26. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 5/22/2019 1:38:50 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

26.1 Files compared

# Location File Last Modified
1 C:\AraxisMergeCompare\Pri_un\CPRS v31_116\OR_30_509_SRC fFrame.pas Mon Apr 15 18:33:16 2019 UTC
2 C:\AraxisMergeCompare\Pri_re\CPRS v31.116\CPRS v31_118\OR_30_509_SRC fFrame.pas Wed May 15 14:08:32 2019 UTC

26.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 3 9434
Changed 2 4
Inserted 0 0
Removed 0 0

26.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

26.4 Active regular expressions

No regular expressions were active.

26.5 Comparison detail

  1   unit fFram e;
  2   { This is  the main f orm for th e CPRS GUI .  It prov ides a pat ient-encou nter-user  framework
  3     which al l the othe r forms of  the GUI u se. }
  4  
  5   {$OPTIMIZA TION OFF}                                 / / REMOVE A FTER UNIT  IS DEBUGGE D
  6   {$WARN SYM BOL_PLATFO RM OFF}
  7   {$DEFINE C COWBROKER}
  8  
  9   {$undef de bug}
  10  
  11   interface
  12  
  13   uses
  14     Windows,  Messages,  SysUtils,  Classes,  Graphics,  Controls,  Forms, Dia logs, Tabs , ComCtrls ,
  15     ExtCtrls , Menus, S tdCtrls, B uttons, OR Fn, fPage,  uConst, O RCtrls, Tr pcb, Contn rs,
  16     OleCtrls , VERGENCE CONTEXTORL ib_TLB, Co mObj, AppE vnts, fBas e508Form,  oPKIEncryp tion,
  17     VA508Acc essibility Manager, R ichEdit, f DebugRepor t, StrUtil s, vcl.Act nList,
  18     System.S yncObjs;
  19  
  20   type
  21     TfrmFram e = class( TfrmBase50 8Form)
  22       pnlToo lbar: TPan el;
  23       stsAre a: TStatus Bar;
  24       tabPag e: TTabCon trol;
  25       pnlPag e: TPanel;
  26       bvlPag eTop: TBev el;
  27       bvlToo lTop: TBev el;
  28       pnlPat ient: TKey ClickPanel ;
  29       lblPtN ame: TStat icText;
  30       lblPtS SN: TStati cText;
  31       lblPtA ge: TStati cText;
  32       pnlVis it: TKeyCl ickPanel;
  33       lblPtL ocation: T StaticText ;
  34       lblPtP rovider: T StaticText ;
  35       mnuFra me: TMainM enu;
  36       mnuFil e: TMenuIt em;
  37       mnuFil eExit: TMe nuItem;
  38       mnuFil eOpen: TMe nuItem;
  39       mnuFil eReview: T MenuItem;
  40       Z1: TM enuItem;
  41       mnuFil ePrint: TM enuItem;
  42       mnuEdi t: TMenuIt em;
  43       mnuEdi tUndo: TMe nuItem;
  44       Z3: TM enuItem;
  45       mnuEdi tCut: TMen uItem;
  46       mnuEdi tCopy: TMe nuItem;
  47       mnuEdi tPaste: TM enuItem;
  48       Z4: TM enuItem;
  49       mnuEdi tPref: TMe nuItem;
  50       Prefs1 : TMenuIte m;
  51       mnu18p t1: TMenuI tem;
  52       mnu14p t1: TMenuI tem;
  53       mnu12p t1: TMenuI tem;
  54       mnu10p t1: TMenuI tem;
  55       mnu8pt : TMenuIte m;
  56       mnuHel p: TMenuIt em;
  57       mnuHel pContents:  TMenuItem ;
  58       mnuHel pTutor: TM enuItem;
  59       Z5: TM enuItem;
  60       mnuHel pAbout: TM enuItem;
  61       mnuToo ls: TMenuI tem;
  62       mnuVie w: TMenuIt em;
  63       mnuVie wChart: TM enuItem;
  64       mnuCha rtReports:  TMenuItem ;
  65       mnuCha rtLabs: TM enuItem;
  66       mnuCha rtDCSumm:  TMenuItem;
  67       mnuCha rtCslts: T MenuItem;
  68       mnuCha rtNotes: T MenuItem;
  69       mnuCha rtOrders:  TMenuItem;
  70       mnuCha rtMeds: TM enuItem;
  71       mnuCha rtProbs: T MenuItem;
  72       mnuCha rtCover: T MenuItem;
  73       mnuHel pBroker: T MenuItem;
  74       mnuFil eEncounter : TMenuIte m;
  75       mnuVie wDemo: TMe nuItem;
  76       mnuVie wPostings:  TMenuItem ;
  77       mnuHel pLists: TM enuItem;
  78       Z6: TM enuItem;
  79       mnuHel pSymbols:  TMenuItem;
  80       mnuFil eNext: TMe nuItem;
  81       Z7: TM enuItem;
  82       mnuFil eRefresh:  TMenuItem;
  83       pnlPri maryCare:  TKeyClickP anel;
  84       lblPtC are: TStat icText;
  85       lblPtA ttending:  TStaticTex t;
  86       pnlRem inders: TK eyClickPan el;
  87       imgRem inder: TIm age;
  88       mnuVie wReminders : TMenuIte m;
  89       anmtRe mSearch: T Animate;
  90       lstCIR NLocations : TORListB ox;
  91       popCIR N: TPopupM enu;
  92       popCIR NSelectAll : TMenuIte m;
  93       popCIR NSelectNon e: TMenuIt em;
  94       popCIR NClose: TM enuItem;
  95       mnuFil ePrintSetu p: TMenuIt em;
  96       LabInf o1: TMenuI tem;
  97       mnuFil eNotifRemo ve: TMenuI tem;
  98       Z8: TM enuItem;
  99       mnuToo lsOptions:  TMenuItem ;
  100       mnuCha rtSurgery:  TMenuItem ;
  101       OROpen Dlg: TOpen Dialog;
  102       mnuFil eResumeCon text: TMen uItem;
  103       mnuFil eResumeCon textSet: T MenuItem;
  104       Useexi stingconte xt1: TMenu Item;
  105       mnuFil eBreakCont ext: TMenu Item;
  106       pnlCCO W: TPanel;
  107       imgCCO W: TImage;
  108       pnlPat ientSelect ed: TPanel ;
  109       pnlNoP atientSele cted: TPan el;
  110       pnlPos tings: TKe yClickPane l;
  111       lblPtP ostings: T StaticText ;
  112       lblPtC WAD: TStat icText;
  113       mnuFil ePrintSele ctedItems:  TMenuItem ;
  114       popAle rts: TPopu pMenu;
  115       mnuAle rtContinue : TMenuIte m;
  116       mnuAle rtForward:  TMenuItem ;
  117       mnuAle rtRenew: T MenuItem;
  118       AppEve nts: TAppl icationEve nts;
  119       paVAA:  TKeyClick Panel;
  120       mnuToo lsGraphing : TMenuIte m;
  121       laVAA2 : TButton;
  122       laMHV:  TButton;
  123       mnuVie wInformati on: TMenuI tem;
  124       mnuVie wVisits: T MenuItem;
  125       mnuVie wPrimaryCa re: TMenuI tem;
  126       mnuVie wMyHealthe Vet: TMenu Item;
  127       mnuIns urance: TM enuItem;
  128       mnuVie wFlags: TM enuItem;
  129       mnuVie wRemoteDat a: TMenuIt em;
  130       compAc cessTabPag e: TVA508C omponentAc cessibilit y;
  131       pnlCVn Flag: TPan el;
  132       btnCom batVet: TB utton;
  133       pnlFla g: TKeyCli ckPanel;
  134       lblFla g: TLabel;
  135       pnlRem oteData: T KeyClickPa nel;
  136       pnlVis taWeb: TKe yClickPane l;
  137       lblVis taWeb: TLa bel;
  138       pnlCIR N: TKeyCli ckPanel;
  139       lblCIR N: TLabel;
  140       mnuEdi tRedo: TMe nuItem;
  141       lblPtM HTC: TStat icText;
  142       Digita lSigningSe tup1: TMen uItem;
  143       mnuFoc usChanges:  TMenuItem ;
  144       txtCmd Flags: TVA 508StaticT ext;
  145       proced ure tabPag eChange(Se nder: TObj ect);
  146       proced ure FormCr eate(Sende r: TObject );
  147       proced ure FormRe size(Sende r: TObject );
  148       proced ure pnlPat ientMouseD own(Sender : TObject;  Button: T MouseButto n;
  149         Shif t: TShiftS tate; X, Y : Integer) ;
  150       proced ure pnlPat ientMouseU p(Sender:  TObject; B utton: TMo useButton;
  151         Shif t: TShiftS tate; X, Y : Integer) ;
  152       proced ure pnlVis itMouseDow n(Sender:  TObject; B utton: TMo useButton;
  153         Shif t: TShiftS tate; X, Y : Integer) ;
  154       proced ure pnlVis itMouseUp( Sender: TO bject; But ton: TMous eButton;
  155         Shif t: TShiftS tate; X, Y : Integer) ;
  156       proced ure mnuFil eExitClick (Sender: T Object);
  157       proced ure pnlPos tingsMouse Down(Sende r: TObject ; Button:  TMouseButt on;
  158         Shif t: TShiftS tate; X, Y : Integer) ;
  159       proced ure pnlPos tingsMouse Up(Sender:  TObject;  Button: TM ouseButton ;
  160         Shif t: TShiftS tate; X, Y : Integer) ;
  161       proced ure mnuFon tSizeClick (Sender: T Object);
  162       proced ure mnuCha rtTabClick (Sender: T Object);
  163       proced ure FormDe stroy(Send er: TObjec t);
  164       proced ure mnuFil eOpenClick (Sender: T Object);
  165       proced ure mnuHel pBrokerCli ck(Sender:  TObject);
  166       proced ure mnuFil eEncounter Click(Send er: TObjec t);
  167       proced ure mnuVie wPostingsC lick(Sende r: TObject );
  168       proced ure mnuHel pAboutClic k(Sender:  TObject);
  169       proced ure mnuFil eReviewCli ck(Sender:  TObject);
  170       proced ure FormCl oseQuery(S ender: TOb ject; var  CanClose:  Boolean);
  171       proced ure mnuHel pListsClic k(Sender:  TObject);
  172       proced ure ToolCl ick(Sender : TObject) ;
  173       proced ure mnuEdi tClick(Sen der: TObje ct);
  174       proced ure mnuEdi tUndoClick (Sender: T Object);
  175       proced ure mnuEdi tCutClick( Sender: TO bject);
  176       proced ure mnuEdi tCopyClick (Sender: T Object);
  177       proced ure mnuEdi tPasteClic k(Sender:  TObject);
  178       proced ure mnuHel pSymbolsCl ick(Sender : TObject) ;
  179       proced ure FormCl ose(Sender : TObject;  var Actio n: TCloseA ction);
  180       proced ure mnuFil ePrintClic k(Sender:  TObject);
  181       proced ure mnuGEC StatusClic k(Sender:  TObject);
  182       proced ure mnuFil eNextClick (Sender: T Object);
  183       proced ure pnlPri maryCareMo useDown(Se nder: TObj ect;
  184         Butt on: TMouse Button; Sh ift: TShif tState; X,  Y: Intege r);
  185       proced ure pnlPri maryCareMo useUp(Send er: TObjec t; Button:  TMouseBut ton;
  186         Shif t: TShiftS tate; X, Y : Integer) ;
  187       proced ure pnlRem indersMous eDown(Send er: TObjec t; Button:  TMouseBut ton;
  188         Shif t: TShiftS tate; X, Y : Integer) ;
  189       proced ure pnlRem indersMous eUp(Sender : TObject;  Button: T MouseButto n;
  190         Shif t: TShiftS tate; X, Y : Integer) ;
  191       proced ure pnlCIR NClick(Sen der: TObje ct);
  192       proced ure lstCIR NLocations Click(Send er: TObjec t);
  193       proced ure popCIR NCloseClic k(Sender:  TObject);
  194       proced ure popCIR NSelectAll Click(Send er: TObjec t);
  195       proced ure popCIR NSelectNon eClick(Sen der: TObje ct);
  196       proced ure mnuFil ePrintSetu pClick(Sen der: TObje ct);
  197       proced ure LabInf o1Click(Se nder: TObj ect);
  198       proced ure mnuFil eNotifRemo veClick(Se nder: TObj ect);
  199       proced ure mnuToo lsOptionsC lick(Sende r: TObject );
  200       proced ure mnuFil eRefreshCl ick(Sender : TObject) ;
  201       proced ure FormKe yDown(Send er: TObjec t; var Key : Word;
  202         Shif t: TShiftS tate);
  203       proced ure FormAc tivate(Sen der: TObje ct);
  204       proced ure pnlPri maryCareEn ter(Sender : TObject) ;
  205       proced ure pnlPri maryCareEx it(Sender:  TObject);
  206       proced ure pnlPat ientClick( Sender: TO bject);
  207       proced ure pnlVis itClick(Se nder: TObj ect);
  208       proced ure pnlPri maryCareCl ick(Sender : TObject) ;
  209       proced ure pnlRem indersClic k(Sender:  TObject);
  210       proced ure pnlPos tingsClick (Sender: T Object);
  211       proced ure ctxCon textorCanc eled(Sende r: TObject );
  212       proced ure ctxCon textorComm itted(Send er: TObjec t);
  213       proced ure ctxCon textorPend ing(Sender : TObject;
  214         cons t aContext ItemCollec tion: IDis patch);
  215       proced ure mnuDeb ugReportCl ick(Sender : TObject) ;
  216       proced ure mnuFil eBreakCont extClick(S ender: TOb ject);
  217       proced ure mnuFil eResumeCon textGetCli ck(Sender:  TObject);
  218       proced ure mnuFil eResumeCon textSetCli ck(Sender:  TObject);
  219       proced ure pnlFla gMouseDown (Sender: T Object; Bu tton: TMou seButton;
  220         Shif t: TShiftS tate; X, Y : Integer) ;
  221       proced ure pnlFla gMouseUp(S ender: TOb ject; Butt on: TMouse Button;
  222         Shif t: TShiftS tate; X, Y : Integer) ;
  223       proced ure pnlFla gClick(Sen der: TObje ct);
  224       proced ure mnuFil ePrintSele ctedItemsC lick(Sende r: TObject );
  225       proced ure mnuAle rtRenewCli ck(Sender:  TObject);
  226       proced ure mnuAle rtForwardC lick(Sende r: TObject );
  227       proced ure pnlFla gEnter(Sen der: TObje ct);
  228       proced ure pnlFla gExit(Send er: TObjec t);
  229       proced ure tabPag eMouseUp(S ender: TOb ject; Butt on: TMouse Button;
  230         Shif t: TShiftS tate; X, Y : Integer) ;
  231       proced ure lstCIR NLocations Exit(Sende r: TObject );
  232       proced ure AppEve ntsActivat e(Sender:  TObject);
  233       proced ure Screen ActiveForm Change(Sen der: TObje ct);
  234       proced ure AppEve ntsShortCu t(var Msg:  TWMKey; v ar Handled : Boolean) ;
  235       proced ure mnuToo lsGraphing Click(Send er: TObjec t);
  236       proced ure pnlCIR NMouseDown (Sender: T Object; Bu tton: TMou seButton;
  237         Shif t: TShiftS tate; X, Y : Integer) ;
  238       proced ure pnlCIR NMouseUp(S ender: TOb ject; Butt on: TMouse Button;
  239         Shif t: TShiftS tate; X, Y : Integer) ;
  240       proced ure laMHVC lick(Sende r: TObject );
  241       proced ure laVAA2 Click(Send er: TObjec t);
  242       proced ure ViewIn fo(Sender:  TObject);
  243       proced ure mnuVie wInformati onClick(Se nder: TObj ect);
  244       proced ure compAc cessTabPag eCaptionQu ery(Sender : TObject;
  245         var  Text: stri ng);
  246       proced ure btnCom batVetClic k(Sender:  TObject);
  247       proced ure pnlVis taWebClick (Sender: T Object);
  248       proced ure pnlVis taWebMouse Up(Sender:  TObject;  Button: TM ouseButton ;
  249         Shif t: TShiftS tate; X, Y : Integer) ;
  250       proced ure pnlVis taWebMouse Down(Sende r: TObject ; Button:  TMouseButt on;
  251         Shif t: TShiftS tate; X, Y : Integer) ;
  252       proced ure mnuEdi tRedoClick (Sender: T Object);
  253       proced ure tabPag eMouseDown (Sender: T Object; Bu tton: TMou seButton;
  254         Shif t: TShiftS tate; X, Y : Integer) ;
  255       proced ure Digita lSigningSe tup1Click( Sender: TO bject);
  256       proced ure mnuFoc usChangesC lick(Sende r: TObject );
  257       proced ure AppEve ntsMessage (var Msg:  tagMSG; va r Handled:  Boolean);
  258     private
  259       FProcc essingNext Click : bo olean;
  260       FJustE nteredApp  : boolean;
  261       FCCOWI nstalled:  boolean;
  262       FCCOWC ontextChan ging: bool ean;
  263       FCCOWI conName: s tring;
  264       FCCOWD rivedChang e: boolean ;
  265       FCCOWB usy: boole an;
  266       FCCOWE rror: bool ean;
  267       FNoPat ientSelect ed: boolea n;
  268       FRefre shing: boo lean;
  269       FClosi ng: boolea n;
  270       FConte xtChanging : Boolean;
  271       FChang eSource: I nteger;
  272       FCreat eProgress:  Integer;
  273       FEditC trl: TCust omEdit;
  274       FLastP age: TfrmP age;
  275       FNextB uttonL: In teger;
  276       FNextB uttonR: In teger;
  277       FNextB uttonActiv e: Boolean ;
  278       FNextB uttonBitma p: TBitmap ;
  279       FNextB utton: TBi tBtn;
  280       FTermi nate: Bool ean;
  281       FTabCh anged: TNo tifyEvent;
  282       FOldAc tivate: TN otifyEvent ;
  283       FOldAc tiveFormCh ange: TNot ifyEvent;
  284       FECSAu thUser: Bo olean;
  285       FFixed StatusWidt h: integer ;
  286       FPrevI nPatient:  Boolean;
  287       FFirst Load:    B oolean;
  288       FFlagL ist: TStri ngList;
  289       FPrevP tID: strin g;
  290       FGraph FloatActiv e: boolean ;
  291       FGraph Context: s tring;
  292       FDoNot ChangeEncW indow: boo lean;
  293       FOrder PrintForm:  boolean;
  294       FRevie wclick: bo olean;
  295       FCtrlT abUsed: bo olean;
  296       proced ure Refres hFixedStat usWidth;
  297       proced ure FocusA pplication TopForm;
  298       proced ure AppAct ivated(Sen der: TObje ct);
  299       proced ure AppDeA ctivated(S ender: TOb ject);
  300       proced ure AppExc eption(Sen der: TObje ct; E: Exc eption);
  301       functi on AllowCo ntextChang eAll(var R eason: str ing):  Boo lean;
  302       proced ure ClearP atient;
  303       proced ure Change Font(NewFo ntSize: In teger);
  304       proced ure Create Tab(ATabID : integer;  ALabel: s tring);
  305       proced ure Determ ineNextTab ;
  306       functi on ExpandC ommand(x:  string): s tring;
  307       proced ure FitToo lbar;
  308       proced ure LoadSi zesForUser ;
  309       proced ure SaveSi zesForUser ;
  310       proced ure LoadUs erPreferen ces;
  311       proced ure SaveUs erPreferen ces;
  312       proced ure Switch ToPage(New Form: Tfrm Page);
  313       functi on TabToPa geID(Tab:  Integer):  Integer;
  314       functi on Timeout Condition:  boolean;
  315       functi on GetTime dOut: bool ean;
  316       proced ure TimeOu tAction;
  317       proced ure SetUse rTools;
  318       proced ure SetDeb ugMenu;
  319       proced ure SetupP atient(AFl aggedList  : TStringL ist = nil) ;
  320       proced ure Remind ersChanged (Sender: T Object);
  321       proced ure Report sOnlyDispl ay;
  322       proced ure UMInit iate(var M essage: TM essage);    message U M_INITIATE ;
  323       proced ure UMNewO rder(var M essage: TM essage);    message U M_NEWORDER ;
  324       proced ure UMStat usText(var  Message:  TMessage);  message U M_STATUSTE XT;
  325       proced ure UMShow Page(var M essage: TM essage);    message U M_SHOWPAGE ;
  326       proced ure WMSetF ocus(var M essage: TM essage);    message W M_SETFOCUS ;
  327       proced ure WMSysC ommand(var  Message:  TMessage);  message W M_SYSCOMMA ND;
  328       proced ure Update ECSParamet er(var Cmd Parameter:  string);
  329       functi on  ValidE CSUser: bo olean;
  330       proced ure StartC COWContext or;
  331       functi on  AllowC COWContext Change(var  CCOWRespo nse: UserR esponse; N ewDFN: str ing): bool ean;
  332       proced ure Update CCOWContex t;
  333       proced ure CheckH yperlinkRe sponse(aCo ntextItemC ollection:  IDispatch ; var Hype rlinkReaso n: string) ;
  334       proced ure CheckF orDifferen tPatient(a ContextIte mCollectio n: IDispat ch; var Pt Changed: b oolean);
  335   {$IFDEF CC OWBROKER}
  336       proced ure CheckF orDifferen tUser(aCon textItemCo llection:  IDispatch;  var UserC hanged: bo olean);
  337   {$ENDIF}
  338       proced ure HideEv erything(A Message: s tring = 'N o patient  is current ly selecte d.');
  339       proced ure ShowEv erything;
  340       functi on FindBes tCCOWDFN:  string;
  341       proced ure Handle CCOWError( AMessage:  string);
  342       proced ure SetUpN extButton;
  343       proced ure NextBu ttonClick( Sender: TO bject);
  344       proced ure NextBu ttonMouseD own(Sender : TObject;  Button: T MouseButto n;
  345         Shif t: TShiftS tate; X, Y : Integer) ;
  346     public
  347       Enduri ngPtSelSpl itterPos,  frmFrameHe ight, pnlP atientSele ctedHeight : integer;
  348       Enduri ngPtSelCol umns: stri ng;
  349       proced ure SetBAD xList;
  350       proced ure SetAct iveTab(Pag eID: Integ er);
  351  
  352       functi on PageIDT oTab(PageI D: Integer ): Integer ;
  353       proced ure ShowHi deChartTab Menus(AMen uItem: TMe nuItem);
  354       proced ure Update PtInfoOnRe fresh;
  355       functi on  TabExi sts(ATabID : integer) : boolean;
  356       proced ure Displa yEncounter Text;
  357       functi on DLLActi ve: boolea n;
  358       proper ty ChangeS ource:     Integer re ad FChange Source;
  359       proper ty CCOWCon textChangi ng: Boolea n read FCC OWContextC hanging;
  360       proper ty CCOWDri vedChange:  Boolean   read FCCOW DrivedChan ge;
  361       proper ty CCOWBus y: Boolean     read F CCOWBusy   write FCCO WBusy;
  362       proper ty Context Changing:  Boolean re ad FContex tChanging;
  363       proper ty TimedOu t:         Boolean re ad GetTime dOut;
  364       proper ty Closing :          Boolean re ad FClosin g;
  365       proper ty OnTabCh anged:     TNotifyEve nt read FT abChanged  write FTab Changed;
  366       proper ty GraphFl oatActive:  boolean r ead FGraph FloatActiv e write FG raphFloatA ctive;
  367       proper ty GraphCo ntext: str ing read F GraphConte xt write F GraphConte xt;
  368       proced ure Toggle MenuItemCh ecked(Send er: TObjec t);
  369       proced ure SetUpC IRN;
  370       proper ty DoNotCh angeEncWin dow: boole an read FD oNotChange EncWindow  write FDoN otChangeEn cWindow;
  371       proper ty OrderPr intForm: b oolean rea d FOrderPr intForm wr ite FOrder PrintForm;
  372     end;
  373  
  374   var
  375     frmFrame : TfrmFram e;
  376     uTabList : TStringL ist;
  377     uRemoteT ype, uRepo rtID, uLab RepID : st ring;
  378     FlaggedP TList: TSt ringList;
  379     ctxConte xtor : TCo ntextorCon trol;
  380     NextTab,  LastTab,  ChangingTa b: Integer ;
  381     uUseVist aWeb: bool ean;
  382     PTSwitch Refresh: b oolean = F ALSE;  //f lag for pa tient refr esh or swi tch of pat ients
  383     ProbTabC licked: bo olean = FA LSE;
  384     TabCtrlC licked: Bo olean = FA LSE;
  385     DEAConte xt: Boolea n = False;
  386     DelayRev iewChanges : Boolean  = False;
  387  
  388   const
  389     PASSCODE  = '_gghwn 7pghCrOJvO V61PtPvgde EU2u5cRsGv pkVDjKT_H7 SdKE_hqFYW sUIVT1H7Jw T6Yz8oCtd2 u2PALqWxib NXx3Yo8GPc TYsNaxW' +  'ZFo8OgT1 1D5TIvpu3c DQuZd3Yh_n V9jhkvb0ZB GdO9n-uNXP PEK7xfYWCI 2Wp3Dsu9YD Sd_EM34nvr gy64cqu9_j FJKJnGiXY9 6Lf1ecLiv4 LT9qtmJ-Ba wYt7O9JZGA swi344BmmC bNxfgvgf0g fGZea';
  390     EM_SETZO OM = (WM_U SER + 225) ;
  391   implementa tion
  392  
  393   {$R *.DFM}
  394   {$R sBitma ps}
  395   {$R sRemSr ch}
  396  
  397   uses
  398     ORNet, r Core, fPtS elMsg, fPt Sel, fCove r, fProbs,  fMeds, fO rders, rOr ders, fNot es, fConsu lts, fDCSu mm,
  399     rMisc, C lipbrd, fL abs, fRepo rts, rRepo rts, fPtDe mo, fEncnt , fPtCWAD,  uCore, fA bout, fRev iew, fxBro ker,
  400     fxLists,  fxServer,  ORSystem,  fRptBox,  fSplash, r ODAllergy,  uInit, fL abTests, f LabInfo, u GlobalVar,
  401     uReminde rs, fRemin derTree, O RClasses,  fDeviceSel ect, fDraw ers, fRemi nderDialog , ShellAPI , rVitals,
  402     fOptions , fGraphs,  fGraphDat a, rTempla tes, fSurg ery, rSurg ery, uEven tHooks, uS ignItems,
  403     fDefault Event, rEC S, fIconLe gend, uOrd ers, fPtSe lOptns, Da teUtils, u Spell, uOr Ptf, fPati entFlagMul ti,
  404     fAlertFo rward, UBA Globals, f BAOptionsD iagnoses,  UBACore, f OrdersSign , uVitals,  fOrdersRe new, fMHTe st, uFormM onitor
  405     {$IFDEF  CCOWBROKER }
  406     , CCOW_c onst
  407     {$ENDIF}
  408     , VA508A ccessibili tyRouter,  fOtherSche dule, VAUt ils, uVA50 8CPRSCompa tibility,  fIVRoutes,
  409     fPrintLo cation, fT emplateEdi tor, fTemp lateDialog , fCombatV et, fFocus edControls ;
  410  
  411   var
  412     IsRunExe cuted: Boo lean = FAL SE;
  413     GraphFlo at: TfrmGr aphs;
  414  
  415   const
  416     FCP_UPDA TE  = 10;                                //  form crea te about t o check au to-update
  417     FCP_SETH OOK = 20;                                //  form crea te about t o set time out hooks
  418     FCP_SERV ER  = 30;                                //  form crea te about t o connect  to server
  419     FCP_CHKV ER  = 40;                                //  form crea te about t o check ve rsion
  420     FCP_OBJE CTS = 50;                                //  form crea te about t o create c ore object s
  421     FCP_FORM S   = 60;                                //  form crea te about t o create c hild forms
  422     FCP_PTSE L   = 70;                                //  form crea te about t o select p atient
  423     FCP_FINI SH  = 99;                                //  form crea te finishe d successf ully
  424  
  425     TX_IN_US E     = 'V istA CPRS  in use by:  ';     //  use same  as with CP RSInstance s in fTime out
  426     TX_OPTIO N     = 'O R CPRS GUI  CHART';
  427     TX_ECSOP T     = 'E C GUI CONT EXT';
  428     TX_PTINQ       = 'R etrieving  demographi c informat ion...';
  429     TX_NOTIF _STOP = 'S top proces sing notif ications?' ;
  430     TC_NOTIF _STOP = 'C urrently P rocessing  Notificati ons';
  431     TX_UNK_N OTIF  = 'U nable to p rocess the  follow up  action fo r this not ification' ;
  432     TC_UNK_N OTIF  = 'F ollow Up A ction Not  Implemente d';
  433     TX_NO_SU RG_NOTIF =  'This not ification  must be pr ocessed us ing the Su rgery tab,  ' + CRLF  +
  434                          'which is  not curre ntly avail able to yo u.';
  435     TC_NO_SU RG_NOTIF =  'Surgery  Tab Not Av ailable';
  436     TX_VER1        = 'T his is ver sion ';
  437     TX_VER2        = '  of CPRSCha rt.exe.';
  438     TX_VER3        = CR LF + 'The  running se rver versi on is ';
  439     TX_VER_R EQ    = '  version se rver is re quired.';
  440     TX_VER_O LD    = CR LF + 'It i s strongly  recommend ed that yo u upgrade. ';
  441     TX_VER_O LD2   = CR LF + 'The  program ca nnot be ru n until th e client i s upgraded .';
  442     TX_VER_N EW    = CR LF + 'The  program ca nnot be ru n until th e server i s upgraded .';
  443     TC_VER         = 'S erver/Clie nt Incompa tibility';
  444     TC_CLIER R     = 'C lient Spec ifications  Mismatch' ;
  445  
  446     SHOW_NOT IFICATIONS  = True;
  447  
  448     TC_DGSR_ ERR    = ' Remote Dat a Error';
  449     TC_DGSR_ SHOW   = ' Restricted  Remote Re cord';
  450     TC_DGSR_ DENY   = ' Remote Acc ess Denied ';
  451     TX_DGSR_ YESNO  = C RLF + 'Do  you want t o continue  accessing  this remo te patient  record?';
  452  
  453     TX_CCOW_ LINKED   =  'Clinical  Link On';
  454     TX_CCOW_ CHANGING =  'Clinical  link chan ging';
  455     TX_CCOW_ BROKEN   =  'Clinical  link brok en';
  456     TX_CCOW_ ERROR    =  'CPRS was  unable to  communica te with th e CCOW Con text Vault ' + CRLF +
  457                          'CCOW pat ient synch ronization  will be u navailable  for the r emainder o f this ses sion.';
  458     TC_CCOW_ ERROR    =  'CCOW Err or';
  459  
  460   function T frmFrame.T imeoutCond ition: boo lean;
  461   begin
  462     Result : = (FCreate Progress <  FCP_PTSEL );
  463   end;
  464  
  465   function T frmFrame.G etTimedOut : boolean;
  466   begin
  467     Result : = uInit.Ti medOut;
  468   end;
  469  
  470   procedure  TfrmFrame. TimeOutAct ion;
  471   var
  472     ClosingC PRS: boole an;
  473  
  474     procedur e CloseCPR S;
  475     begin
  476       if Clo singCPRS t hen
  477         halt ;
  478       try
  479         Clos ingCPRS :=  TRUE;
  480         Clos e;
  481       except
  482         halt ;
  483       end;
  484     end;
  485  
  486   begin
  487     ClosingC PRS := FAL SE;
  488     try
  489       if ass igned(frmO therSchedu le) then f rmOtherSch edule.Clos e;
  490       if ass igned (frm IVRoutes)  then frmIV Routes.Clo se;
  491       if frm Frame.DLLA ctive then
  492       begin
  493          Clo seVitalsDL L();
  494          Clo seMHDLL();
  495       end;
  496       CloseC PRS;
  497     except
  498       CloseC PRS;
  499     end;
  500   end;
  501  
  502   { General  Functions  and Proced ures }
  503  
  504   procedure  TfrmFrame. AppExcepti on(Sender:  TObject;  E: Excepti on);
  505   var
  506     AnAddr:  Pointer;
  507     ErrMsg:  string;
  508  
  509   begin
  510     Applicat ion.Normal izeTopMost s;
  511     if (E is  EIntError ) then
  512     begin
  513       ErrMsg  := E.Mess age + CRLF  +
  514                  'Creat eProgress:  ' + IntTo Str(FCreat eProgress)  + CRLF +
  515                  'RPC I nfo: ' + R PCLastCall ;
  516       if EEx ternal(E). ExceptionR ecord <> n il then
  517       begin
  518         AnAd dr := EExt ernal(E).E xceptionRe cord^.Exce ptionAddre ss;
  519         ErrM sg := ErrM sg + CRLF  + 'Address  was ' + I ntToStr(In teger(AnAd dr));
  520       end;
  521       ShowMs g(ErrMsg);
  522     end
  523     else if  (E is EBro kerError)  then
  524     begin
  525       Applic ation.Show Exception( E);
  526       FCreat eProgress  := FCP_FOR MS;
  527       Close;
  528     end
  529     else if  (E is EOle Exception)  then
  530     begin
  531       Applic ation.Show Exception( E);
  532       FCreat eProgress  := FCP_FOR MS;
  533       Close;
  534     end
  535     else App lication.S howExcepti on(E);
  536     Applicat ion.Restor eTopMosts;
  537  
  538   end;
  539  
  540   procedure  TfrmFrame. btnCombatV etClick(Se nder: TObj ect);
  541   begin
  542     inherite d;
  543     frmComba tVet := Tf rmCombatVe t.Create(f rmFrame);
  544     frmComba tVet.ShowM odal;
  545     frmComba tVet.Free;
  546   end;
  547  
  548   function T frmFrame.A llowContex tChangeAll (var Reaso n: string) : Boolean;
  549   var
  550     Silent:  Boolean;
  551   begin
  552     if pnlNo PatientSel ected.Visi ble then
  553     begin
  554       Result  := True;
  555       exit;
  556     end;
  557     FContext Changing : = True;
  558     Result : = True;
  559     if COMOb jectActive  or SpellC heckInProg ress or DL LActive th en
  560       begin
  561         Reas on := 'COM _OBJECT_AC TIVE';
  562         Resu lt:= False ;
  563       end;
  564     if Resul t then Res ult := frm Cover.Allo wContextCh ange(Reaso n);
  565     if Resul t then Res ult := frm Problems.A llowContex tChange(Re ason);
  566     if Resul t then Res ult := frm Meds.Allow ContextCha nge(Reason );
  567     if Resul t then Res ult := frm Orders.All owContextC hange(Reas on);
  568     if Resul t then Res ult := frm Notes.Allo wContextCh ange(Reaso n);
  569     if Resul t then Res ult := frm Consults.A llowContex tChange(Re ason);
  570     if Resul t then Res ult := frm DCSumm.All owContextC hange(Reas on);
  571     if Resul t then
  572       if Ass igned(frmS urgery) th en Result  := frmSurg ery.AllowC ontextChan ge(Reason) ;;
  573     if Resul t then Res ult := frm Labs.Allow ContextCha nge(Reason );;
  574     if Resul t then Res ult := frm Reports.Al lowContext Change(Rea son);
  575     if Resul t then Res ult := frm GraphData. AllowConte xtChange(R eason);
  576     if (not  User.IsRep ortsOnly)  then
  577       if Res ult and Ch anges.Requ ireReview  then //Res ult := Rev iewChanges (TimedOut) ;
  578         case  BOOLCHAR[ FCCOWConte xtChanging ] of
  579           '1 ': begin
  580                   if Ch anges.Requ ireReview  then
  581                     beg in
  582                       R eason := ' Items will  be left u nsigned.';
  583                       R esult := F alse;
  584                     end
  585                   else
  586                     Res ult := Tru e;
  587                 end;
  588           '0 ': begin
  589                   Silen t := (Time dOut) or ( Reason = ' COMMIT');
  590                   Resul t := Revie wChanges(S ilent);
  591                 end;
  592         end;
  593     FContext Changing : = False;
  594   end;
  595  
  596   procedure  TfrmFrame. ClearPatie nt;
  597   { call all  pages to  make sure  patient re lated info rmation is  cleared ( when switc hing patie nts) }
  598   begin
  599     //if frm Frame.Time dout then  Exit; // a dded to co rrect Acce ss Violati on when "R efresh Pat ient Infor mation" se lected
  600     lblPtNam e.Caption      := '';
  601     lblPtSSN .Caption       := '';
  602     lblPtAge .Caption       := '';
  603     pnlPatie nt.Caption     := '';
  604     lblPtCWA D.Caption      := '';
  605     if DoNot ChangeEncW indow = fa lse then
  606        begin
  607         lblP tLocation. Caption :=  'Visit No t Selected ';
  608         lblP tProvider. Caption :=  'Current  Provider N ot Selecte d';
  609         pnlV isit.Capti on      :=  lblPtLoca tion.Capti on + CRLF  + lblPtPro vider.Capt ion;
  610        end;
  611     lblPtCar e.Caption      := 'Pr imary Care  Team Unas signed';
  612     lblPtAtt ending.Cap tion := '' ;
  613     lblPtMHT C.Caption  := '';
  614     pnlPrima ryCare.Cap tion := lb lPtCare.Ca ption + '  ' + lblPtA ttending.C aption + '  ' + lblPt MHTC.Capti on;
  615     frmCover .ClearPtDa ta;
  616     frmProbl ems.ClearP tData;
  617     frmMeds. ClearPtDat a;
  618     frmOrder s.ClearPtD ata;
  619     frmNotes .ClearPtDa ta;
  620     frmConsu lts.ClearP tData;
  621     frmDCSum m.ClearPtD ata;
  622     if Assig ned(frmSur gery) then  frmSurger y.ClearPtD ata;
  623     frmLabs. ClearPtDat a;
  624     frmGraph Data.Clear PtData;
  625     frmRepor ts.ClearPt Data;
  626     tabPage. TabIndex : = PageIDTo Tab(CT_NOP AGE);        // to ma ke sure Di splayPage  gets calle d
  627     tabPageC hange(tabP age);
  628     ClearRem inderData;
  629     SigItems .Clear;
  630     Changes. Clear;
  631     lstCIRNL ocations.C lear;
  632     ClearFla g;
  633     if Assig ned(FlagLi st) then F lagList.Cl ear;
  634     HasFlag  := False;
  635     HidePati entSelectM essages;
  636     if (Grap hFloat <>  nil) and G raphFloatA ctive then
  637     with Gra phFloat do
  638     begin
  639       Initia lize;
  640       Displa yData('top ');
  641       Displa yData('bot tom');
  642       Captio n := 'CPRS  Graphing  - Patient:  ' + Mixed Case(Patie nt.Name);
  643     end;
  644     if frmFr ame.TimedO ut then
  645     begin
  646       infoBo x('CPRS ha s encounte red a seri ous proble m and is u nable to d isplay the  selected  patient''s  data. '
  647                + 'To pr event pati ent safety  issues, C PRS is shu tting down . Shutting  down and  then resta rting CPRS  will corr ect the pr oblem, and  you may c ontinue wo rking in C PRS.'
  648                 + CRLF  + CRLF + ' Please rep ort all oc currences  of this pr oblem by c ontacting  your CPRS  Help Desk. ', 'CPRS E rror', MB_ OK);
  649       frmFra me.Close;
  650     end;
  651   end;
  652  
  653   procedure  TfrmFrame. DigitalSig ningSetup1 Click(Send er: TObjec t);
  654   var
  655     aPKIEncr yptionEngi ne: IPKIEn cryptionEn gine;
  656     AMessage , successM sg: string ;
  657   //  i: Int eger;
  658   begin
  659     try
  660       // get  PKI engin e ready
  661       NewPKI Encryption Engine(RPC BrokerV, a PKIEncrypt ionEngine) ;
  662       CallV( 'ORDEA LNK MSG', []);
  663       succes sMsg := RP CBrokerV.R esults.Tex t;
  664       if not  IsDigital SignatureA vailable(a PKIEncrypt ionEngine,  AMessage,  successMs g) then
  665       begin
  666         Show Msg('There  was a pro blem linki ng your PI V card. Ei ther the '
  667           +  'PIV card  name does  NOT match  your VistA  account n ame or the  PIV card  is already  '
  668           +  'linked to  another V istA accou nt.  Ensur e that the  correct P IV card ha s '
  669           +  'been inse rted for y our VistA  account. P lease cont act your P IV Card Co ordinator  '
  670           +  'if you co ntinue to  have probl ems.');
  671       end
  672       else b egin
  673        frmFr ame.Digita lSigningSe tup1.Visib le := Fals e;
  674       end;
  675     except
  676       on E:  Exception  do
  677         Show Msg('Probl em during  digital si gning setu p: ' + E.M essage);
  678     end;
  679   end;
  680  
  681   procedure  TfrmFrame. DisplayEnc ounterText ;
  682   { updates  the displa y in the h eader bar  of encount er related  informati on (locati on & provi der) }
  683   begin
  684     if DoNot ChangeEncW indow = tr ue then ex it;
  685     with Enc ounter do
  686     begin
  687       if Len gth(Locati onText) >  0
  688         then  lblPtLoca tion.Capti on := Loca tionText
  689         else  lblPtLoca tion.Capti on := 'Vis it Not Sel ected';
  690       if Len gth(Provid erName) >  0
  691         then  lblPtProv ider.Capti on := 'Pro vider:  '  + Provider Name
  692         else  lblPtProv ider.Capti on := 'Cur rent Provi der Not Se lected';
  693     end;
  694     pnlVisit .Caption : = lblPtLoc ation.Capt ion + CRLF  + lblPtPr ovider.Cap tion;
  695     FitToolB ar;
  696   end;
  697  
  698   function T frmFrame.D LLActive:  boolean;
  699   begin
  700     Result : = (VitalsD LLHandle < > 0) or (M HDLLHandle  <> 0);
  701   end;
  702  
  703   { Form Eve nts (Creat e, Destroy ) -------- ---------- ---------- ---------- ---------- ---------- - }
  704  
  705  
  706   procedure  TfrmFrame. RefreshFix edStatusWi dth;
  707   begin
  708     with sts Area do
  709       FFixed StatusWidt h := Panel s[0].Width  + Panels[ 2].Width +  Panels[3] .Width + P anels[4].W idth;
  710   end;
  711  
  712   procedure  TfrmFrame. FormCreate (Sender: T Object);
  713   { connect  to server,  create ta b pages, s elect a pa tient, & i nitialize  core objec ts }
  714   var
  715     ClientVe r, ServerV er, Server Req, SAN:  string;
  716   begin
  717     FJustEnt eredApp :=  false;
  718     SizeHold er := TSiz eHolder.Cr eate;
  719     FOldActi veFormChan ge := Scre en.OnActiv eFormChang e;
  720     Screen.O nActiveFor mChange :=  ScreenAct iveFormCha nge;
  721     if not ( ParamSearc h('CCOW')= 'DISABLE')  then
  722       try
  723         Star tCCOWConte xtor;
  724       except
  725         IsRu nExecuted  := False;
  726         FCCO WInstalled  := False;
  727         pnlC COW.Visibl e := False ;
  728         mnuF ileResumeC ontext.Vis ible := Fa lse;
  729         mnuF ileBreakCo ntext.Visi ble := Fal se;
  730       end
  731     else
  732       begin
  733         IsRu nExecuted  := False;
  734         FCCO WInstalled  := False;
  735         pnlC COW.Visibl e := False ;
  736         mnuF ileResumeC ontext.Vis ible := Fa lse;
  737         mnuF ileBreakCo ntext.Visi ble := Fal se;
  738       end;
  739  
  740     RefreshF ixedStatus Width;
  741     FTermina te := Fals e;
  742  
  743     FFlagLis t := TStri ngList.Cre ate;
  744  
  745     // setup  initial t imeout her e so can t imeout log on
  746     FCreateP rogress :=  FCP_SETHO OK;
  747     InitTime Out(Timeou tCondition , TimeOutA ction);
  748  
  749     // conne ct to the  server and  create an  option co ntext
  750     FCreateP rogress :=  FCP_SERVE R;
  751  
  752   {$IFDEF CC OWBROKER}
  753     EnsureBr oker;
  754     if ctxCo ntextor <>  nil then
  755     begin
  756       if Par amSearch(' CCOW') = ' PATIENTONL Y' then
  757         RPCB rokerV.Con textor :=  nil
  758       else
  759         RPCB rokerV.Con textor :=  ctxContext or;
  760     end
  761     else
  762       RPCBro kerV.Conte xtor := ni l;
  763   {$ENDIF}
  764  
  765     if not C onnectToSe rver(TX_OP TION) then
  766     begin
  767       if Ass igned(RPCB rokerV) th en
  768         Info Box(RPCBro kerV.RPCBE rror, 'Err or', MB_OK  or MB_ICO NERROR);
  769       Close;
  770       Exit;
  771     end;
  772  
  773     if ctxCo ntextor <>  nil then
  774     begin
  775       if not  (ParamSea rch('CCOW' ) = 'PATIE NTONLY') t hen
  776         ctxC ontextor.N otificatio nFilter :=  ctxContex tor.Notifi cationFilt er + ';Use r';
  777     end;
  778  
  779     FECSAuth User := Va lidECSUser ;
  780     uECSRepo rt := TECS Report.Cre ate;
  781     uECSRepo rt.ECSPerm it := FECS AuthUser;
  782     RPCBroke rV.CreateC ontext(TX_ OPTION);
  783     Applicat ion.OnExce ption := A ppExceptio n;
  784     FOldActi vate := Ap plication. OnActivate ;
  785     Applicat ion.OnActi vate := Ap pActivated ;
  786     Applicat ion.OnDeAc tivate :=  AppDeActiv ated;
  787  
  788     // creat e initial  core objec ts
  789     FCreateP rogress :=  FCP_OBJEC TS;
  790     User :=  TUser.Crea te;
  791  
  792     // make  sure we're  using the  matching  server ver sion
  793     FCreateP rogress :=  FCP_CHKVE R;
  794     ClientVe r := Clien tVersion(A pplication .ExeName);
  795     ServerVe r := Serve rVersion(T X_OPTION,  ClientVer) ;
  796     if (Serv erVer = '0 .0.0.0') t hen
  797     begin
  798       InfoBo x('Unable  to determi ne current  version o f server.' , TX_OPTIO N, MB_OK);
  799       Close;
  800       Exit;
  801     end;
  802     ServerRe q := Piece (FileVersi onValue(Ap plication. ExeName, F ILE_VER_IN TERNALNAME ), ' ', 1) ;
  803     if (Clie ntVer <> S erverReq)  then
  804     begin
  805       InfoBo x('Client  "version"  does not m atch clien t "require d" server. ', TC_CLIE RR, MB_OK) ;
  806       Close;
  807       Exit;
  808     end;
  809     SAN := s CallV('XUS  PKI GET U PN', []);
  810     if SAN=' ' then Dig italSignin gSetup1.Vi sible := T rue
  811     else Dig italSignin gSetup1.Vi sible := F alse;
  812     if (Comp areVersion (ServerVer , ServerRe q) <> 0) t hen
  813     begin
  814       if (sC allV('ORWU  DEFAULT D IVISION',  [nil]) = ' 1') then
  815       begin
  816         if ( InfoBox('P roceed wit h mismatch ed Client  and Server  versions? ', TC_CLIE RR, MB_YES NO) = ID_N O) then
  817         begi n
  818           Cl ose;
  819           Ex it;
  820         end;
  821       end
  822       else
  823       begin
  824         if ( CompareVer sion(Serve rVer, Serv erReq) > 0 ) then //  Server new er than Re quired
  825         begi n
  826           //  NEXT LINE  COMMENTED  OUT - CHA NGED FOR V ERSION 19. 16, PATCH  OR*3*155:
  827           //       if G etUserPara m('ORWOR R EQUIRE CUR RENT CLIEN T') = '1'  then
  828           if  (true) th en // "Tru e" stateme nt guarant ees "requi red" curre nt version  client.
  829           be gin
  830              InfoBox(TX _VER1 + Cl ientVer +  TX_VER2 +  CRLF + Ser verReq + T X_VER_REQ  + TX_VER3  + ServerVe r + '.' +  TX_VER_OLD 2, TC_VER,  MB_OK);
  831              Close;
  832              Exit;
  833           en d;
  834         end
  835         else  InfoBox(T X_VER1 + C lientVer +  TX_VER2 +  CRLF + Se rverReq +  TX_VER_REQ  + TX_VER3  + ServerV er + '.' +  TX_VER_OL D, TC_VER,  MB_OK);
  836       end;
  837       if (Co mpareVersi on(ServerV er, Server Req) < 0)  then // Se rver older  then Requ ired
  838       begin
  839         Info Box(TX_VER 1 + Client Ver + TX_V ER2 + CRLF  + ServerR eq + TX_VE R_REQ + TX _VER3 + Se rverVer +  '.' + TX_V ER_NEW, TC _VER, MB_O K);
  840         Clos e;
  841         Exit ;
  842       end;
  843     end;
  844  
  845     // Add f uture tabs  here as t hey are cr eated/impl emented:
  846     if (
  847        (not  User.HasCo rTabs) and
  848        (not  User.HasRp tTab)
  849        )
  850     then
  851     begin
  852       InfoBo x('No vali d tabs ass igned', 'T ab Access  Problem',  MB_OK);
  853       Close;
  854       Exit;
  855     end;
  856     // Globa l flags se t by serve r
  857     IsLeJeun eActive :=  ServerHas Patch(Camp LejeunePat ch);
  858     SpansInt lDateLine  := SiteSpa nsIntlDate Line;
  859  
  860     // creat e creating  core obje cts
  861     Patient  := TPatien t.Create;
  862     Encounte r := TEnco unter.Crea te;
  863     Changes  := TChange s.Create;
  864     Notifica tions := T Notificati ons.Create ;
  865     RemoteSi tes := TRe moteSiteLi st.Create;
  866     RemoteRe ports := T RemoteRepo rtList.Cre ate;
  867     uTabList  := TStrin gList.Crea te;
  868     FlaggedP TList := T StringList .Create;
  869     HasFlag   := False;
  870     FlagList  := TStrin gList.Crea te;
  871     // set u p structur es specifi c to the u ser
  872     Caption  := TX_IN_U SE + Mixed Case(User. Name) + '   (' + Stri ng(RPCBrok erV.Server ) + ')';
  873     SetDebug Menu;
  874     if Inter activeRemi ndersActiv e then
  875       Notify WhenRemind ersChange( RemindersC hanged);
  876     // load  all the ta b pages
  877     FCreateP rogress :=  FCP_FORMS ;
  878     //Create Tab(TObjec t(frmProbl ems), Tfrm Problems,  CT_PROBLEM S, 'Proble ms');
  879     CreateTa b(CT_PROBL EMS, 'Prob lems');
  880     CreateTa b(CT_MEDS,      'Meds ');
  881     CreateTa b(CT_ORDER S,   'Orde rs');
  882     CreateTa b(CT_NOTES ,    'Note s');
  883     CreateTa b(CT_CONSU LTS, 'Cons ults');
  884     if ShowS urgeryTab  then Creat eTab(CT_SU RGERY,  'S urgery');
  885     CreateTa b(CT_DCSUM M,   'D/C  Summ');
  886     CreateTa b(CT_LABS,      'Labs ');
  887     CreateTa b(CT_REPOR TS,  'Repo rts');
  888     CreateTa b(CT_COVER ,    'Cove r Sheet');
  889     ShowHide ChartTabMe nus(mnuVie wChart);
  890     //  We d efer calli ng LoadUse rPreferenc es to UMIn itiate, so  that the  font sizin g
  891     // routi nes recogn ize this a s the appl ication's  main form  (this hasn 't been
  892     // set y et).
  893     FNextBut tonBitmap  := TBitmap .Create;
  894     FNextBut tonBitmap. LoadFromRe sourceName (hInstance , 'BMP_HAN DRIGHT');
  895     // set t he timeout  to DTIME  now that t here is a  connection
  896     UpdateTi meOutInter val(User.D TIME * 100 0);  // DT IME * 1000  mSec
  897     // get a  patient
  898     HandleNe eded;                                 // ma ke sure ha ndle is th ere for OR WPT SHARE  call
  899     FCreateP rogress :=  FCP_PTSEL ;
  900     Enabled  := False;
  901     FFirstLo ad := True ;                         // Fir st time to  initializ e the fFra me
  902     FCreateP rogress :=  FCP_FINIS H;
  903     pnlRemin ders.Visib le := Inte ractiveRem indersActi ve;
  904     GraphFlo atActive : = false;
  905     GraphCon text := '' ;
  906     frmGraph Data := Tf rmGraphDat a.Create(s elf);         // form  is only v isible for  testing
  907     GraphDat aOnUser;
  908     uRemoteT ype := '';
  909     uReportI D := '';
  910     uLabRepI D := '';
  911     FPrevPtI D := '';
  912     SetUserT ools;
  913     Enduring PtSelSplit terPos :=  0;
  914     Enduring PtSelColum ns := '';
  915     if User. IsReportsO nly then / / Reports  Only tab.
  916       Report sOnlyDispl ay; // Cal ls procedu re to hide  all compo nents/menu s not need ed.
  917     InitialO rderVariab les;
  918     PostMess age(Handle , UM_INITI ATE, 0, 0) ;    // se lect patie nt after m ain form i s created
  919     SetFormM onitoring( true);
  920  
  921   end;
  922  
  923   procedure  TfrmFrame. StartCCOWC ontextor;
  924   begin
  925     try
  926       ctxCon textor :=  TContextor Control.Cr eate(Self) ;
  927       with c txContexto r do
  928         begi n
  929           On Pending :=  ctxContex torPending ;
  930           On Committed  := ctxCont extorCommi tted;
  931           On Canceled : = ctxConte xtorCancel ed;
  932         end;
  933       FCCOWB usy := Fal se;
  934       FCCOWI nstalled : = True;
  935       FCCOWD rivedChang e := False ;
  936       ctxCon textor.Run ('CPRSChar t', '', TR UE, 'Patie nt');
  937       IsRunE xecuted :=  True;
  938     except
  939       on exc  : EOleExc eption do
  940       begin
  941         IsRu nExecuted  := False;
  942         Free AndNil(ctx Contextor) ;
  943         try
  944           ct xContextor  := TConte xtorContro l.Create(S elf);
  945           wi th ctxCont extor do
  946              begin
  947                OnPendin g := ctxCo ntextorPen ding;
  948                OnCommit ted := ctx ContextorC ommitted;
  949                OnCancel ed := ctxC ontextorCa nceled;
  950              end;
  951           FC COWBusy :=  False;
  952           FC COWInstall ed := True ;
  953           FC COWDrivedC hange := F alse;
  954           ct xContextor .Run('CPRS Chart' + ' #', '', TR UE, 'Patie nt');
  955           Is RunExecute d := True;
  956           if  ParamSear ch('CCOW')  = 'FORCE'  then
  957           be gin
  958              mnuFileRes umeContext .Enabled : = False;
  959              mnuFileBre akContext. Visible :=  True;
  960              mnuFileBre akContext. Enabled :=  True;
  961           en d
  962           el se
  963           be gin
  964              ctxContext or.Suspend ;
  965              mnuFileRes umeContext .Visible : = True;
  966              mnuFileBre akContext. Visible :=  True;
  967              mnuFileBre akContext. Enabled :=  False;
  968           en d;
  969         exce pt
  970           Is RunExecute d := False ;
  971           FC COWInstall ed := Fals e;
  972           Fr eeAndNil(c txContexto r);
  973           pn lCCOW.Visi ble := Fal se;
  974           mn uFileResum eContext.V isible :=  False;
  975           mn uFileBreak Context.Vi sible := F alse;
  976         end;
  977       end;
  978     end
  979   end;
  980  
  981   procedure  TfrmFrame. UMInitiate (var Messa ge: TMessa ge);
  982   begin
  983     NotifyOt herApps(NA E_OPEN, In tToStr(Use r.DUZ));
  984     LoadUser Preference s;
  985     GetBASta tus(User.D UZ,Patient .DFN);
  986     mnuFileO penClick(S elf);
  987     Enabled  := True;
  988     // If Ti medOut, Cl ose has al ready been  called.
  989     if not T imedOut an d (Patient .DFN = '')  then Clos e;
  990   end;
  991  
  992   procedure  TfrmFrame. FormDestro y(Sender:  TObject);
  993   { free cor e objects  used by CP RS }
  994   begin
  995     Applicat ion.OnActi vate := FO ldActivate ;
  996     Screen.O nActiveFor mChange :=  FOldActiv eFormChang e;
  997     FNextBut tonBitmap. Free;
  998     if FNext Button <>  nil then F NextButton .Free;
  999     uTabList .Free;
  1000     FlaggedP TList.Free ;
  1001     RemoteSi tes.Free;
  1002     RemoteRe ports.Free ;
  1003     Notifica tions.Free ;
  1004     Changes. Free;
  1005     Encounte r.Free;
  1006     Patient. Free;
  1007     User.Fre e;
  1008     SizeHold er.Free;
  1009     ctxConte xtor.Free;
  1010     frmDebug Report.Fre e;
  1011   end;
  1012  
  1013   procedure  TfrmFrame. FormCloseQ uery(Sende r: TObject ; var CanC lose: Bool ean);
  1014   { cancels  close if t he user ca ncels the  ReviewChan ges screen  }
  1015   var
  1016     Reason:  string;
  1017   begin
  1018     if (FCre ateProgres s < FCP_FI NISH) then  Exit;
  1019     if User. IsReportsO nly then / / Reports  Only tab.
  1020       exit;
  1021     if Timed Out then
  1022       begin
  1023         if C hanges.Req uireReview  then Revi ewChanges( TimedOut);
  1024         Exit ;
  1025       end;
  1026     if not A llowContex tChangeAll (Reason) t hen CanClo se := Fals e;
  1027   end;
  1028  
  1029   procedure  TfrmFrame. SetUserToo ls;
  1030   var
  1031     item, pa rent: TToo lMenuItem;
  1032     ok: bool ean;
  1033     index, i , idx, cou nt: Intege r;
  1034     UserTool : TMenuIte m;
  1035     Menus: T StringList ;
  1036   begin
  1037     if User. IsReportsO nly then / / Reports  Only tab.
  1038     begin
  1039       mnuToo ls.Clear;  // Remove  all curren t items.
  1040       UserTo ol := TMen uItem.Crea te(Self);
  1041       UserTo ol.Caption  := 'Optio ns...';
  1042       UserTo ol.Hint :=  'Options' ;
  1043       UserTo ol.OnClick  := mnuToo lsOptionsC lick;
  1044       mnuToo ls.Add(Use rTool); //  Add back  the "Optio ns" menu.
  1045       exit;
  1046     end;
  1047     if User. GECStatus  then
  1048     begin
  1049       UserTo ol := TMen uItem.Crea te(self);
  1050       UserTo ol.Caption  := 'GEC R eferral St atus Displ ay';
  1051       UserTo ol.Hint :=  'GEC Refe rral Statu s Display' ;
  1052       UserTo ol.OnClick  := mnuGEC StatusClic k;
  1053       mnuToo ls.Add(Use rTool); //  Add back  the "Optio ns" menu.
  1054     end;
  1055     GetToolM enu; // Fo r all othe r users, p roceed nor mally with  creation  of Tools m enu:
  1056     for i :=  uToolMenu Items.Coun t-1 downto  0 do
  1057     begin
  1058       item : = TToolMen uItem(uToo lMenuItems [i]);
  1059       if (An siCompareT ext(item.C aption, 'E vent Captu re Interfa ce') = 0 )  and
  1060          (no t uECSRepo rt.ECSPerm it) then
  1061       begin
  1062         uToo lMenuItems .Delete(i) ;
  1063         Brea k;
  1064       end;
  1065     end;
  1066     Menus :=  TStringLi st.Create;
  1067     try
  1068       count  := 0;
  1069       idx :=  0;
  1070       index  := 0;
  1071       while  count < uT oolMenuIte ms.Count d o
  1072       begin
  1073         for  I := 0 to  uToolMenuI tems.Count  - 1 do
  1074         begi n
  1075           it em := TToo lMenuItem( uToolMenuI tems[i]);
  1076           if  assigned( item.MenuI tem) then  continue;
  1077           if  item.SubM enuID = ''  then
  1078              ok := True
  1079           el se
  1080           be gin
  1081              idx := Men us.IndexOf (item.SubM enuID);
  1082              ok := (idx  >= 0);
  1083           en d;
  1084           if  ok then
  1085           be gin
  1086              inc(count) ;
  1087              UserTool : = TMenuIte m.Create(S elf);
  1088              UserTool.C aption :=  Item.Capti on;
  1089              if Item.Ac tion <> ''  then
  1090              begin
  1091                UserTool .Hint := I tem.Action ;
  1092                UserTool .OnClick : = ToolClic k;
  1093              end;
  1094              Item.MenuI tem := Use rTool;
  1095              if item.Su bMenuID =  '' then
  1096              begin
  1097                mnuTools .Insert(In dex,UserTo ol);
  1098                inc(Inde x);
  1099              end
  1100              else
  1101              begin
  1102                parent : = TToolMen uItem(Menu s.Objects[ idx]);
  1103                parent.M enuItem.Ad d(UserTool );
  1104              end;
  1105              if item.Me nuID <> ''  then
  1106                Menus.Ad dObject(it em.MenuID,  item);
  1107           en d;
  1108         end;
  1109       end;
  1110     finally
  1111       Menus. Free;
  1112     end;
  1113     FreeAndN il(uToolMe nuItems);
  1114   end;
  1115  
  1116   procedure  TfrmFrame. UpdateECSP arameter(v ar CmdPara meter: str ing);  //E CS
  1117   var
  1118     vstID,Ac cVer,Svr,S vrPort,VUs er: string ;
  1119   begin
  1120     AccVer   := '';
  1121     Svr      := '';
  1122     SvrPort  := '';
  1123     VUser    := '';
  1124     if RPCBr okerV <> n il then
  1125     begin
  1126       AccVer   := Strin g(RPCBroke rV.AccessV erifyCodes );
  1127       Svr      := Strin g(RPCBroke rV.Server) ;
  1128       SvrPor t := IntTo Str(RPCBro kerV.Liste nerPort);
  1129       VUser    := RPCBr okerV.User .DUZ;
  1130     end;
  1131     vstID :=  GetVisitI D;
  1132     CmdParam eter :=' S vr=' +Svr
  1133                     +'  SvrPort='+ SvrPort
  1134                     +'  VUser='+ V User
  1135                     +'  PtIEN='+ P atient.DFN
  1136                     +'  PdIEN='+In tToStr(Enc ounter.Pro vider)
  1137                     +'  vstIEN='+v stID
  1138                     +'  locIEN='+I ntToStr(En counter.Lo cation)
  1139                     +'  Date=0'
  1140                     +'  Division=' +GetDivisi onID;
  1141  
  1142   end;
  1143  
  1144   procedure  TfrmFrame. compAccess TabPageCap tionQuery( Sender: TO bject;
  1145     var Text : string);
  1146   begin
  1147     Text :=  GetTabText ;
  1148   end;
  1149  
  1150   function T frmFrame.V alidECSUse r: boolean ;   //ECS
  1151   var
  1152     isTrue:  boolean;
  1153   begin
  1154     Result : = True;
  1155     with RPC BrokerV do
  1156     begin
  1157       ShowEr rorMsgs :=  semQuiet;
  1158       Connec ted     :=  True;
  1159      try
  1160         isTr ue := Crea teContext( TX_ECSOPT) ;
  1161         if n ot isTrue  then
  1162           Re sult := Fa lse;
  1163         Show ErrorMsgs  := semRais e;
  1164       except
  1165         on E : Exceptio n do
  1166         begi n
  1167           Sh owErrorMsg s := semRa ise;
  1168           Re sult := Fa lse;
  1169         end;
  1170       end;
  1171     end;
  1172   end;
  1173  
  1174   procedure  TfrmFrame. FormClose( Sender: TO bject; var  Action: T CloseActio n);
  1175   begin
  1176     FClosing  := TRUE;
  1177     SetFormM onitoring( false);
  1178  
  1179     if FCrea teProgress  < FCP_FIN ISH then F Terminate  := True;
  1180  
  1181     FlushNot ifierBuffe r;
  1182     if FCrea teProgress  = FCP_FIN ISH then N otifyOther Apps(NAE_C LOSE, '');
  1183     Terminat eOtherAppN otificatio n;
  1184  
  1185     if Graph Float <> n il then
  1186     begin
  1187       if frm Frame.Grap hFloatActi ve then
  1188         Grap hFloat.Clo se;
  1189       GraphF loat.Relea se;
  1190     end;
  1191  
  1192     // unhoo k the time out hooks
  1193     ShutDown TimeOut;
  1194     // clear ing change s will unl ock notes
  1195     if FCrea teProgress  = FCP_FIN ISH then C hanges.Cle ar;
  1196     // clear  server si de flag gl obal tmp
  1197     if FCrea teProgress  = FCP_FIN ISH then C learFlag;
  1198     // save  user prefe rences
  1199     if FCrea teProgress  = FCP_FIN ISH then S aveUserPre ferences;
  1200     // call  close for  each page  in case th ere is any  special p rocessing
  1201     if FCrea teProgress  > FCP_FOR MS then
  1202     begin
  1203       mnuFra me.Merge(n il);
  1204       frmCov er.Close;       //frm Cover.Rele ase;
  1205       frmPro blems.Clos e;   //frm Problems.R elease;
  1206       frmMed s.Close;        //frm Meds.Relea se;
  1207       frmOrd ers.Close;      //frm Orders.Rel ease;
  1208       frmNot es.Close;       //frm Notes.Rele ase;
  1209       frmCon sults.Clos e;   //frm Consults.R elease;
  1210       frmDCS umm.Close;      //frm DCSumm.Rel ease;
  1211       if Ass igned(frmS urgery) th en frmSurg ery.Close;     //frmS urgery.Rel ease;
  1212       frmLab s.Close;        //frm Labs.Relea se;
  1213       frmRep orts.Close ;    //frm Reports.Re lease;
  1214       frmGra phData.Clo se;  //frm GraphData. Release;
  1215  
  1216     end;
  1217     // if <  FCP_FINISH  we came h ere from i nside Form Create, so  need to c all termin ate
  1218     if FCrea teProgress  < FCP_FIN ISH then A pplication .Terminate ;
  1219   end;
  1220  
  1221   procedure  TfrmFrame. SetDebugMe nu;
  1222   var
  1223     IsProgra mmer: Bool ean;
  1224   begin
  1225     IsProgra mmer := Us er.HasKey( 'XUPROGMOD E') or (Sh owRPCList  = True);
  1226     mnuHelpB roker.Visi ble   := I sProgramme r;
  1227     mnuHelpL ists.Visib le    := I sProgramme r;
  1228     mnuHelpS ymbols.Vis ible  := I sProgramme r;
  1229     mnuFocus Changes.Vi sible := I sProgramme r;  {added  10 May 20 12  dlp se e fFocusCo ntrols }
  1230     Z6.Visib le               := I sProgramme r;
  1231   end;
  1232  
  1233   { Updates  posted to  MainForm - ---------- ---------- ---------- ---------- ---------- ---------- -- }
  1234  
  1235   procedure  TfrmFrame. UMNewOrder (var Messa ge: TMessa ge);
  1236   { post a n otice of c hange in o rders to a ll TPages,  wParam=Or derAction,  lParam=TO rder }
  1237   var
  1238     OrderAct : string;
  1239   begin
  1240     with Mes sage do
  1241     begin
  1242       frmCov er.NotifyO rder(WPara m, TOrder( LParam));
  1243       frmPro blems.Noti fyOrder(WP aram, TOrd er(LParam) );
  1244       frmMed s.NotifyOr der(WParam , TOrder(L Param));
  1245       frmOrd ers.Notify Order(WPar am, TOrder (LParam));
  1246       frmNot es.NotifyO rder(WPara m, TOrder( LParam));
  1247       frmCon sults.Noti fyOrder(WP aram, TOrd er(LParam) );
  1248       frmDCS umm.Notify Order(WPar am, TOrder (LParam));
  1249       if Ass igned(frmS urgery) th en frmSurg ery.Notify Order(WPar am, TOrder (LParam));
  1250       frmLab s.NotifyOr der(WParam , TOrder(L Param));
  1251       frmRep orts.Notif yOrder(WPa ram, TOrde r(LParam)) ;
  1252       lblPtC WAD.Captio n := GetCW ADInfo(Pat ient.DFN);
  1253       if Len gth(lblPtC WAD.Captio n) > 0 the n
  1254         lblP tPostings. Caption :=  'Postings '
  1255       else
  1256         lblP tPostings. Caption :=  'No Posti ngs';
  1257       pnlPos tings.Capt ion := lbl PtPostings .Caption +  ' ' + lbl PtCWAD.Cap tion;
  1258       OrderA ct := '';
  1259       case W Param of
  1260         ORDE R_NEW:   O rderAct :=  'NW';
  1261         ORDE R_DC:    O rderAct :=  'DC';
  1262         ORDE R_RENEW: O rderAct :=  'RN';
  1263         ORDE R_HOLD:  O rderAct :=  'HD';
  1264         ORDE R_EDIT:  O rderAct :=  'XX';
  1265         ORDE R_ACT:   O rderAct :=  'AC';
  1266       end;
  1267       if Len gth(OrderA ct) > 0 th en NotifyO therApps(N AE_ORDER,  OrderAct +  U + TOrde r(LParam). ID);  // a dd FillerI D
  1268     end;
  1269   end;
  1270  
  1271   { Tab Sele ction (nav igate betw een pages)  --------- ---------- ---------- ---------- ---------- -- }
  1272  
  1273   procedure  TfrmFrame. WMSetFocus (var Messa ge: TMessa ge);
  1274   begin
  1275     if (FLas tPage <> n il) and (n ot TimedOu t) and
  1276        (not  (csDestroy ing in FLa stPage.Com ponentStat e)) and FL astPage.Vi sible then
  1277       FLastP age.FocusF irstContro l;
  1278   end;
  1279  
  1280   procedure  TfrmFrame. UMShowPage (var Messa ge: TMessa ge);
  1281   { shows a  page when  the UM_SHO WPAGE mess age is rec eived }
  1282   begin
  1283     if FCCOW DrivedChan ge then FC COWDrivedC hange := F alse;
  1284     if FLast Page <> ni l then FLa stPage.Dis playPage;
  1285     FChangeS ource := C C_CLICK;   // reset t o click so  we're onl y dealing  with excep tions to c lick
  1286     if assig ned(FTabCh anged) the n
  1287       FTabCh anged(Self );
  1288   end;
  1289  
  1290   procedure  TfrmFrame. SwitchToPa ge(NewForm : TfrmPage );
  1291   { unmerge/ merge menu s, bring p age to top  of z-orde r, call fo rm-specifi c OnDispla y code }
  1292   begin
  1293     if FLast Page = New Form then
  1294       begin
  1295         if N otificatio ns.Active  and Assign ed(NewForm ) then Pos tMessage(H andle, UM_ SHOWPAGE,  0, 0);
  1296         Exit ;
  1297       end;
  1298     if (FLas tPage <> n il) then
  1299     begin
  1300       mnuFra me.Unmerge (FLastPage .Menu);
  1301       FLastP age.Hide;
  1302     end;
  1303     if Assig ned(NewFor m) then be gin
  1304       mnuFra me.Merge(N ewForm.Men u);
  1305       NewFor m.Show;
  1306       FormRe size(Self) ;
  1307     end;
  1308     lstCIRNL ocations.V isible :=  False;
  1309     pnlCIRN. BevelOuter  := bvRais ed;
  1310     lstCIRNL ocations.S endToBack;
  1311     mnuFileP rint.Enabl ed := Fals e;            // let  individual  page enab le this
  1312     mnuFileP rintSetup. Enabled :=  False;       // let  individual  page enab le this
  1313     mnuFileP rintSelect edItems.En abled := F alse;
  1314     FLastPag e := NewFo rm;
  1315     if NewFo rm <> nil  then
  1316     begin
  1317       if New Form.Name  = frmNotes .Name then  frmNotes. Align := a lClient
  1318         else  frmNotes. Align := a lNone;
  1319       if New Form.Name  = frmConsu lts.Name t hen frmCon sults.Alig n := alCli ent
  1320         else  frmConsul ts.Align : = alNone;
  1321       if New Form.Name  = frmRepor ts.Name th en frmRepo rts.Align  := alClien t
  1322         else  frmReport s.Align :=  alNone;
  1323       if New Form.Name  = frmDCSum m.Name the n frmDCSum m.Align :=  alClient
  1324         else  frmDCSumm .Align :=  alNone;
  1325       if Ass igned(frmS urgery) th en
  1326         if N ewForm.Nam e = frmSur gery.Name  then frmSu rgery.Alig n := alcli ent
  1327           el se frmSurg ery.Align  := alNone;
  1328       NewFor m.BringToF ront;                      // to  cause tab  switch to  happen im mediately
  1329       Applic ation.Proc essMessage s;
  1330       PostMe ssage(Hand le, UM_SHO WPAGE, 0,  0);  // th is calls D isplayPage  for the f orm
  1331     end;
  1332   end;
  1333  
  1334   procedure  TfrmFrame. mnuDebugRe portClick( Sender: TO bject);
  1335   begin
  1336     inherite d;
  1337     if not A ssigned(fr mDebugRepo rt) then f rmDebugRep ort := Tfr mDebugRepo rt.Create( self);
  1338      frmDebu gReport.Sh ow;
  1339   end;
  1340  
  1341   procedure  TfrmFrame. mnuChartTa bClick(Sen der: TObje ct);
  1342   { use the  Tag proper ty of the  menu item  to switch  to proper  page }
  1343   begin
  1344     with Sen der as TMe nuItem do  tabPage.Ta bIndex :=  PageIDToTa b(Tag);
  1345     LastTab  := TabToPa geID(tabPa ge.TabInde x) ;
  1346     tabPageC hange(tabP age);
  1347   end;
  1348  
  1349   procedure  TfrmFrame. tabPageCha nge(Sender : TObject) ;
  1350   { switches  to form l inked to N ewTab }
  1351   var
  1352     PageID :  integer;
  1353   begin
  1354     PageID : = TabToPag eID((sende r as TTabC ontrol).Ta bIndex);
  1355     if (Page ID <> CT_N OPAGE) and  (TabPage. CanFocus)  and Assign ed(FLastPa ge) and
  1356        (not  TabPage.Fo cused) the n
  1357       TabPag e.SetFocus ;  //CQ: 1 4854
  1358     if (not  User.IsRep ortsOnly)  then
  1359     begin
  1360       case P ageID of
  1361         CT_N OPAGE:   S witchToPag e(nil);
  1362         CT_C OVER:    S witchToPag e(frmCover );
  1363         CT_P ROBLEMS: S witchToPag e(frmProbl ems);
  1364         CT_M EDS:     S witchToPag e(frmMeds) ;
  1365         CT_O RDERS:   S witchToPag e(frmOrder s);
  1366         CT_N OTES:    S witchToPag e(frmNotes );
  1367         CT_C ONSULTS: S witchToPag e(frmConsu lts);
  1368         CT_D CSUMM:   S witchToPag e(frmDCSum m);
  1369         CT_S URGERY:  S witchToPag e(frmSurge ry);
  1370         CT_L ABS:     S witchToPag e(frmLabs) ;
  1371         CT_R EPORTS:  S witchToPag e(frmRepor ts);
  1372       end; { case}
  1373     end
  1374     else //  Reports On ly tab.
  1375       Switch ToPage(frm Reports);
  1376     if Scree nReaderSys temActive  and FCtrlT abUsed the n
  1377       SpeakP atient;
  1378     Changing Tab := Pag eID;
  1379   end;
  1380  
  1381   function T frmFrame.P ageIDToTab (PageID: I nteger): I nteger;
  1382   { returns  the tab in dex that c orresponds  to a give n PageID }
  1383   VAR
  1384     i: integ er;
  1385   begin
  1386     i :=  uT abList.Ind exOf(IntTo Str(PageID ));
  1387     Result : = i;
  1388   end;
  1389  
  1390   function T frmFrame.T abToPageID (Tab: Inte ger): Inte ger;
  1391   { returns  the consta nt that id entifies t he page gi ven a TabI ndex }
  1392   begin
  1393     if (Tab  > -1) and  (Tab < uTa bList.Coun t) then
  1394       Result  := StrToI ntDef(uTab List[Tab],  CT_UNKNOW N)
  1395     else
  1396       Result  := CT_NOP AGE;
  1397   end;
  1398  
  1399   { File Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  1400  
  1401   procedure  TfrmFrame. SetupPatie nt(AFlagge dList : TS tringList) ;
  1402   var
  1403     AMsg, Se lectMsg: s tring;
  1404   begin
  1405     with Pat ient do
  1406     begin
  1407       ClearP atient;  / / must be  called to  avoid leav ing previo us patient 's informa tion visib le!
  1408       btnCom batVet.Cap tion := 'C V '+ Comba tVet.Expir ationDate;
  1409       btnCom batVet.Vis ible := Pa tient.Comb atVet.IsEl igible;
  1410       Visibl e := True;
  1411       Applic ation.Proc essMessage s;
  1412       lblPtN ame.Captio n := Name  + Status;  //CQ #1749 1: Allow f or the dis play of th e patient  status ind icator in  header bar .
  1413       lblPtS SN.Caption  := SSN;
  1414       lblPtA ge.Caption  := Format FMDateTime ('mmm dd,y yyy', DOB)  + ' (' +  IntToStr(A ge) + ')';
  1415       pnlPat ient.Capti on := lblP tName.Capt ion + ' '  + lblPtSSN .Caption +  ' ' + lbl PtAge.Capt ion;
  1416       if Len gth(CWAD)  > 0
  1417         then  lblPtPost ings.Capti on := 'Pos tings'
  1418         else  lblPtPost ings.Capti on := 'No  Postings';
  1419       lblPtC WAD.Captio n := CWAD;
  1420       pnlPos tings.Capt ion := lbl PtPostings .Caption +  ' ' + lbl PtCWAD.Cap tion;
  1421       if (Le ngth(Prima ryTeam) >  0) or (Len gth(Primar yProvider)  > 0) then
  1422       begin
  1423         lblP tCare.Capt ion := Pri maryTeam +  ' / ' + M ixedCase(P rimaryProv ider);
  1424         if L ength(Asso ciate)>0 t hen lblPtC are.Captio n :=  lblP tCare.Capt ion + ' /  ' + MixedC ase(Associ ate);
  1425       end;
  1426       if Len gth(Attend ing) > 0 t hen lblPtA ttending.C aption :=  '(Inpatien t) Attendi ng:  ' + M ixedCase(A ttending);
  1427       pnlPri maryCare.C aption :=  lblPtCare. Caption +  ' ' + lblP tAttending .Caption;
  1428       if Len gth(InProv ider) > 0   then lblP tAttending .Caption : = lblPtAtt ending.Cap tion + ' -  (Inpatien t) Provide r: ' + Mix edCase(InP rovider);
  1429       if Len gth(MHTC)  > 0 then l blPtMHTC.C aption :=  'MH Treatm ent Coordi nator: ' +  MixedCase (MHTC);
  1430       if (Le ngth(MHTC)  = 0) and  (Inpatient  = True) a nd (Specia ltySvc = ' P') then
  1431         lblP tMHTC.Capt ion := 'MH  Treatment  Coordinat or Unassig ned';
  1432       pnlPri maryCare.C aption :=  lblPtCare. Caption +  ' ' + lblP tAttending .Caption +  ' ' + lbl PtMHTC.Cap tion;
  1433       SetUpC IRN;
  1434       Displa yEncounter Text;
  1435       SetSha reNode(DFN , Handle);
  1436       with P atient do
  1437         Noti fyOtherApp s(NAE_NEWP T, SSN + U  + FloatTo Str(DOB) +  U + Name) ;
  1438       Select Msg := '';
  1439       if Mea nsTestRequ ired(Patie nt.DFN, AM sg) then S electMsg : = AMsg;
  1440       if Has LegacyData (Patient.D FN, AMsg)      then S electMsg : = SelectMs g + CRLF +  AMsg;
  1441  
  1442       HasAct iveFlg(Fla gList, Has Flag, Pati ent.DFN);
  1443       if Has Flag then  begin
  1444         txtC mdFlags.Vi sible := f alse;
  1445         pnlF lag.Enable d := True;
  1446         lblF lag.Font.C olor := Ge t508Compli antColor(c lMaroon);
  1447         lblF lag.Enable d := True;
  1448         if ( not FReFre shing) and  (TriggerP RFPopUp(Pa tient.DFN) ) then
  1449           Sh owFlags;
  1450       end el se begin
  1451         txtC mdFlags.Vi sible := S creenReade rSystemAct ive;
  1452         pnlF lag.Enable d := False ;
  1453         lblF lag.Font.C olor := cl BtnFace;
  1454         lblF lag.Enable d := False ;
  1455       end;
  1456       FPrevP tID := pat ient.DFN;
  1457       frmCov er.UpdateV AAButton;  //VAA CQ75 25  (moved  here in v 26.30 (RV) )
  1458       Proces sPatientCh angeEventH ook;
  1459       if Len gth(Select Msg) > 0 t hen ShowPa tientSelec tMessages( SelectMsg) ;
  1460     end;
  1461   end;
  1462  
  1463   procedure  TfrmFrame. mnuFileNex tClick(Sen der: TObje ct);
  1464   var
  1465     SaveDFN,  NewDFN: s tring; //  *DFN*
  1466     NextInde x: Integer ;
  1467     Reason:  string;
  1468     CCOWResp onse: User Response;
  1469     AccessSt atus: inte ger;
  1470  
  1471       proced ure Update PatientInf oForAlert;
  1472       begin
  1473         if P atient.Inp atient the n begin
  1474           En counter.In patient :=  True;
  1475           En counter.Lo cation :=  Patient.Lo cation;
  1476           En counter.Da teTime :=  Patient.Ad mitTime;
  1477           En counter.Vi sitCategor y := 'H';
  1478         end;
  1479         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  1480         Setu pPatient(F laggedPTLi st);
  1481         if ( FlaggedPTL ist.IndexO f(Patient. DFN) < 0)  then
  1482           Fl aggedPTLis t.Add(Pati ent.DFN);
  1483       end;
  1484  
  1485   begin
  1486     DoNotCha ngeEncWind ow := Fals e;
  1487     OrderPri ntForm :=  False;
  1488     mnuFile. Tag := 0;
  1489     SaveDFN  := Patient .DFN;
  1490     Notifica tions.Next ;
  1491     if Notif ications.A ctive then
  1492     begin
  1493       NewDFN  := Notifi cations.DF N;
  1494       if Sav eDFN <> Ne wDFN then
  1495       begin
  1496         // n ewdfn does  not have  new patien t.co infor mation for  CCOW call
  1497         if ( (Sender =  mnuFileOpe n) or (All owContextC hangeAll(R eason)))
  1498              and AllowA ccessToSen sitivePati ent(NewDFN , AccessSt atus) then
  1499         begi n
  1500           Re mindersSta rted := FA LSE;
  1501           Pa tient.DFN  := NewDFN;
  1502           En counter.Cl ear;
  1503           Ch anges.Clea r;
  1504           if  Assigned( FlagList)  then
  1505           be gin
  1506            F lagList.Cl ear;
  1507            H asFlag :=  False;
  1508            H asActiveFl g(FlagList , HasFlag,  NewDFN);
  1509           en d;
  1510           if  FCCOWInst alled and  (ctxContex tor.State  = csPartic ipating) t hen
  1511              begin
  1512                if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n
  1513                  Update PatientInf oForAlert
  1514                else
  1515                  begin
  1516                    case  CCOWRespo nse of
  1517                      ur Cancel:
  1518                         begin
  1519                           Patient. DFN := Sav eDFN;
  1520                           Notifica tions.Prio r;
  1521                           Exit;
  1522                         end;
  1523                      ur Break:
  1524                         begin
  1525                           // do no t revert t o old DFN  if context  was manua lly broken  by user -  v26 (RV)
  1526                           if (ctxC ontextor.S tate = csP articipati ng) then P atient.DFN  := SaveDF N;
  1527                           UpdatePa tientInfoF orAlert;
  1528                         end;
  1529                      el se
  1530                         UpdatePati entInfoFor Alert;
  1531                    end;
  1532                  end;
  1533              end
  1534           el se
  1535              UpdatePati entInfoFor Alert
  1536         end  else
  1537         begi n
  1538           if  AccessSta tus in [DG SR_ASK, DG SR_DENY] t hen
  1539           be gin
  1540              Notificati ons.Clear;
  1541              // hide th e 'next no tification ' button
  1542              FNextButto nActive :=  False;
  1543              FNextButto n.Free;
  1544              FNextButto n := nil;
  1545              mnuFileNex t.Enabled  := False;
  1546              mnuFileNot ifRemove.E nabled :=  False;
  1547              Patient.DF N := '';
  1548              mnuFileOpe nClick(mnu FileNext);
  1549              exit;
  1550           en d
  1551           el se
  1552           if  SaveDFN < > '' then
  1553           be gin
  1554              Patient.DF N := SaveD FN;
  1555              Notificati ons.Prior;
  1556              Exit;
  1557           en d
  1558           el se
  1559           be gin
  1560              Notificati ons.Clear;
  1561              Patient.DF N := '';
  1562              mnuFileOpe nClick(mnu FileNext);
  1563              exit;
  1564           en d;
  1565         end;
  1566       end;
  1567       stsAre a.Panels.I tems[1].Te xt := Noti fications. Text;
  1568       FChang eSource :=  CC_NOTIFI CATION;
  1569       NextIn dex := Pag eIDToTab(C T_COVER);
  1570       tabPag e.TabIndex  := CT_NOP AGE;
  1571       tabPag eChange(ta bPage);
  1572       mnuFil eNotifRemo ve.Enabled  := Notifi cations.Fo llowup in  [NF_FLAGGE D_ORDERS,
  1573                                                                      NF_ORDER_ REQUIRES_E LEC_SIGNAT URE,
  1574                                                                      NF_MEDICA TIONS_EXPI RING_INPT,
  1575                                                                      NF_MEDICA TIONS_EXPI RING_OUTPT ,
  1576                                                                      NF_UNVERI FIED_MEDIC ATION_ORDE R,
  1577                                                                      NF_UNVERI FIED_ORDER ,
  1578                                                                      NF_FLAGGE D_OI_EXP_I NPT,
  1579                                                                      NF_FLAGGE D_OI_EXP_O UTPT];
  1580       case N otificatio ns.FollowU p of
  1581         NF_L AB_RESULTS                     :  NextIndex  := PageID ToTab(CT_L ABS);
  1582         NF_F LAGGED_ORD ERS                 :  NextIndex  := PageID ToTab(CT_O RDERS);
  1583         NF_O RDER_REQUI RES_ELEC_S IGNATURE :  NextIndex  := PageID ToTab(CT_O RDERS);
  1584         NF_A BNORMAL_LA B_RESULTS           :  NextIndex  := PageID ToTab(CT_L ABS);
  1585         NF_I MAGING_RES ULTS                :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1586         NF_C ONSULT_REQ UEST_RESOL UTION    :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1587         NF_A BNORMAL_IM AGING_RESU LTS      :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1588         NF_I MAGING_REQ UEST_CANCE L_HELD   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1589         NF_N EW_SERVICE _CONSULT_R EQUEST   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1590         NF_C ONSULT_REQ UEST_CANCE L_HOLD   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1591         NF_S ITE_FLAGGE D_RESULTS           :  NextIndex  := PageID ToTab(CT_O RDERS);
  1592         NF_O RDERER_FLA GGED_RESUL TS       :  NextIndex  := PageID ToTab(CT_O RDERS);
  1593         NF_O RDER_REQUI RES_COSIGN ATURE    :  NextIndex  := PageID ToTab(CT_O RDERS);
  1594         NF_L AB_ORDER_C ANCELED             :  NextIndex  := PageID ToTab(CT_O RDERS);
  1595         NF_S TAT_RESULT S                   :
  1596           if  Piece(Pie ce(Notific ations.Ale rtData, '| ', 2), '@' , 2) = 'LR CH' then
  1597              NextIndex  := PageIDT oTab(CT_LA BS)
  1598           el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2)  = 'GMRC' t hen
  1599              NextIndex  := PageIDT oTab(CT_CO NSULTS)
  1600           el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2)  = 'RA' the n
  1601              NextIndex  := PageIDT oTab(CT_RE PORTS);
  1602         NF_D NR_EXPIRIN G                   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1603         NF_M EDICATIONS _EXPIRING_ INPT     :  NextIndex  := PageID ToTab(CT_O RDERS);
  1604         NF_M EDICATIONS _EXPIRING_ OUTPT    :  NextIndex  := PageID ToTab(CT_O RDERS);
  1605         NF_U NVERIFIED_ MEDICATION _ORDER   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1606         NF_R X_RENEWAL_ REQUEST             :
  1607           be gin
  1608              if (Notifi cations.Al ertData =  '') then
  1609              begin
  1610                Notifica tions.Dele te;
  1611              end;
  1612              NextIndex  := PageIDT oTab(CT_OR DERS);
  1613           en d;
  1614         NF_L APSED_ORDE R                   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1615         NF_N EW_ORDER                       :  NextIndex  := PageID ToTab(CT_O RDERS);
  1616         NF_I MAGING_RES ULTS_AMEND ED       :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1617         NF_C RITICAL_LA B_RESULTS           :  NextIndex  := PageID ToTab(CT_L ABS);
  1618         NF_U NVERIFIED_ ORDER               :  NextIndex  := PageID ToTab(CT_O RDERS);
  1619         NF_F LAGGED_OI_ RESULTS             :  NextIndex  := PageID ToTab(CT_O RDERS);
  1620         NF_F LAGGED_OI_ ORDER               :  NextIndex  := PageID ToTab(CT_O RDERS);
  1621         NF_D C_ORDER                        :  NextIndex  := PageID ToTab(CT_O RDERS);
  1622         NF_D EA_AUTO_DC _CS_MED_OR DER      :  NextIndex  := PageID ToTab(CT_O RDERS);
  1623         NF_D EA_CERT_RE VOKED               :  NextIndex  := PageID ToTab(CT_O RDERS);
  1624         NF_C ONSULT_UNS IGNED_NOTE          :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1625         NF_D CSUMM_UNSI GNED_NOTE           :  NextIndex  := PageID ToTab(CT_D CSUMM);
  1626         NF_N OTES_UNSIG NED_NOTE            :  NextIndex  := PageID ToTab(CT_N OTES);
  1627         NF_C ONSULT_REQ UEST_UPDAT ED       :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1628         NF_F LAGGED_OI_ EXP_INPT            :  NextIndex  := PageID ToTab(CT_O RDERS);
  1629         NF_F LAGGED_OI_ EXP_OUTPT           :  NextIndex  := PageID ToTab(CT_O RDERS);
  1630         NF_C ONSULT_PRO C_INTERPRE TATION   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1631         NF_R TC_CANCEL_ ORDERS              :  NextIndex  := PageID ToTab(CT_O RDERS);
  1632         NF_I MAGING_REQ UEST_CHANG ED       :
  1633           be gin
  1634              ReportBox( GetNotific ationFollo wUpText(Pa tient.DFN,  Notificat ions.Follo wUp, Notif ications.A lertData),  Pieces(Pi ece(Notifi cations.Re cordID, U,  1), ':',  2, 3), Tru e);
  1635              Notificati ons.Delete ;
  1636           en d;
  1637         NF_L AB_THRESHO LD_EXCEEDE D        :  NextIndex  := PageID ToTab(CT_L ABS);
  1638         NF_M AMMOGRAM_R ESULTS              :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1639         NF_P AP_SMEAR_R ESULTS              :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1640         NF_A NATOMIC_PA THOLOGY_RE SULTS    :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1641         NF_S URGERY_UNS IGNED_NOTE          :  if TabExi sts(CT_SUR GERY) then
  1642                                                  NextInd ex := Page IDToTab(CT _SURGERY)
  1643                                                else
  1644                                                  InfoBox (TX_NO_SUR G_NOTIF, T C_NO_SURG_ NOTIF, MB_ OK);
  1645       else
  1646         Info Box(TX_UNK _NOTIF, TC _UNK_NOTIF , MB_OK);
  1647       end;
  1648       tabPag e.TabIndex  := NextIn dex;
  1649       tabPag eChange(ta bPage);
  1650     end else
  1651       mnuFil eOpenClick (mnuFileNe xt);
  1652   end;
  1653  
  1654   procedure  TfrmFrame. SetBADxLis t;
  1655   var
  1656     i: small int;
  1657   begin
  1658     if not A ssigned(UB AGlobals.t empDxList)  then
  1659        begin
  1660        UBAGl obals.temp DxList :=  TList.Crea te;
  1661        UBAGl obals.temp DxList.Cou nt := 0;
  1662        Appli cation.Pro cessMessag es;
  1663        end
  1664     else
  1665        begin
  1666        //Kil l the old  Dx list
  1667        for i  := 0 to p red(UBAGlo bals.tempD xList.Coun t) do
  1668           TO bject(UBAG lobals.tem pDxList[i] ).Free;
  1669  
  1670        UBAGl obals.temp DxList.Cle ar;
  1671        Appli cation.Pro cessMessag es;
  1672  
  1673        //Cre ate new Dx  list for  newly sele cted patie nt
  1674         if n ot Assigne d(UBAGloba ls.tempDxL ist) then
  1675            b egin
  1676            U BAGlobals. tempDxList  := TList. Create;
  1677            U BAGlobals. tempDxList .Count :=  0;
  1678            A pplication .ProcessMe ssages;
  1679            e nd;
  1680        end;
  1681   end;
  1682  
  1683   procedure  TfrmFrame. mnuFileOpe nClick(Sen der: TObje ct);
  1684   { select a  new patie nt & updat e the head er display s (patient  id, encou nter, post ings) }
  1685   var
  1686     SaveDFN,  Reason: s tring;
  1687     ok, OldR emindersSt arted, PtS elCancelle d: boolean ;
  1688     CCOWResp onse: User Response;
  1689     ThisSess ionChanges : TChanges ;
  1690     I: Integ er;
  1691   begin
  1692     pnlPatie nt.Enabled  := false;
  1693     if (Send er = mnuFi leOpen) or  (FRefresh ing) then  PTSwitchRe fresh := T rue
  1694     else PTS witchRefre sh := Fals e;  //part  of a chan ge to CQ # 11529
  1695     PtSelCan celled :=  FALSE;
  1696     if not F Refreshing  then mnuF ile.Tag :=  0
  1697     else mnu File.Tag : = 1;
  1698     Determin eNextTab;
  1699     //if Sen der <> mnu FileNext t hen         //CQ 1627 3 & 16419  - Missing  Review/Sig n Changes  dialog whe n clicking  'Next' bu tton.
  1700     ThisSess ionChanges  := TChang es.Create;
  1701     try
  1702       //Loop  through a nd add in  the docume nts
  1703       for i  := 0 to Ch anges.Docu ments.Coun t - 1 do b egin
  1704         This SessionCha nges.Add(C H_DOC, TCh angeItem(C hanges.Doc uments.Ite ms[i]).ID,  TChangeIt em(Changes .Documents .Items
  1705         [i]) .Text, TCh angeItem(C hanges.Doc uments.Ite ms[i]).Gro upName, TC hangeItem( Changes.Do cuments.It ems[i]).Si gnState,
  1706         TCha ngeItem(Ch anges.Docu ments.Item s[i]).Pare ntID, TCha ngeItem(Ch anges.Docu ments.Item s[i]).User ,
  1707         TCha ngeItem(Ch anges.Docu ments.Item s[i]).Orde rDG, TChan geItem(Cha nges.Docum ents.Items [i]).DCOrd er,
  1708         TCha ngeItem(Ch anges.Docu ments.Item s[i]).Dela y);
  1709       end;
  1710       //Loop  through a nd add in  the orders
  1711       for i  := 0 to Ch anges.Orde rs.Count -  1 do begi n
  1712        ThisS essionChan ges.Add(CH _ORD, TCha ngeItem(Ch anges.Orde rs.Items[i ]).ID, TCh angeItem(C hanges.Ord ers.Items[ i]).Text,
  1713        TChan geItem(Cha nges.Order s.Items[i] ).GroupNam e, TChange Item(Chang es.Orders. Items[i]). SignState,
  1714        TChan geItem(Cha nges.Order s.Items[i] ).ParentID , TChangeI tem(Change s.Orders.I tems[i]).U ser,
  1715        TChan geItem(Cha nges.Order s.Items[i] ).OrderDG,  TChangeIt em(Changes .Orders.It ems[i]).DC Order,
  1716        TChan geItem(Cha nges.Order s.Items[i] ).Delay);
  1717       end;
  1718       //Loop  through a nd add in  PCE
  1719       for i  := 0 to Ch anges.PCE. Count - 1  do begin
  1720         This SessionCha nges.Add(C H_PCE, TCh angeItem(C hanges.PCE .Items[i]) .ID, TChan geItem(Cha nges.PCE.I tems[i]).T ext,
  1721         TCha ngeItem(Ch anges.PCE. Items[i]). GroupName,  TChangeIt em(Changes .PCE.Items [i]).SignS tate,
  1722         TCha ngeItem(Ch anges.PCE. Items[i]). ParentID,  TChangeIte m(Changes. PCE.Items[ i]).User,
  1723         TCha ngeItem(Ch anges.PCE. Items[i]). OrderDG, T ChangeItem (Changes.P CE.Items[i ]).DCOrder ,
  1724         TCha ngeItem(Ch anges.PCE. Items[i]). Delay);
  1725       end;
  1726       if not  AllowCont extChangeA ll(Reason)  then
  1727         begi n
  1728           pn lPatient.E nabled :=  True;
  1729           // If this is  cancelled  then relo ad this se ssions cha nges.
  1730           Ch anges.Clea r;
  1731           // Loop throu gh and add  in the do cuments
  1732           fo r i := 0 t o ThisSess ionChanges .Documents .Count - 1  do begin
  1733              Changes.Ad d(CH_DOC,
  1734              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .ID,
  1735              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .Text,
  1736              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .GroupName ,
  1737              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .SignState ,
  1738              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .ParentID,
  1739              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .User,
  1740              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .OrderDG,
  1741              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .DCOrder,
  1742              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .Delay);
  1743           en d;
  1744           // Loop throu gh and add  in the or ders
  1745           fo r i := 0 t o ThisSess ionChanges .Orders.Co unt - 1 do  begin
  1746              Changes.Ad d(CH_ORD,  TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).ID ,
  1747              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Te xt,
  1748              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Gr oupName,
  1749              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Si gnState,
  1750              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Pa rentID,
  1751              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Us er,
  1752              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Or derDG,
  1753              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).DC Order,
  1754              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).De lay);
  1755           en d;
  1756           // Loop throu gh and add  in PCE
  1757           fo r i := 0 t o ThisSess ionChanges .PCE.Count  - 1 do be gin
  1758              Changes.Ad d(CH_PCE,  TChangeIte m(ThisSess ionChanges .PCE.Items [i]).ID,
  1759              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Text,
  1760              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Group Name,
  1761              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).SignS tate,
  1762              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Paren tID,
  1763              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).User,
  1764              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Order DG,
  1765              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).DCOrd er,
  1766              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Delay );
  1767           en d;
  1768           Ex it;
  1769         end;
  1770     finally
  1771       ThisSe ssionChang es.Clear;
  1772       ThisSe ssionChang es.Free;
  1773     end;
  1774     // updat e status t ext here
  1775     stsArea. Panels.Ite ms[1].Text  := '';
  1776     if (not  User.IsRep ortsOnly)  then
  1777     begin
  1778       if not  FRefreshi ng then
  1779       begin
  1780         Noti fications. Next;   //  avoid pro mpt if no  more alert s selected  to proces s  {v14a R V}
  1781         if N otificatio ns.Active  then
  1782         begi n
  1783           if  (InfoBox( TX_NOTIF_S TOP, TC_NO TIF_STOP,  MB_YESNO)  = ID_NO) t hen
  1784           be gin
  1785              Notificati ons.Prior;
  1786              pnlPatient .Enabled : = True;
  1787              Exit;
  1788           en d;
  1789         end;
  1790         if N otificatio ns.Active  then Notif ications.P rior;
  1791       end;
  1792     end;
  1793  
  1794     if FNoPa tientSelec ted then
  1795       SaveDF N := ''
  1796     else
  1797       SaveDF N := Patie nt.DFN;
  1798  
  1799     OldRemin dersStarte d := Remin dersStarte d;
  1800     Reminder sStarted : = FALSE;
  1801     try
  1802       if FRe freshing t hen
  1803       begin
  1804         Upda tePtInfoOn Refresh;
  1805         ok : = TRUE;
  1806       end
  1807       else
  1808       begin
  1809         ok : = FALSE;
  1810         if ( not User.I sReportsOn ly) then
  1811         begi n
  1812           if  FCCOWInst alled and  (ctxContex tor.State  = csPartic ipating) t hen
  1813              begin
  1814                UpdateCC OWContext;
  1815                if not F CCOWError  then
  1816                begin
  1817                  FCCOWI conName :=  'BMP_CCOW _LINKED';
  1818                  pnlCCO W.Hint :=  TX_CCOW_LI NKED;
  1819                  imgCCO W.Picture. Bitmap.Loa dFromResou rceName(hI nstance, F CCOWIconNa me);
  1820                end;
  1821              end
  1822           el se
  1823              begin
  1824                FCCOWIco nName := ' BMP_CCOW_B ROKEN';
  1825                pnlCCOW. Hint := TX _CCOW_BROK EN;
  1826                imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  1827              end;
  1828           if  (Patient. DFN = '')  or (Sender  = mnuFile Open) or ( Sender = m nuFileNext ) or (Send er = mnuVi ewDemo) th en
  1829              SelectPati ent(SHOW_N OTIFICATIO NS, Font.S ize, PtSel Cancelled) ;
  1830           if  PtSelCanc elled then
  1831              begin
  1832                pnlPatie nt.Enabled  := True;
  1833                exit;
  1834              end;
  1835           Sh owEverythi ng;
  1836           // HideEveryt hing('Retr ieving inf ormation -  please wa it....');   //v27 (pe nding) RV
  1837           Di splayEncou nterText;
  1838           FP revInPatie nt := Pati ent.Inpati ent;
  1839           if  Notificat ions.Activ e then
  1840           be gin
  1841              // display  'next not ification'  button
  1842              SetUpNextB utton;
  1843              FNextButto nActive :=  True;
  1844              mnuFileNex t.Enabled  := True;
  1845              mnuFileNex tClick(mnu FileOpen);
  1846           en d
  1847           el se
  1848           be gin
  1849              // hide th e 'next no tification ' button
  1850              FNextButto nActive :=  False;
  1851              FNextButto n.Free;
  1852              FNextButto n := nil;
  1853              mnuFileNex t.Enabled  := False;
  1854              mnuFileNot ifRemove.E nabled :=  False;
  1855              if Patient .DFN <> Sa veDFN then
  1856                ok := TR UE;
  1857           en d
  1858         end
  1859         else
  1860         begi n
  1861           No tification s.Clear;
  1862           Se lectPatien t(False, F ont.Size,  PtSelCance lled); //  Call Pt. S el. w/o no tification s.
  1863           if  PtSelCanc elled then  exit;
  1864           Sh owEverythi ng;
  1865           Di splayEncou nterText;
  1866           FP revInPatie nt := Pati ent.Inpati ent;
  1867           ok  := TRUE;
  1868         end;
  1869       end;
  1870       if ok  then
  1871       begin
  1872         if F CCOWInstal led and (c txContexto r.State =  csParticip ating) and  (not FRef reshing) t hen
  1873           be gin
  1874              if (AllowC COWContext Change(CCO WResponse,  Patient.D FN)) then
  1875                begin
  1876                  SetupP atient;
  1877                  tabPag e.TabIndex  := PageID ToTab(Next Tab);
  1878                  tabPag eChange(ta bPage);
  1879                end
  1880              else
  1881                begin
  1882                  case C COWRespons e of
  1883                    urCa ncel: Upda teCCOWCont ext;
  1884                    urBr eak:
  1885                      be gin
  1886                         // do not  revert to  old DFN if  context w as manuall y broken b y user - v 26 (RV)
  1887                         if (ctxCon textor.Sta te = csPar ticipating ) then Pat ient.DFN : = SaveDFN;
  1888                         SetupPatie nt;
  1889                         tabPage.Ta bIndex :=  PageIDToTa b(NextTab) ;
  1890                         tabPageCha nge(tabPag e);
  1891                      en d;
  1892                    else
  1893                      be gin
  1894                         SetupPatie nt;
  1895                         tabPage.Ta bIndex :=  PageIDToTa b(NextTab) ;
  1896                         tabPageCha nge(tabPag e);
  1897                      en d;
  1898                  end;
  1899                end;
  1900           en d
  1901         else
  1902           be gin
  1903              SetupPatie nt;
  1904              tabPage.Ta bIndex :=  PageIDToTa b(NextTab) ;
  1905              tabPageCha nge(tabPag e);
  1906           en d;
  1907       end;
  1908     finally
  1909       if (no t FRefresh ing) and ( Patient.DF N = SaveDF N) then
  1910         Remi ndersStart ed := OldR emindersSt arted;
  1911       FFirst Load := Fa lse;
  1912     end;
  1913    {Begin Bi llingAware }
  1914     if  BILL ING_AWARE  then frmFr ame.SetBAD xList; //e nd IsBilli ngAware
  1915    {End Bill ingAware}
  1916    if not FR efreshing  then
  1917      begin
  1918         DoNo tChangeEnc Window :=  false;
  1919         Orde rPrintForm  := false;
  1920         uCor e.TempEnco unterLoc : = 0;
  1921         uCor e.TempEnco unterLocNa me := '';
  1922      end;
  1923    pnlPatien t.Enabled  := True;
  1924   end;
  1925  
  1926   procedure  TfrmFrame. DetermineN extTab;
  1927   begin
  1928     if (FRef reshing or  User.UseL astTab) an d (not FFi rstLoad) t hen
  1929       begin
  1930         if ( tabPage.Ta bIndex < 0 ) then
  1931           Ne xtTab := L astTab
  1932         else
  1933           Ne xtTab := T abToPageID (tabPage.T abIndex);
  1934       end
  1935     else
  1936       NextTa b := User. InitialTab ;
  1937     if NextT ab = CT_NO PAGE then  NextTab :=  User.Init ialTab;
  1938     if User. IsReportsO nly then / / Reports  Only tab.
  1939       NextTa b := CT_RE PORTS; //  Only one t ab should  exist by t his point  in "REPORT S ONLY" mo de.
  1940     if not T abExists(N extTab) th en NextTab  := CT_COV ER;
  1941     if NextT ab = CT_NO PAGE then  NextTab :=  User.Init ialTab;
  1942     if NextT ab = CT_OR DERS then
  1943       if frm Orders <>  nil then w ith frmOrd ers do
  1944       begin
  1945         if ( lstSheets. ItemIndex  > -1 ) and  (TheCurre ntView <>  nil) and ( theCurrent View.Event Delay.PtEv entIFN>0)  then
  1946           Pt EvtComplet ed(TheCurr entView.Ev entDelay.P tEventIFN,  TheCurren tView.Even tDelay.Eve ntName);
  1947       end;
  1948   end;
  1949  
  1950   procedure  TfrmFrame. mnuFileEnc ounterClic k(Sender:  TObject);
  1951   { displays  encounter  window an d updates  encounter  display in  case enco unter was  updated }
  1952   begin
  1953     UpdateEn counter(NP F_ALL); {* KCM*}
  1954     DisplayE ncounterTe xt;
  1955   end;
  1956  
  1957   procedure  TfrmFrame. mnuFileRev iewClick(S ender: TOb ject);
  1958   { displays  the Revie w Changes  window (wh ich resets  the Encou nter objec t) }
  1959   var
  1960     EventCha nges: bool ean;
  1961     NameNeed Look: stri ng;
  1962   begin
  1963     FReviewC lick := Tr ue;
  1964     mnuFile. Tag := 1;
  1965     EventCha nges := Fa lse;
  1966     NameNeed Look := '' ;
  1967     //Update PtInfoOnRe fresh;
  1968     if Chang es.Count >  0 then
  1969     begin
  1970      if (frm Orders <>  nil) and ( frmOrders. TheCurrent View <> ni l) and ( f rmOrders.T heCurrentV iew.EventD elay.Event IFN>0) the n
  1971      begin
  1972        Event Changes :=  True;
  1973        NameN eedLook :=  frmOrders .TheCurren tView.View Name;
  1974        frmOr ders.PtEvt Completed( frmOrders. TheCurrent View.Event Delay.PtEv entIFN, fr mOrders.Th eCurrentVi ew.EventDe lay.EventN ame);
  1975      end;
  1976      ReviewC hanges(Tim edOut, Eve ntChanges) ;
  1977      if TabT oPageID(ta bPage.TabI ndex)= CT_ MEDS then
  1978      begin
  1979        frmOr ders.InitO rderSheets 2(NameNeed Look);
  1980      end;
  1981     end
  1982     else Inf oBox('No n ew changes  to review /sign.', ' Review Cha nges', MB_ OK);
  1983     //CQ #17 491: Moved  UpdatePtI nfoOnRefre sh here to  allow for  the updat ing of the  patient s tatus indi cator
  1984     //in the  header ba r (after t he Review  Changes di alog close s) if the  patient be comes admi tted/disch arged.
  1985     UpdatePt InfoOnRefr esh;
  1986     FOrderPr intForm :=  false;
  1987     FReviewC lick := fa lse;
  1988   end;
  1989  
  1990   procedure  TfrmFrame. mnuFileExi tClick(Sen der: TObje ct);
  1991   { see the  CloseQuery  event }
  1992   var
  1993     i: small int;
  1994   begin
  1995     try
  1996        if  B ILLING_AWA RE then
  1997            b egin
  1998            i f Assigned (tempDxLis t) then
  1999                for i :=  0 to pred (UBAGlobal s.tempDxLi st.Count)  do
  2000                   TObje ct(UBAGlob als.tempDx List[i]).F ree;
  2001  
  2002            U BAGlobals. tempDxList .Clear;
  2003            A pplication .ProcessMe ssages;
  2004            e nd; //end  IsBillingA ware
  2005     except
  2006        on EA ccessViola tion do
  2007           be gin
  2008           {$ ifdef debu gCPRS}{Sho w508Messag e('Access  Violation  in procedu re TfrmFra me.mnuFile ExitClick( )');}{$end if}
  2009           ra ise;
  2010           en d;
  2011        on E:  Exception  do
  2012           be gin
  2013           {$ ifdef debu gCPRS}{Sho w508Messag e('Unhandl ed excepti on in proc edure Tfrm Frame.mnuF ileExitCli ck()');}{$ endif}
  2014           ra ise;
  2015           en d;
  2016     end;
  2017  
  2018     Close;
  2019   end;
  2020  
  2021   { View Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2022  
  2023   procedure  TfrmFrame. mnuViewPos tingsClick (Sender: T Object);
  2024   begin
  2025   end;
  2026  
  2027   { Tool Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2028  
  2029   function T frmFrame.E xpandComma nd(x: stri ng): strin g;
  2030   { look for  'macros'  on the com mand line  and expand  them usin g current  context }
  2031  
  2032     procedur e Substitu te(const K ey, Data:  string);
  2033     var
  2034       Stop,  Start: Int eger;
  2035     begin
  2036       Stop   := Pos(Key , x) - 1;
  2037       Start  := Stop +  Length(Key ) + 1;
  2038       x := C opy(x, 1,  Stop) + Da ta + Copy( x, Start,  Length(x)) ;
  2039     end;
  2040  
  2041   begin
  2042     if Pos(' %MREF', x)  > 0 then  Substitute ('%MREF',
  2043       '^TMP( ''ORWCHART '',' + MSc alar('$J')  + ',''' +  DottedIPS tr + ''','  + IntToHe x(Handle,  8) + ')');
  2044     if Pos(' %SRV',  x)  > 0 then  Substitute ('%SRV',   String(RPC BrokerV.Se rver));
  2045     if Pos(' %PORT', x)  > 0 then  Substitute ('%PORT',  IntToStr(R PCBrokerV. ListenerPo rt));
  2046     if Pos(' %DFN',  x)  > 0 then  Substitute ('%DFN',   Patient.DF N);  //*DF N*
  2047     if Pos(' %DUZ',  x)  > 0 then  Substitute ('%DUZ',   IntToStr(U ser.DUZ));
  2048     if Pos(' %H', x) >  0  then Su bstitute(' %H', Strin g(RPCBroke rV.LogIn.L ogInHandle ));
  2049     Result : = x;
  2050   end;
  2051  
  2052   procedure  TfrmFrame. ToolClick( Sender: TO bject);
  2053   { executes  the progr am associa ted with a n item on  the Tools  menu, the  command li ne is stor ed
  2054     in the i tem's hint  property  }
  2055   const
  2056     TXT_ECS_ NOTFOUND =  'The ECS  applicatio n is not f ound at th e default  directory, ' + #13 +  'would you  like manu ally searc h it?';
  2057     TC_ECS_N OTFOUND =  'Applicati on Not Fou nd';
  2058   var
  2059     x, AFile , Param, M enuCommand , ECSAppen d, CapNm,  curPath :  string;
  2060     IsECSInt erface: bo olean;
  2061  
  2062     function  TakeOutAm ps(AString : string):  string;
  2063     var
  2064       S1,S2:  string;
  2065     begin
  2066       if Pos ('&',AStri ng)=0 then
  2067       begin
  2068         Resu lt := AStr ing;
  2069         Exit ;
  2070       end;
  2071       S1 :=  Piece(AStr ing,'&',1) ;
  2072       S2 :=  Piece(AStr ing,'&',2) ;
  2073       Result  := S1 + S 2;
  2074     end;
  2075  
  2076     function  ExcuteEC( AFile,APar a: string) : boolean;
  2077     begin
  2078       if (Sh ellExecute (Handle, ' open', PCh ar(AFile),  PChar(Par am), '', S W_NORMAL)  > 32 ) the n Result : = True
  2079       else
  2080       begin
  2081         if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO  or MB_ICO NERROR) =  IDYES then
  2082         begi n
  2083           if  OROpenDlg .Execute t hen
  2084           be gin
  2085               AFile :=  OROpenDlg. FileName;
  2086               if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then
  2087               begin
  2088                 ShowMsg ('This is  not a vali d ECS appl ication.') ;
  2089                 Result  := True;
  2090               end else
  2091               begin
  2092                 if (She llExecute( Handle, 'o pen', PCha r(AFile),  PChar(Para m), '', SW _NORMAL)<3 2) then Re sult := Fa lse
  2093                 else Re sult := Tr ue;
  2094               end;
  2095           en d
  2096           el se Result  := True;
  2097         end  else Resul t := True;
  2098       end;
  2099     end;
  2100  
  2101     function  ExcuteECS (AFile, AP ara: strin g; var cur rPath: str ing): bool ean;
  2102     var
  2103       comman dline,RPCH andle: str ing;
  2104       Startu pInfo: TSt artupInfo;
  2105       Proces sInfo: TPr ocessInfor mation;
  2106     begin
  2107       FillCh ar(Startup Info, Size Of(TStartu pInfo), 0) ;
  2108       with S tartupInfo  do
  2109       begin
  2110         cb : = SizeOf(T StartupInf o);
  2111         dwFl ags := STA RTF_USESHO WWINDOW;
  2112         wSho wWindow :=  SW_SHOWNO RMAL;
  2113       end;
  2114       comman dline := A File + Par am;
  2115       RPCHan dle := Get AppHandle( RPCBrokerV );
  2116       comman dline := c ommandline  + ' H=' +  RPCHandle ;
  2117       if Cre ateProcess (nil, PCha r(commandl ine), nil,  nil, Fals e,
  2118         NORM AL_PRIORIT Y_CLASS, n il, nil, S tartupInfo , ProcessI nfo) then  Result :=  True
  2119       else
  2120       begin
  2121         if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO  or MB_ICO NERROR) =  IDYES then
  2122         begi n
  2123           if  OROpenDlg .Execute t hen
  2124           be gin
  2125               AFile :=  OROpenDlg. FileName;
  2126               if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then
  2127               begin
  2128                 ShowMsg ('This is  not a vali d ECS appl ication.') ;
  2129                 Result  := True;
  2130               end else
  2131               begin
  2132                 SaveUse rPath('Eve nt Capture  Interface ='+AFile,  currPath);
  2133                 FillCha r(StartupI nfo, SizeO f(TStartup Info), 0);
  2134                 with St artupInfo  do
  2135                 begin
  2136                   cb :=  SizeOf(TS tartupInfo );
  2137                   dwFla gs := STAR TF_USESHOW WINDOW;
  2138                   wShow Window :=  SW_SHOWNOR MAL;
  2139                 end;
  2140                 command line := AF ile + Para m;
  2141                 RPCHand le := GetA ppHandle(R PCBrokerV) ;
  2142                 command line := co mmandline  + ' H=' +  RPCHandle;
  2143                 if not  CreateProc ess(nil, P Char(comma ndline), n il, nil, F alse,
  2144                    NORM AL_PRIORIT Y_CLASS, n il, nil,St artupInfo, ProcessInf o) then Re sult := Fa lse
  2145                 else Re sult := Tr ue;
  2146               end;
  2147           en d
  2148           el se Result  := True;
  2149         end  else Resul t := True;
  2150       end;
  2151     end;
  2152  
  2153   begin
  2154     MenuComm and := '';
  2155     ECSAppen d   := '';
  2156     IsECSInt erface :=  False;
  2157     curPath  := '';
  2158     CapNm :=  LowerCase (TMenuItem (Sender).C aption);
  2159     CapNm :=  TakeOutAm ps(CapNm);
  2160     if AnsiC ompareText ('event ca pture inte rface',Cap Nm)=0 then
  2161     begin
  2162       IsECSI nterface : = True;
  2163       if FEC SAuthUser  then Updat eECSParame ter(ECSApp end)
  2164       else b egin
  2165         Show Msg('You d on''t have  permissio n to use E CS.');
  2166         exit ;
  2167       end;
  2168     end;
  2169     MenuComm and := TMe nuItem(Sen der).Hint  + ECSAppen d;
  2170     x := Exp andCommand (MenuComma nd);
  2171     if CharA t(x, 1) =  '"' then
  2172     begin
  2173       x      := Copy(x,  2, Length (x));
  2174       AFile  := Copy(x,  1, Pos('" ',x)-1);
  2175       Param  := Copy(x,  Pos('"',x )+1, Lengt h(x));
  2176     end else
  2177     begin
  2178       AFile  := Piece(x , ' ', 1);
  2179       Param  := Copy(x,  Length(AF ile)+1, Le ngth(x));
  2180     end;
  2181     if IsECS Interface  then
  2182     begin
  2183       if not  ExcuteECS (AFile,Par am,curPath ) then
  2184         Excu teECS(AFil e,Param,cu rPath);
  2185       if Len gth(curPat h)>0 then
  2186         TMen uItem(Send er).Hint : = curPath;
  2187     end
  2188     else if  (Pos('ecs' ,LowerCase (AFile))>0 ) and (not  IsECSInte rface) the n
  2189     begin
  2190       if not  ExcuteEC( AFile,Para m) then
  2191         Excu teEC(AFile ,Param);
  2192     end else
  2193     begin
  2194       ShellE xecute(Han dle, 'open ', PChar(A File), PCh ar(Param),  '', SW_NO RMAL);
  2195     end;
  2196   end;
  2197  
  2198   { Help Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2199  
  2200   procedure  TfrmFrame. mnuHelpBro kerClick(S ender: TOb ject);
  2201   { used for  debugging  - shows l ast n brok er calls }
  2202   begin
  2203     ShowBrok er;
  2204   end;
  2205  
  2206   procedure  TfrmFrame. mnuHelpLis tsClick(Se nder: TObj ect);
  2207   { used for  debugging  - shows i nternal co ntents of  TORListBox  }
  2208   begin
  2209     if Scree n.ActiveCo ntrol is T ListBox
  2210       then D ebugListIt ems(TListB ox(Screen. ActiveCont rol))
  2211       else I nfoBox('Fo cus contro l is not a  listbox',  'ListBox  Data', MB_ OK);
  2212   end;
  2213  
  2214   procedure  TfrmFrame. mnuHelpSym bolsClick( Sender: TO bject);
  2215   { used for  debugging  - shows c urrent sym bol table  }
  2216   begin
  2217     DebugSho wServer;
  2218   end;
  2219  
  2220   procedure  TfrmFrame. mnuHelpAbo utClick(Se nder: TObj ect);
  2221   { displays  the about  screen }
  2222   begin
  2223     ShowAbou t;
  2224   end;
  2225  
  2226   { Status B ar Methods  }
  2227  
  2228   procedure  TfrmFrame. UMStatusTe xt(var Mes sage: TMes sage);
  2229   { displays  status ba r text (us ing the po inter to a  text buff er passed  in LParam)  }
  2230   begin
  2231     stsArea. Panels.Ite ms[0].Text  := StrPas (PChar(Mes sage.LPara m));
  2232     stsArea. Refresh;
  2233   end;
  2234  
  2235   { Toolbar  Methods (m ake panels  act like  buttons) - ---------- ---------- ---------- ---------- -- }
  2236  
  2237   procedure  TfrmFrame. pnlPatient MouseDown( Sender: TO bject; But ton: TMous eButton;
  2238     Shift: T ShiftState ; X, Y: In teger);
  2239   { emulate  a button p ress in th e patient  identifica tion panel  }
  2240   begin
  2241     if pnlPa tient.Beve lOuter = b vLowered t hen exit;
  2242     pnlPatie nt.BevelOu ter := bvL owered;
  2243     with lbl PtName do  SetBounds( Left+2, To p+2, Width , Height);
  2244     with lbl PtSSN  do  SetBounds( Left+2, To p+2, Width , Height);
  2245     with lbl PtAge  do  SetBounds( Left+2, To p+2, Width , Height);
  2246   end;
  2247  
  2248   procedure  TfrmFrame. pnlPatient MouseUp(Se nder: TObj ect; Butto n: TMouseB utton;
  2249     Shift: T ShiftState ; X, Y: In teger);
  2250   { emulate  the button  raising i n the pati ent identi fication p anel & cal l Patient  Inquiry }
  2251   begin
  2252     if pnlPa tient.Beve lOuter = b vRaised th en exit;
  2253     pnlPatie nt.BevelOu ter := bvR aised;
  2254     with lbl PtName do  SetBounds( Left-2, To p-2, Width , Height);
  2255     with lbl PtSSN  do  SetBounds( Left-2, To p-2, Width , Height);
  2256     with lbl PtAge  do  SetBounds( Left-2, To p-2, Width , Height);
  2257   end;
  2258  
  2259   procedure  TfrmFrame. pnlVisitMo useDown(Se nder: TObj ect; Butto n: TMouseB utton;
  2260     Shift: T ShiftState ; X, Y: In teger);
  2261   { emulate  a button p ress in th e encounte r panel }
  2262   begin
  2263     if User. IsReportsO nly then
  2264       exit;
  2265     if pnlVi sit.BevelO uter = bvL owered the n exit;
  2266     pnlVisit .BevelOute r := bvLow ered;
  2267     with lbl PtLocation  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2268     with lbl PtProvider  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2269   end;
  2270  
  2271   procedure  TfrmFrame. pnlVisitMo useUp(Send er: TObjec t; Button:  TMouseBut ton;
  2272     Shift: T ShiftState ; X, Y: In teger);
  2273   { emulate  a button r aising in  the encoun ter panel  and call U pdate Prov ider/Locat ion }
  2274   begin
  2275     if User. IsReportsO nly then
  2276       exit;
  2277     if pnlVi sit.BevelO uter = bvR aised then  exit;
  2278     pnlVisit .BevelOute r := bvRai sed;
  2279     with lbl PtLocation  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2280     with lbl PtProvider  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2281   end;
  2282  
  2283   procedure  TfrmFrame. pnlVistaWe bClick(Sen der: TObje ct);
  2284   begin
  2285     inherite d;
  2286     uUseVist aWeb := tr ue;
  2287     pnlVista Web.BevelO uter := bv Lowered;
  2288     pnlCIRNC lick(self) ;
  2289     uUseVist aWeb := fa lse;
  2290   end;
  2291  
  2292   procedure  TfrmFrame. pnlVistaWe bMouseDown (Sender: T Object; Bu tton: TMou seButton;
  2293     Shift: T ShiftState ; X, Y: In teger);
  2294   begin
  2295     inherite d;
  2296     pnlVista Web.BevelO uter := bv Lowered;
  2297   end;
  2298  
  2299   procedure  TfrmFrame. pnlVistaWe bMouseUp(S ender: TOb ject; Butt on: TMouse Button;
  2300     Shift: T ShiftState ; X, Y: In teger);
  2301   begin
  2302     inherite d;
  2303     pnlVista Web.BevelO uter := bv Raised;
  2304   end;
  2305  
  2306   procedure  TfrmFrame. pnlPrimary CareMouseD own(Sender : TObject;
  2307     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2308   begin
  2309     if pnlPr imaryCare. BevelOuter  = bvLower ed then ex it;
  2310     pnlPrima ryCare.Bev elOuter :=  bvLowered ;
  2311     with lbl PtCare       do SetBo unds(Left+ 2, Top+2,  Width, Hei ght);
  2312     with lbl PtAttendin g do SetBo unds(Left+ 2, Top+2,  Width, Hei ght);
  2313     with lbl PtMHTC do  SetBounds( Left+2, To p+2, Width , Height);
  2314   end;
  2315  
  2316   procedure  TfrmFrame. pnlPrimary CareMouseU p(Sender:  TObject;
  2317     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2318   begin
  2319     if pnlPr imaryCare. BevelOuter  = bvRaise d then exi t;
  2320     pnlPrima ryCare.Bev elOuter :=  bvRaised;
  2321     with lbl PtCare       do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2322     with lbl PtAttendin g do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2323     with lbl PtMHTC       do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2324   end;
  2325  
  2326   procedure  TfrmFrame. pnlPosting sMouseDown (Sender: T Object;
  2327     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2328   { emulate  a button p ress in th e postings  panel }
  2329   begin
  2330     if pnlPo stings.Bev elOuter =  bvLowered  then exit;
  2331     pnlPosti ngs.BevelO uter := bv Lowered;
  2332     with lbl PtPostings  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2333     with lbl PtCWAD      do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2334   end;
  2335  
  2336   procedure  TfrmFrame. pnlPosting sMouseUp(S ender: TOb ject;
  2337     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2338   { emulate  a button r aising in  the postin g panel an d call Pos tings }
  2339   begin
  2340     if pnlPo stings.Bev elOuter =  bvRaised t hen exit;
  2341     pnlPosti ngs.BevelO uter := bv Raised;
  2342     with lbl PtPostings  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2343     with lbl PtCWAD      do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2344   end;
  2345  
  2346   { Resize a nd Font-Ch ange proce dures ---- ---------- ---------- ---------- ---------- ---------- -- }
  2347  
  2348   procedure  TfrmFrame. LoadSizesF orUser;
  2349   var
  2350     s1, s2,  s3, s4, Du mmy: integ er;
  2351     panelBot tom, panel MedIn, Res toreWidth,  MinCnst :  integer;
  2352  
  2353     procedur e GetMinCo ntraint(aC ontrol: TW inControl;  var LastM inWidth: I nteger);
  2354     var
  2355      I: inte ger;
  2356     begin
  2357      if aCon trol.Const raints.Min Width > La stMinWidth  then
  2358        LastM inWidth :=  aControl. Constraint s.MinWidth ;
  2359  
  2360      for I : = 0 to aCo ntrol.Cont rolCount -  1 do
  2361      begin
  2362        if aC ontrol.Con trols[i] i s TWinCont rol then
  2363         GetM inContrain t(TWinCont rol(aContr ol.Control s[i]), Las tMinWidth) ;
  2364      end;
  2365  
  2366     end;
  2367  
  2368   begin
  2369     ChangeFo nt(UserFon tSize);
  2370     SetUserB ounds(TCon trol(frmFr ame));
  2371     SetUserW idths(TCon trol(frmPr oblems.pnl Left));
  2372     SetUserW idths(TCon trol(frmOr ders.pnlLe ft));
  2373     RestoreW idth := fr mNotes.pnl Left.Width ;
  2374     SetUserW idths(TCon trol(frmNo tes.pnlLef t));
  2375     MinCnst  := 0;
  2376     GetMinCo ntraint(fr mNotes.pnl Left, MinC nst);
  2377     if frmNo tes.pnlLef t.Width <  MinCnst th en
  2378      frmNote s.pnlLeft. Width := R estoreWidt h;
  2379  
  2380     frmNotes .splHorz.L eft := frm Notes.pnlL eft.left +  1;
  2381     SetUserW idths(TCon trol(frmCo nsults.pnl Left));
  2382     SetUserW idths(TCon trol(frmDC Summ.pnlLe ft));
  2383     if Assig ned(frmSur gery) then  SetUserWi dths(TCont rol(frmSur gery.pnlLe ft));
  2384     SetUserW idths(TCon trol(frmLa bs.pnlLeft ));
  2385     SetUserW idths(TCon trol(frmRe ports.pnlL eft));
  2386     SetUserC olumns(TCo ntrol(frmO rders.hdrO rders));
  2387     SetUserC olumns(TCo ntrol(frmM eds.hdrMed sIn));  //  still nee d conversi on
  2388     SetUserC olumns(TCo ntrol(frmM eds.hdrMed sOut));
  2389     SetUserS tring('frm PtSel.lstv Alerts',En duringPtSe lColumns);
  2390     SetUserS tring(Spel lCheckerSe ttingName,  SpellChec kerSetting s);
  2391     SetUserB ounds2(Tem plateEdito rSplitters , tmplEdit orSplitter Middle,
  2392                     tmp lEditorSpl itterPrope rties, tmp lEditorSpl itterMain,  tmplEdito rSplitterB oil);
  2393     SetUserB ounds2(Tem plateEdito rSplitters 2, tmplEdi torSplitte rNotes, Du mmy, Dummy , Dummy);
  2394     SetUserB ounds2(Rem inderTreeN ame, RemTr eeDlgLeft,  RemTreeDl gTop, RemT reeDlgWidt h, RemTree DlgHeight) ;
  2395     SetUserB ounds2(Rem DlgName, R emDlgLeft,  RemDlgTop , RemDlgWi dth, RemDl gHeight);
  2396     SetUserB ounds2(Rem DlgSplitte rs, RemDlg Spltr1, Re mDlgSpltr2 , Dummy ,D ummy);
  2397     SetUserB ounds2(Dra werSplitte rs,s1, s2,  s3, S4);
  2398     frmNotes .Drawers.L astOpenSiz e := s1;
  2399     frmConsu lts.Drawer s.LastOpen Size := s2 ;
  2400     frmDCSum m.Drawers. LastOpenSi ze := s3;
  2401     if Assig ned(frmSur gery) then  frmSurger y.Drawers. LastOpenSi ze := S4;  //CQ7315
  2402  
  2403     SetUserB ounds2(Lab Splitters, s1, s2, s3 , s4);
  2404     frmLabs. LoadUserSe ttings(s1,  s2, s3, s 4);
  2405  
  2406     with frm Meds do
  2407        begin
  2408        SetUs erBounds2( frmMeds.Na me+'Split' , panelBot tom, panel MedIn, Dum my, Dummy) ;
  2409        if (p anelBottom  > frmMeds .Height-50 ) then pan elBottom : = frmMeds. Height-50;
  2410        if (p anelMedIn  > panelBot tom-50) th en panelMe dIn := pan elBottom-5 0;
  2411        frmMe ds.pnlBott om.Height  := panelBo ttom;
  2412        frmMe ds.pnlMedI n.Height : = panelMed In;
  2413        //Med s Tab Non- VA meds co lumns
  2414        SetUs erColumns( TControl(h drMedsNonV A)); //CQ7 314
  2415        end;
  2416  
  2417        frmCo ver.Disabl eAlign;
  2418     try
  2419       SetUse rBounds2(C overSplitt ers1, s1,  s2, s3, s4 );
  2420       if s1  > 0 then
  2421         frmC over.pnl_1 .Width :=  LowerOf( f rmCover.pn l_not3.Cli entWidth -  5, s1);
  2422       if s2  > 0 then
  2423         frmC over.pnl_3 .Width :=  LowerOf( f rmCover.pn lTop.Clien tWidth - 5 , s2);
  2424       if s3  > 0 then
  2425         frmC over.pnlTo p.Height : = LowerOf(  frmCover. pnlBase.Cl ientHeight  - 5, s3);
  2426       if s4  > 0 then
  2427         frmC over.pnl_4 .Width :=  LowerOf( f rmCover.pn lMiddle.Cl ientWidth  - 5, s4);
  2428  
  2429       SetUse rBounds2(C overSplitt ers2, s1,  s2, s3, Du mmy);
  2430       if s1  > 0 then
  2431         frmC over.pnlBo ttom.Heigh t := Lower Of( frmCov er.pnlBase .ClientHei ght - 5, s 1);
  2432       if s2  > 0 then
  2433         frmC over.pnl_6 .Width :=  LowerOf( f rmCover.pn lBottom.Cl ientWidth  - 5, s2);
  2434       if s3  > 0 then
  2435         frmC over.pnl_8 .Width :=  LowerOf( f rmCover.pn lBottom.Cl ientWidth  - 5, s3);
  2436  
  2437     finally
  2438      frmCove r.EnableAl ign;
  2439     end;
  2440     if Param Search('re z') = '640 ' then Set Bounds(Lef t, Top, 64 8, 488);   // for tes ting
  2441  
  2442   end;
  2443  
  2444   procedure  TfrmFrame. SaveSizesF orUser;
  2445   var
  2446     SizeList : TStringL ist;
  2447     SurgTemp Ht: intege r;
  2448     s1, s2,  s3, s4: in teger;
  2449   begin
  2450     SaveUser FontSize(M ainFontSiz e);
  2451     SizeList  := TStrin gList.Crea te;
  2452     try
  2453       with S izeList do
  2454       begin
  2455         Add( StrUserBou nds(frmFra me));
  2456         Add( StrUserWid th(frmProb lems.pnlLe ft));
  2457         Add( StrUserWid th(frmOrde rs.pnlLeft ));
  2458         Add( StrUserWid th(frmNote s.pnlLeft) );
  2459         Add( StrUserWid th(frmCons ults.pnlLe ft));
  2460         Add( StrUserWid th(frmDCSu mm.pnlLeft ));
  2461         if A ssigned(fr mSurgery)  then Add(S trUserWidt h(frmSurge ry.pnlLeft ));
  2462         Add( StrUserWid th(frmLabs .pnlLeft)) ;
  2463         Add( StrUserWid th(frmRepo rts.pnlLef t));
  2464         Add( StrUserCol umns(frmOr ders.hdrOr ders));
  2465         Add( StrUserCol umns(frmMe ds.hdrMeds In));
  2466         Add( StrUserCol umns(frmMe ds.hdrMeds Out));
  2467         Add( StrUserStr ing(SpellC heckerSett ingName, S pellChecke rSettings) );
  2468         Add( StrUserBou nds2(Templ ateEditorS plitters,  tmplEditor SplitterMi ddle,
  2469                  tmplEd itorSplitt erProperti es, tmplEd itorSplitt erMain, tm plEditorSp litterBoil ));
  2470         Add( StrUserBou nds2(Templ ateEditorS plitters2,  tmplEdito rSplitterN otes, 0, 0 , 0));
  2471         Add( StrUserBou nds2(Remin derTreeNam e, RemTree DlgLeft, R emTreeDlgT op, RemTre eDlgWidth,  RemTreeDl gHeight));
  2472         Add( StrUserBou nds2(RemDl gName, Rem DlgLeft, R emDlgTop,  RemDlgWidt h, RemDlgH eight));
  2473         Add( StrUserBou nds2(RemDl gSplitters , RemDlgSp ltr1, RemD lgSpltr2,  0 ,0));
  2474  
  2475         //v2 6.47 - RV  - access v iolation i f Surgery  Tab not en abled.  Se t to desig ner height  as defaul t.
  2476         if A ssigned(fr mSurgery)  then SurgT empHt := f rmSurgery. Drawers.pn lTemplates .Height el se SurgTem pHt := 85;
  2477         Add( StrUserBou nds2(Drawe rSplitters , frmNotes .Drawers.L astOpenSiz e,
  2478                                                    frmCo nsults.Dra wers.LastO penSize,
  2479                                                    frmDC Summ.Drawe rs.LastOpe nSize,
  2480                                                    SurgT empHt)); / / last par ameter = C Q7315
  2481  
  2482         frmL abs.SaveUs erSettings (s1, s2, s 3, s4);
  2483         Add( StrUserBou nds2(LabSp litters, s 1, s2, s3,  s4));
  2484         Add( StrUserBou nds2(Cover Splitters1 ,
  2485           fr mCover.pnl _1.Width,
  2486           fr mCover.pnl _3.Width,
  2487           fr mCover.pnl Top.Height ,
  2488           fr mCover.pnl _4.Width)) ;
  2489         Add( StrUserBou nds2(Cover Splitters2 ,
  2490           fr mCover.pnl Bottom.Hei ght,
  2491           fr mCover.pnl _6.Width,
  2492           fr mCover.pnl _8.Width,
  2493           0) );
  2494  
  2495         //Me ds Tab Spl itters
  2496         Add( StrUserBou nds2(frmMe ds.Name+'S plit',frmM eds.pnlBot tom.Height ,frmMeds.p nlMedIn.He ight,0,0)) ;
  2497  
  2498         //Me ds Tab Non -VA meds c olumns
  2499         Add( StrUserCol umns(fMeds .frmMeds.h drMedsNonV A)); //CQ7 314
  2500  
  2501         //Or ders Tab c olumns
  2502         Add( StrUserCol umns(fOrde rs.frmOrde rs.hdrOrde rs)); //CQ 6328
  2503  
  2504         if E nduringPtS elSplitter Pos <> 0 t hen
  2505           Ad d(StrUserB ounds2('fr mPtSel.spt Vert', End uringPtSel SplitterPo s, 0, 0, 0 ));
  2506         if E nduringPtS elColumns  <> '' then
  2507           Ad d('C^frmPt Sel.lstvAl erts^' + E nduringPtS elColumns) ;
  2508  
  2509         //** ** Copy/Pa ste
  2510   //      Ad d(StrUserB ounds2('fr mNotes.Rea dOnlyEditM onitor', f rmNotes.Re adOnlyEdit Monitor.He ight, 0, 0 , 0)); //  Notes savi ng is done  on the no tes form.
  2511       end;
  2512       //Add  sizes for  forms that  used Save UserBounds () to save  thier pos itions
  2513       SizeHo lder.AddSi zesToStrLi st(SizeLis t);
  2514       //Send  the SizeL ist to the  Database
  2515       SaveUs erSizes(Si zeList);
  2516     finally
  2517       SizeLi st.Free;
  2518     end;
  2519   end;
  2520  
  2521   procedure  TfrmFrame. FormResize (Sender: T Object);
  2522   { need to  resize tab  forms spe cifically  since they  don't inh erit resiz e event (b ecause the y
  2523     are deri ved from T Form itsel f) }
  2524   var
  2525     r: TRect ;
  2526  
  2527   begin
  2528     if FTerm inate or F Closing th en Exit;
  2529     if csDes troying in  Component State then  Exit;
  2530     MoveWind ow(frmCove r.Handle,     0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2531     MoveWind ow(frmProb lems.Handl e, 0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2532     MoveWind ow(frmMeds .Handle,      0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2533     MoveWind ow(frmOrde rs.Handle,    0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2534     MoveWind ow(frmNote s.Handle,     0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2535     MoveWind ow(frmCons ults.Handl e, 0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2536     MoveWind ow(frmDCSu mm.Handle,    0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2537     if Assig ned(frmSur gery) then  MoveWindo w(frmSurge ry.Handle,      0, 0,  pnlPage.C lientWidth , pnlPage. ClientHeig ht, True);
  2538     MoveWind ow(frmLabs .Handle,      0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2539     MoveWind ow(frmRepo rts.Handle ,  0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2540     with sts Area do
  2541     begin
  2542       Panels [1].Width  := stsArea .Width - F FixedStatu sWidth;
  2543       FNextB uttonL :=  Panels[0]. Width + Pa nels[1].Wi dth;
  2544       FNextB uttonR :=  FNextButto nL + Panel s[2].Width ;
  2545     end;
  2546     if Notif ications.A ctive then  SetUpNext Button;
  2547     lstCIRNL ocations.L eft  := FN extButtonL  - ScrollB arWidth -  100;
  2548     lstCIRNL ocations.W idth := Cl ientWidth  - lstCIRNL ocations.L eft;
  2549     //cq: 15 641
  2550     if frmFr ame.FNextB uttonActiv e then //  keeps butt on aligned  if cancel  is presse d
  2551     begin
  2552       FNextB utton.Left  := FNextB uttonL;
  2553       FNextB utton.Top  := stsArea .Top;
  2554     end;
  2555  
  2556     if Self. WindowStat e <> wsMax imized the n
  2557     begin
  2558       r := S creen.Moni torFromWin dow(Self.H andle).Wor kareaRect;
  2559  
  2560       if hei ght > r.He ight then
  2561       begin
  2562         heig ht := r.He ight;
  2563         top  := r.top;
  2564       end;
  2565       if (to p+height)  > r.Bottom  then
  2566         top  := r.Botto m-height;
  2567       if (to p < r.Top)  then top  := r.Top;
  2568     end;
  2569  
  2570     Self.Rep aint;
  2571   end;
  2572  
  2573   procedure  TfrmFrame. ChangeFont (NewFontSi ze: Intege r);
  2574   { Makes ch anges in a ll compone nts whenev er the fon t size is  changed.   This is ha rdcoded an d
  2575     based on  MS Sans S erif for n ow, as onl y the font  size may  be selecte d. Courier  New is us ed
  2576     wherever  non-propo rtional fo nts are re quired. }
  2577   const
  2578     TAB_VOFF SET = 7;
  2579   var
  2580     OldFont:  TFont;
  2581   begin
  2582   // Ho ho!   ResizeAnc horedFormT oFont(self ) doesn't  work here  because th e
  2583   // Form si ze is alia sed with M ainFormSiz e.
  2584     OldFont  := TFont.C reate;
  2585     try
  2586       Disabl eAlign;
  2587       try
  2588         OldF ont.Assign (Font);
  2589         with  Self           do Fo nt.Size :=  NewFontSi ze;
  2590         with  lblPtName      do Fo nt.Size :=  NewFontSi ze;   // m ust change  BOLDED la bels by ha nd
  2591         with  lblPtSSN       do Fo nt.Size :=  NewFontSi ze;
  2592         with  lblPtAge       do Fo nt.Size :=  NewFontSi ze;
  2593         with  lblPtLoca tion do Fo nt.Size :=  NewFontSi ze;
  2594         with  lblPtProv ider do Fo nt.Size :=  NewFontSi ze;
  2595         with  lblPtPost ings do Fo nt.Size :=  NewFontSi ze;
  2596         with  lblPtCare      do Fo nt.Size :=  NewFontSi ze;
  2597         with  lblPtAtte nding do F ont.Size : = NewFontS ize;
  2598         with  lblPtMHTC       do F ont.Size : = NewFontS ize;
  2599         with  lblFlag        do Fo nt.Size :=  NewFontSi ze;
  2600         with  lblPtCWAD      do Fo nt.Size :=  NewFontSi ze;
  2601         with  lblCIRN        do Fo nt.Size :=  NewFontSi ze;
  2602         with  lblVistaW eb   do Fo nt.Size :=  NewFontSi ze;
  2603         with  lstCIRNLo cations do
  2604           be gin
  2605              Font.Size  := NewFont Size;
  2606              ItemHeight  := NewFon tSize + 6;
  2607           en d;
  2608         with  tabPage        do Fo nt.Size :=  NewFontSi ze;
  2609         with  laMHV          do Fo nt.Size :=  NewFontSi ze; //VAA
  2610         with  laVAA2         do Fo nt.Size :=  NewFontSi ze; //VAA
  2611  
  2612         frmF rameHeight  := frmFra me.Height;
  2613         pnlP atientSele ctedHeight  := pnlPat ientSelect ed.Height;
  2614         tabP age.Height  := MainFo ntHeight +  TAB_VOFFS ET;   // r esize tab  selector
  2615         FitT oolbar;                                           // r esize tool bar
  2616         stsA rea.Font.S ize := New FontSize;
  2617         stsA rea.Height  := MainFo ntHeight +  TAB_VOFFS ET;
  2618         stsA rea.Panels [0].Width  := ResizeW idth( OldF ont, Font,  stsArea.P anels[0].W idth);
  2619         stsA rea.Panels [2].Width  := ResizeW idth( OldF ont, Font,  stsArea.P anels[2].W idth);
  2620  
  2621         //VA A CQ8271
  2622         if ( (fCover.Pt IsVAA and  fCover.PtI sMHV)) the n
  2623           be gin
  2624            l aMHV.Heigh t := (pnlT oolBar.Hei ght div 2)  -1;
  2625            w ith laVAA2  do
  2626               begin
  2627               Top := la MHV.Top +  laMHV.Heig ht;
  2628               Height :=  (pnlToolB ar.Height  div 2) -1;
  2629               end;
  2630            e nd;
  2631         //en d VAA
  2632  
  2633         Refr eshFixedSt atusWidth;
  2634         Form Resize( se lf );
  2635       finall y
  2636         Enab leAlign;
  2637       end;
  2638     finally
  2639       OldFon t.Free;
  2640     end;
  2641  
  2642     case (Ne wFontSize)  of
  2643      8: mnu8 pt.Checked  := true;
  2644     10: mnu1 0pt1.Check ed := true ;
  2645     12: mnu1 2pt1.Check ed := true ;
  2646     14: mnu1 4pt1.Check ed := true ;
  2647     18: mnu1 8pt1.Check ed := true ;
  2648     end;
  2649  
  2650     //Now th at the for m elements  are resiz ed, the pa ges will k now what s ize to tak e.
  2651     frmCover .SetFontSi ze(NewFont Size);                  // child  pages lac k a Parent Font prope rty
  2652     frmProbl ems.SetFon tSize(NewF ontSize);
  2653     frmMeds. SetFontSiz e(NewFontS ize);
  2654     frmOrder s.SetFontS ize(NewFon tSize);
  2655     frmNotes .SetFontSi ze(NewFont Size);
  2656     frmConsu lts.SetFon tSize(NewF ontSize);
  2657     frmDCSum m.SetFontS ize(NewFon tSize);
  2658     if Assig ned(frmSur gery) then  frmSurger y.SetFontS ize(NewFon tSize);
  2659     frmLabs. SetFontSiz e(NewFontS ize);
  2660     frmRepor ts.SetFont Size(NewFo ntSize);
  2661     TfrmIcon Legend.Set FontSize(N ewFontSize );
  2662     uOrders. SetFontSiz e(NewFontS ize);
  2663     if Assig ned(frmRem Dlg) then  frmRemDlg. SetFontSiz e;
  2664     //if (Tf rmRemDlg.G etInstance  <> nil) t hen TfrmRe mDlg.GetIn stance.Set FontSize;
  2665     if Assig ned(frmRem inderTree)  then frmR eminderTre e.SetFontS ize(NewFon tSize);
  2666     if Graph Float <> n il then Re sizeAnchor edFormToFo nt(GraphFl oat);
  2667   end;
  2668  
  2669   procedure  TfrmFrame. FitToolBar ;
  2670   { resizes  and reposi tions the  panels & l abels used  in the to olbar }
  2671   const
  2672     PATIENT_ WIDTH = 29 ;
  2673     VISIT_WI DTH   = 36 ;
  2674     POSTING_ WIDTH = 11 .5;
  2675     FLAG_WID TH    = 5;
  2676     CV_WIDTH       = 15 ; //14; WA T
  2677     CIRN_WID TH    = 11 ;
  2678     MHV_WIDT H     = 6;
  2679     LINES_HI GH2    = 2 ;
  2680     LINES_HI GH3    = 3 ;    //lbl PtMHTC lin e change
  2681     M_HORIZ        = 4;
  2682     M_MIDDLE       = 2;
  2683     M_NVERT        = 4;
  2684     M_WVERT        = 6;
  2685     TINY_MAR GIN   = 2;
  2686   begin
  2687     if lblPt MHTC.capti on = '' th en
  2688     begin
  2689       lblPtM HTC.Visibl e := false ;
  2690       pnlToo lbar.Heigh t  := (LIN ES_HIGH2 *  lblPtName .Height) +  M_HORIZ +  M_MIDDLE  + M_HORIZ  + M_MIDDLE
  2691     end
  2692     else
  2693     begin
  2694       if (lb lPtAttendi ng.Caption  <> '') an d (lblPtAt tending.Ca ption <> l blPtMHTC.C aption) th en
  2695       begin
  2696         lblP tMHTC.Visi ble := tru e;
  2697         pnlT oolbar.Hei ght  := (L INES_HIGH3  * lblPtNa me.Height)  + M_HORIZ  + M_MIDDL E + M_HORI Z + M_HORI Z;
  2698       end;
  2699       if lbl PtAttendin g.Caption  = '' then
  2700       begin
  2701         lblP tAttending .Caption : = lblPtMHT C.Caption;
  2702         lblP tMHTC.Visi ble := fal se;
  2703         pnlT oolbar.Hei ght  := (L INES_HIGH2  * lblPtNa me.Height)  + M_HORIZ  + M_MIDDL E + M_HORI Z + M_MIDD LE;
  2704       end;
  2705     end;
  2706     pnlPatie nt.Width    := Higher Of(PATIENT _WIDTH * M ainFontWid th, lblPtN ame.Width  + (M_WVERT  * 2));
  2707     lblPtSSN .Top        := M_HORI Z + lblPtN ame.Height  + M_MIDDL E;
  2708     lblPtAge .Top        := lblPtS SN.Top;
  2709     lblPtAge .Left       := pnlPat ient.Width  - lblPtAg e.Width -  M_WVERT;
  2710     pnlVisit .Width      := Higher Of(LowerOf (VISIT_WID TH * MainF ontWidth,
  2711                                                HigherOf( lblPtProvi der.Width  + (M_WVERT  * 2),
  2712                                                          lblPtLocat ion.Width  + (M_WVERT  * 2))),
  2713                                       PATIENT _WIDTH * M ainFontWid th);
  2714     lblPtPro vider.Top   := lblPtS SN.Top;
  2715     lblPtAtt ending.Top  := lblPtS SN.Top;
  2716     lblPtMHT C.Top        := M_MID DLE + lblP tSSN.Heigh t + lblPtS SN.Top;
  2717     pnlPosti ngs.Width   := Round( POSTING_WI DTH * Main FontWidth) ;
  2718     if btnCo mbatVet.Vi sible then
  2719      begin
  2720       pnlCVn Flag.Width    := Roun d(CV_WIDTH  * MainFon tWidth);
  2721       pnlFla g.Width       := Roun d(CV_WIDTH  * MainFon tWidth);
  2722       btnCom batVet.Hei ght := Rou nd(pnlCVnF lag.Height  div 2);
  2723      end
  2724     else
  2725      begin
  2726       pnlCVn Flag.Width    := Roun d(FLAG_WID TH * MainF ontWidth);
  2727       pnlFla g.Width       := Roun d(FLAG_WID TH * MainF ontWidth);
  2728      end;
  2729     pnlRemot eData.Widt h := Round (CIRN_WIDT H * MainFo ntWidth) +  M_WVERT;
  2730     pnlVista Web.Height  := pnlRem oteData.He ight div 2 ;
  2731     paVAA.Wi dth         := Round( MHV_WIDTH  * MainFont Width) + M _WVERT + 2 ;
  2732     with lbl PtPostings  do
  2733       SetBou nds(M_WVER T, M_HORIZ , pnlPosti ngs.Width- M_WVERT-M_ WVERT, lbl PtName.Hei ght);
  2734     with lbl PtCWAD      do
  2735       SetBou nds(M_WVER T, lblPtSS N.Top, lbl PtPostings .Width, lb lPtName.He ight);
  2736     //Low re solution h andling: F irst, try  to fit eve rything on  by shrink ing fields
  2737     if pnlPr imaryCare. Width < Hi gherOf( lb lPtCare.Le ft + lblPt Care.Width , HigherOf (lblPtAtte nding.Left  + lblPtAt tending.Wi dth,lblPtM HTC.Left +  lblPtMHTC .Width)) +  TINY_MARG IN then
  2738     //if pnl PrimaryCar e.Width <  HigherOf(  lblPtCare. Left + lbl PtCare.Wid th, lblPtA ttending.L eft + lblP tAttending .Width) +  TINY_MARGI N then
  2739     begin
  2740       lblPtA ge.Left :=  lblPtAge. Left - (lb lPtName.Le ft - TINY_ MARGIN);
  2741       lblPtN ame.Left : = TINY_MAR GIN;
  2742       lblPTS SN.Left :=  TINY_MARG IN;
  2743       pnlPat ient.Width  := Higher Of( lblPtN ame.Left +  lblPtName .Width, lb lPtAge.Lef t + lblPtA ge.Width)+  TINY_MARG IN;
  2744       lblPtL ocation.Le ft := TINY _MARGIN;
  2745       lblPtP rovider.Le ft := TINY _MARGIN;
  2746       pnlVis it.Width : = HigherOf ( lblPtLoc ation.Left  + lblPtLo cation.Wid th, lblPtP rovider.Le ft + lblPt Provider.W idth)+ TIN Y_MARGIN;
  2747     end;
  2748     HorzScro llBar.Rang e := 0;
  2749   end;
  2750  
  2751   { Temporar y Calls -- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2752  
  2753   procedure  TfrmFrame. ToggleMenu ItemChecke d(Sender:  TObject);
  2754   begin
  2755     TMenuIte m(Sender). Checked :=  not TMenu Item(Sende r).Checked ;
  2756   end;
  2757  
  2758   {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------}
  2759   {  mnuFocu sChangesCl ick - togg les the Fo cused Cont rols windo w for form s that sup port it  }
  2760   {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------}
  2761   procedure  TfrmFrame. mnuFocusCh angesClick (Sender: T Object);
  2762   begin
  2763     inherite d;
  2764     ShowFocu sedControl Dialog :=  mnuFocusCh anges.Chec ked;
  2765   end;
  2766  
  2767   procedure  TfrmFrame. mnuFontSiz eClick(Sen der: TObje ct);
  2768   begin
  2769     if (frmR emDlg <> n il) then
  2770       ShowMs g('Please  close the  reminder d ialog befo re changin g font siz es.')
  2771     else if  (dlgProbs  <> nil) th en
  2772       ShowMs g('Font si ze cannot  be changed  while add ing or edi ting a pro blem.')
  2773     else beg in
  2774       with ( Sender as  TMenuItem)  do begin
  2775         Togg leMenuItem Checked(Se nder);
  2776         fMed s.oldFont  := MainFon tSize; //C Q9182
  2777         Chan geFont(Tag );
  2778       end;
  2779     end;
  2780   end;
  2781  
  2782   procedure  TfrmFrame. mnuEditCli ck(Sender:  TObject);
  2783   var
  2784     IsReadOn ly: Boolea n;
  2785   begin
  2786     FEditCtr l := nil;
  2787     if Scree n.ActiveCo ntrol is T CustomEdit  then FEdi tCtrl := T CustomEdit (Screen.Ac tiveContro l);
  2788     if FEdit Ctrl <> ni l then beg in
  2789       if       FEditCtr l is TMemo      then  IsReadOnly  := TMemo( FEditCtrl) .ReadOnly
  2790       else i f FEditCtr l is TEdit      then  IsReadOnly  := TEdit( FEditCtrl) .ReadOnly
  2791       else i f FEditCtr l is TRich Edit then  IsReadOnly  := TRichE dit(FEditC trl).ReadO nly
  2792       else I sReadOnly  := True;
  2793  
  2794       mnuEdi tRedo.Enab led := FEd itCtrl.Per form(EM_CA NREDO, 0,  0) <> 0;
  2795       mnuEdi tUndo.Enab led := (FE ditCtrl.Pe rform(EM_C ANUNDO, 0,  0) <> 0)  and (FEdit Ctrl.Perfo rm(EM_CANR EDO, 0, 0)  = 0);
  2796  
  2797       mnuEdi tCut.Enabl ed := FEdi tCtrl.SelL ength > 0;
  2798       mnuEdi tCopy.Enab led := mnu EditCut.En abled;
  2799       mnuEdi tPaste.Ena bled := (I sReadOnly  = False) a nd Clipboa rd.HasForm at(CF_TEXT );
  2800     end else  begin
  2801       mnuEdi tUndo.Enab led  := Fa lse;
  2802       mnuEdi tCut.Enabl ed   := Fa lse;
  2803       mnuEdi tCopy.Enab led  := Fa lse;
  2804       mnuEdi tPaste.Ena bled := Fa lse;
  2805     end;
  2806   end;
  2807  
  2808   procedure  TfrmFrame. mnuEditUnd oClick(Sen der: TObje ct);
  2809   begin
  2810     FEditCtr l.Perform( EM_UNDO, 0 , 0);
  2811   end;
  2812  
  2813   procedure  TfrmFrame. mnuEditRed oClick(Sen der: TObje ct);
  2814   begin
  2815     FEditCtr l.Perform( EM_REDO, 0 , 0);
  2816   end;
  2817  
  2818  
  2819   procedure  TfrmFrame. mnuEditCut Click(Send er: TObjec t);
  2820   begin
  2821     FEditCtr l.CutToCli pboard;
  2822   end;
  2823  
  2824   procedure  TfrmFrame. mnuEditCop yClick(Sen der: TObje ct);
  2825   begin
  2826     FEditCtr l.CopyToCl ipboard;
  2827   end;
  2828  
  2829   procedure  TfrmFrame. mnuEditPas teClick(Se nder: TObj ect);
  2830   begin
  2831     FEditCtr l.PasteFro mClipboard ;  // use  AsText to  prevent fo rmatting f rom being  pasted
  2832   end;
  2833  
  2834   procedure  TfrmFrame. mnuFilePri ntClick(Se nder: TObj ect);
  2835   begin
  2836     case mnu FilePrint. Tag of
  2837     CT_NOTES :    frmNo tes.Reques tPrint;
  2838     CT_CONSU LTS: frmCo nsults.Req uestPrint;
  2839     CT_DCSUM M:   frmDC Summ.Reque stPrint;
  2840     CT_REPOR TS:  frmRe ports.Requ estPrint;
  2841     CT_LABS:      frmLa bs.Request Print;
  2842     CT_ORDER S:   frmOr ders.Reque stPrint;
  2843     CT_PROBL EMS: frmPr oblems.Req uestPrint;
  2844     CT_SURGE RY:  if As signed(frm Surgery) t hen frmSur gery.Reque stPrint;
  2845     end;
  2846   end;
  2847  
  2848   procedure  TfrmFrame. WMSysComma nd(var Mes sage: TMes sage);
  2849   begin
  2850     case Tab ToPageID(t abPage.Tab Index) of
  2851       CT_NOT ES:
  2852           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then
  2853              with Messa ge do
  2854                begin
  2855                  SendMe ssage(frmN otes.Handl e, Msg, WP aram, LPar am);
  2856                  Result  := 0;
  2857                end
  2858           el se
  2859              inherited;
  2860       CT_DCS UMM:
  2861           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboAttendi ng') then
  2862              with Messa ge do
  2863                begin
  2864                  SendMe ssage(frmD CSumm.Hand le, Msg, W Param, lPa ram);
  2865                  Result  := 0;
  2866                end
  2867           el se
  2868              inherited;
  2869       CT_CON SULTS:
  2870           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then
  2871              with Messa ge do
  2872                begin
  2873                  SendMe ssage(frmC onsults.Ha ndle, Msg,  WParam, l Param);
  2874                  Result  := 0;
  2875                end
  2876           el se
  2877              inherited;
  2878     else
  2879       inheri ted;
  2880     end;
  2881     if Messa ge.WParam  = SC_MAXIM IZE then
  2882     begin
  2883       // for m becomes  maximized;
  2884       frmOrd ers.mnuOpt imizeField sClick(sel f);
  2885       frmPro blems.mnuO ptimizeFie ldsClick(s elf);
  2886       frmMed s.mnuOptim izeFieldsC lick(self) ;
  2887     end
  2888     else if  Message.WP aram = SC_ MINIMIZE t hen
  2889     begin
  2890       // for m becomes  maximized;
  2891     end
  2892     else if  Message.WP aram = SC_ RESTORE th en
  2893     begin
  2894       // for m is resto red (from  maximized) ;
  2895       frmOrd ers.mnuOpt imizeField sClick(sel f);
  2896       frmPro blems.mnuO ptimizeFie ldsClick(s elf);
  2897       frmMed s.mnuOptim izeFieldsC lick(self) ;
  2898     end;
  2899   end;
  2900  
  2901   procedure  TfrmFrame. RemindersC hanged(Sen der: TObje ct);
  2902   var
  2903     ImgName:  string;
  2904   begin
  2905     pnlRemin ders.tag : = HAVE_REM INDERS;
  2906     pnlRemin ders.Hint  := 'Click  to display  reminders ';
  2907     case Get ReminderSt atus of
  2908       rsUnkn own:
  2909         begi n
  2910           Im gName := ' BMP_REMIND ERS_UNKNOW N';
  2911           pn lReminders .Caption : = 'Reminde rs';
  2912         end;
  2913       rsDue:
  2914         begi n
  2915           Im gName := ' BMP_REMIND ERS_DUE';
  2916           pn lReminders .Caption : = 'Due Rem inders';
  2917         end;
  2918       rsAppl icable:
  2919         begi n
  2920           Im gName := ' BMP_REMIND ERS_APPLIC ABLE';
  2921           pn lReminders .Caption : = 'Applica ble Remind ers';
  2922         end;
  2923       rsNotA pplicable:
  2924         begi n
  2925           Im gName := ' BMP_REMIND ERS_OTHER' ;
  2926           pn lReminders .Caption : = 'Other R eminders';
  2927         end;
  2928       else
  2929         begi n
  2930           Im gName := ' BMP_REMIND ERS_NONE';
  2931           pn lReminders .Hint := ' There are  currently  no reminde rs availab le';
  2932           pn lReminders .Caption : = pnlRemin ders.Hint;
  2933           pn lReminders .tag := NO _REMINDERS ;
  2934         end;
  2935     end;
  2936     if(Remin dersEvalua tingInBack ground) th en
  2937     begin
  2938       if(anm tRemSearch .ResName =  '') then
  2939       begin
  2940         TORE xposedAnim ate(anmtRe mSearch).O nMouseDown  := pnlRem indersMous eDown;
  2941         TORE xposedAnim ate(anmtRe mSearch).O nMouseUp    := pnlRem indersMous eUp;
  2942         anmt RemSearch. ResHandle  := 0;
  2943         anmt RemSearch. ResName :=  'REMSEARC HAVI';
  2944       end;
  2945       imgRem inder.Visi ble := FAL SE;
  2946       anmtRe mSearch.Ac tive := TR UE;
  2947       anmtRe mSearch.Vi sible := T RUE;
  2948       if(pnl Reminders. Hint <> '' ) then
  2949         pnlR eminders.H int := CRL F + pnlRem inders.Hin t + '.';
  2950       pnlRem inders.Hin t := 'Eval uating Rem inders...   ' + pnlRe minders.Hi nt;
  2951       pnlRem inders.Cap tion := pn lReminders .Hint;
  2952     end
  2953     else
  2954     begin
  2955       anmtRe mSearch.Vi sible := F ALSE;
  2956       imgRem inder.Visi ble := TRU E;
  2957       imgRem inder.Pict ure.Bitmap .LoadFromR esourceNam e(hInstanc e, ImgName );
  2958       anmtRe mSearch.Ac tive := FA LSE;
  2959     end;
  2960     mnuViewR eminders.E nabled :=  (pnlRemind ers.tag =  HAVE_REMIN DERS);
  2961   end;
  2962  
  2963   procedure  TfrmFrame. pnlReminde rsMouseDow n(Sender:  TObject;
  2964     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2965   begin
  2966     if(not I nitialRemi ndersLoade d) then
  2967       Startu pReminders ;
  2968     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  2969       pnlRem inders.Bev elOuter :=  bvLowered ;
  2970   end;
  2971  
  2972   procedure  TfrmFrame. pnlReminde rsMouseUp( Sender: TO bject;
  2973     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2974   begin
  2975     pnlRemin ders.Bevel Outer := b vRaised;
  2976     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  2977       ViewIn fo(mnuView Reminders) ;
  2978   end;
  2979  
  2980   //-------- ---------- --- CIRN-r elated pro cedures -- ---------- ---------- ----------
  2981  
  2982   procedure  TfrmFrame. SetUpCIRN;
  2983   var
  2984     i: integ er;
  2985     iNwHIN,  iRDVOnly:  integer;
  2986     aAutoQue ry,aVistaW ebLabel: s tring;
  2987     ASite: T RemoteSite ;
  2988     item: TV A508Access ibilityIte m;
  2989     id: inte ger;
  2990   begin
  2991     uUseVist aWeb := fa lse;
  2992     with Rem oteSites d o
  2993     begin
  2994       Change Patient(Pa tient.DFN) ;
  2995       lblCIR N.Caption  := ' Remot e Data';
  2996       lblCIR N.Alignmen t := taCen ter;
  2997       aVista WebLabel : = GetVista Web_JLV_La belName;
  2998       if aVi staWebLabe l = '' the n aVistaWe bLabel :=  'VistaWeb' ;
  2999       lblVis taWeb.Capt ion := aVi staWebLabe l;
  3000       pnlVis taWeb.Beve lOuter :=  bvRaised;
  3001       iNwHIN  := 0;
  3002       iRDVOn ly := 0;
  3003       for i  := 0 to Re moteSites. Count - 1  do
  3004         begi n
  3005           if  not(LeftS tr(TRemote Site(Remot eSites.Sit eList.Item s[i]).Site ID, 4) = ' 200N') the n
  3006              begin
  3007                iRDVOnly  := 1;
  3008                continue ;
  3009              end
  3010           el se
  3011              iNwHIN :=  1;
  3012         end;
  3013  
  3014       if Rem oteDataExi sts and (( iRDVOnly =  1) or (iN wHIN = 1))  and (Remo teSites.Co unt > 0) t hen
  3015         begi n
  3016           if  ScreenRea derSystemA ctive then
  3017           be gin
  3018            i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData,  False);
  3019            i d:= item.I NDEX;
  3020            a mgrMain.Ac cessData[i d].AccessT ext := '';
  3021           en d;
  3022           lb lCIRN.Enab led     :=  True;
  3023           pn lCIRN.TabS top     :=  True;
  3024           lb lCIRN.Font .Color  :=  Get508Com pliantColo r(clBlue);
  3025           ls tCIRNLocat ions.Font. Color  :=  Get508Comp liantColor (clBlue);
  3026           lb lCIRN.Capt ion := 'Re mote Data' ;
  3027           pn lCIRN.Hint  := 'Click  to displa y other fa cilities h aving data  for this  patient.';
  3028           lb lVistaWeb. Font.Color  := Get508 CompliantC olor(clBlu e);
  3029           pn lVistaWeb. Hint := 'C lick to go  to ' + aV istaWebLab el + ' to  see data f rom other  facilities  for this  patient.';
  3030           if  RemoteSit es.Count >  0 then
  3031              lstCIRNLoc ations.Ite ms.Add('0'  + U + 'Al l Availabl e Sites');
  3032           fo r i := 0 t o RemoteSi tes.Count  - 1 do
  3033              begin
  3034                ASite :=  TRemoteSi te(SiteLis t[i]);
  3035                lstCIRNL ocations.I tems.Add(A Site.SiteI D + U + AS ite.SiteNa me + U +
  3036                  Format FMDateTime ('mmm dd y yyy hh:nn' , ASite.La stDate));
  3037              end;
  3038         end
  3039       else
  3040         begi n
  3041           if  ScreenRea derSystemA ctive then
  3042           be gin
  3043            i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData,  False);
  3044            i d:= item.I NDEX;
  3045            a mgrMain.Ac cessData[i d].AccessT ext := 'No  remote da ta availab le';
  3046           en d;
  3047           lb lCIRN.Font .Color  :=  clWindowT ext;
  3048           lb lVistaWeb. Font.Color  := clWind owText;
  3049           lb lCIRN.Enab led     :=  False;
  3050           pn lCIRN.TabS top     :=  False;
  3051           pn lCIRN.Hint  := NoData Reason;
  3052           if  (iNwHIN =  1) and (i RDVOnly =  0) then
  3053              begin
  3054               lblVistaW eb.Font.Co lor := Get 508Complia ntColor(cl Blue);
  3055               pnlVistaW eb.Hint :=  'Click to  go to ' +  aVistaWeb Label + '  to see dat a from oth er facilit ies for th is patient  (includes  Non-VA da ta).';
  3056              end;
  3057         end;
  3058       aAutoQ uery := Au toRDV;         //Chec k to see i f Remote Q ueries sho uld be use d for all  available  sites
  3059       if (aA utoQuery =  '1') and  (lstCIRNLo cations.Co unt > 0) t hen
  3060         begi n
  3061           ls tCIRNLocat ions.ItemI ndex := 1;
  3062           ls tCIRNLocat ions.Check ed[1] := t rue;
  3063           ls tCIRNLocat ionsClick( self);
  3064         end;
  3065     end;
  3066   end;
  3067  
  3068   procedure  TfrmFrame. pnlCIRNCli ck(Sender:  TObject);
  3069   begin
  3070     ViewInfo (mnuViewRe moteData);
  3071   end;
  3072  
  3073   procedure  TfrmFrame. lstCIRNLoc ationsClic k(Sender:  TObject);
  3074   var
  3075     iIndex,j ,iAll,iCur : integer;
  3076     aMsg,s:  string;
  3077     AccessSt atus: inte ger;
  3078   begin
  3079     iAll :=  1;
  3080     AccessSt atus := 0;
  3081     iIndex : = lstCIRNL ocations.I temIndex;
  3082     if not C heckHL7TCP Link then
  3083       begin
  3084         Info Box('Local  HL7 TCP L ink is dow n.' + CRLF  + 'Unable  to retrie ve remote  data.', TC _DGSR_ERR,  MB_OK);
  3085         lstC IRNLocatio ns.Checked [iIndex] : = false;
  3086         Exit ;
  3087       end;
  3088     if lstCI RNLocation s.Items.Co unt > 1 th en
  3089       if pie ce(lstCIRN Locations. Items[1],' ^',1) = '0 ' then
  3090         iAll  := 2;
  3091     with frm Reports do
  3092       if pie ce(uRemote Type,'^',2 ) = 'V' th en
  3093         begi n
  3094           lv Reports.It ems.BeginU pdate;
  3095           lv Reports.It ems.Clear;
  3096           lv Reports.Co lumns.Clea r;
  3097           lv Reports.It ems.EndUpd ate;
  3098         end;
  3099     uReportI nstruction  := '';
  3100     frmRepor ts.TabCont rol1.Tabs. Clear;
  3101     frmLabs. TabControl 1.Tabs.Cle ar;
  3102     frmRepor ts.TabCont rol1.Tabs. AddObject( 'Local',ni l);
  3103     frmLabs. TabControl 1.Tabs.Add Object('Lo cal',nil);
  3104     StatusTe xt('Checki ng Remote  Sites...') ;
  3105     if piece (lstCIRNLo cations.It ems[iIndex ],'^',1) =  '0' then  // All sit es have be en clicked
  3106       if lst CIRNLocati ons.Checke d[iIndex]  = false th en // All  selection  is being t urned off
  3107         begi n
  3108           wi th RemoteS ites.SiteL ist do
  3109           fo r j := 0 t o Count -  1 do
  3110              if lstCIRN Locations. Checked[j+ 1] = true  then
  3111                begin
  3112                  lstCIR NLocations .Checked[j +1] := fal se;
  3113                  TRemot eSite(Remo teSites.Si teList[j]) .Selected  := false;
  3114                  TRemot eSite(Remo teSites.Si teList[j]) .ReportCle ar;
  3115                  TRemot eSite(Remo teSites.Si teList[j]) .LabClear;
  3116                end;
  3117         end
  3118       else
  3119         begi n
  3120           wi th RemoteS ites.SiteL ist do
  3121           fo r j := 0 t o Count -  1 do
  3122                begin
  3123                  Screen .Cursor :=  crHourGla ss;
  3124                  Screen .Cursor :=  crDefault ;
  3125                  aMsg : = aMsg + '  at site:  ' + TRemot eSite(Item s[j]).Site Name;
  3126                  s := l stCIRNLoca tions.Item s[j+1];
  3127                  lstCIR NLocations .Items[j+1 ] := piece s(s, '^',  1, 3);
  3128                  case A ccessStatu s of
  3129                  DGSR_F AIL: begin
  3130                                if  piece(aMsg ,':',1) =  'RPC name  not found  at site' t hen //Allo w for back ward compa tibility
  3131                                  b egin
  3132                                     lstCIRNLo cations.Ch ecked[j+1]  := true;
  3133                                     TRemoteSi te(RemoteS ites.SiteL ist[j]).Re portClear;
  3134                                     TRemoteSi te(RemoteS ites.SiteL ist[j]).La bClear;
  3135                                     TRemoteSi te(Items[j ]).Selecte d := true;
  3136                                  e nd
  3137                                els e
  3138                                  b egin
  3139                                     InfoBox(a Msg, TC_DG SR_ERR, MB _OK);
  3140                                     lstCIRNLo cations.Ch ecked[j+1]  := false;
  3141                                     lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1,  3) + '^' +  TC_DGSR_E RR;
  3142                                     TRemoteSi te(Items[j ]).Selecte d := false ;
  3143                                     Continue;
  3144                                  e nd;
  3145                              end;
  3146                  DGSR_N ONE: begin
  3147                                lst CIRNLocati ons.Checke d[j+1] :=  true;
  3148                                TRe moteSite(R emoteSites .SiteList[ j]).Report Clear;
  3149                                TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar;
  3150                                TRe moteSite(I tems[j]).S elected :=  true;
  3151                              end;
  3152                  DGSR_S HOW: begin
  3153                                Inf oBox(AMsg,  TC_DGSR_S HOW, MB_OK );
  3154                                lst CIRNLocati ons.Checke d[j+1] :=  true;
  3155                                TRe moteSite(R emoteSites .SiteList[ j]).Report Clear;
  3156                                TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar;
  3157                                TRe moteSite(I tems[j]).S elected :=  true;
  3158                              end;
  3159                  DGSR_A SK:  if In foBox(AMsg  + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO  or MB_ICO NWARNING o r
  3160                                MB_ DEFBUTTON2 ) = IDYES  then
  3161                                beg in
  3162                                  l stCIRNLoca tions.Chec ked[j+1] : = true;
  3163                                  T RemoteSite (RemoteSit es.SiteLis t[j]).Repo rtClear;
  3164                                  T RemoteSite (RemoteSit es.SiteLis t[j]).LabC lear;
  3165                                  T RemoteSite (Items[j]) .Selected  := true;
  3166                                end
  3167                                els e
  3168                                  b egin
  3169                                     lstCIRNLo cations.Ch ecked[j+1]  := false;
  3170                                     lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1,  3) + '^' +  TC_DGSR_S HOW;
  3171                                     TRemoteSi te(Items[j ]).Selecte d := false ;
  3172                                     Continue;
  3173                                  e nd;
  3174                  else        begin
  3175                                Inf oBox(AMsg,  TC_DGSR_D ENY, MB_OK );
  3176                                lst CIRNLocati ons.Checke d[j+1] :=  false;
  3177                                lst CIRNLocati ons.Items[ j+1] := pi eces(s, '^ ', 1, 3) +  '^' + TC_ DGSR_DENY;
  3178                                TRe moteSite(I tems[j]).S elected :=  false;
  3179                                Con tinue;
  3180                              end;
  3181                  end;
  3182                end;
  3183         end
  3184     else
  3185       begin
  3186         if i Index > 0  then
  3187           be gin
  3188              iCur := iI ndex - iAl l;
  3189              TRemoteSit e(RemoteSi tes.SiteLi st[iCur]). Selected : =
  3190                lstCIRNL ocations.C hecked[iIn dex];
  3191              if lstCIRN Locations. Checked[iI ndex] = tr ue then
  3192                with Rem oteSites.S iteList do
  3193                begin
  3194                  Screen .Cursor :=  crHourGla ss;
  3195                  Screen .Cursor :=  crDefault ;
  3196                  aMsg : = aMsg + '  at site:  ' + TRemot eSite(Item s[iCur]).S iteName;
  3197                  s := l stCIRNLoca tions.Item s[iIndex];
  3198                  lstCIR NLocations .Items[iIn dex] := pi eces(s, '^ ', 1, 3);
  3199                  case A ccessStatu s of
  3200                  DGSR_F AIL: begin
  3201                                if  piece(aMsg ,':',1) =  'RPC name  not found  at site' t hen //Allo w for back ward compa tibility
  3202                                  b egin
  3203                                     lstCIRNLo cations.Ch ecked[iInd ex] := tru e;
  3204                                     TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .ReportCle ar;
  3205                                     TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .LabClear;
  3206                                     TRemoteSi te(Items[i Cur]).Sele cted := tr ue;
  3207                                  e nd
  3208                                els e
  3209                                  b egin
  3210                                     InfoBox(a Msg, TC_DG SR_ERR, MB _OK);
  3211                                     lstCIRNLo cations.Ch ecked[iInd ex] := fal se;
  3212                                     lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^',  1, 3) + '^ ' + TC_DGS R_ERR;
  3213                                     TRemoteSi te(Items[i Cur]).Sele cted := fa lse;
  3214                                  e nd;
  3215                              end;
  3216                  DGSR_N ONE: begin
  3217                                lst CIRNLocati ons.Checke d[iIndex]  := true;
  3218                                TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear;
  3219                                TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear;
  3220                                TRe moteSite(I tems[iCur] ).Selected  := true;
  3221                              end;
  3222                  DGSR_S HOW: begin
  3223                                Inf oBox(AMsg,  TC_DGSR_S HOW, MB_OK );
  3224                                lst CIRNLocati ons.Checke d[iIndex]  := true;
  3225                                TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear;
  3226                                TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear;
  3227                                TRe moteSite(I tems[iCur] ).Selected  := true;
  3228                              end;
  3229                  DGSR_A SK:  if In foBox(AMsg  + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO  or MB_ICO NWARNING o r
  3230                                MB_ DEFBUTTON2 ) = IDYES  then
  3231                                beg in
  3232                                  l stCIRNLoca tions.Chec ked[iIndex ] := true;
  3233                                  T RemoteSite (RemoteSit es.SiteLis t[iCur]).R eportClear ;
  3234                                  T RemoteSite (RemoteSit es.SiteLis t[iCur]).L abClear;
  3235                                  T RemoteSite (Items[iCu r]).Select ed := true ;
  3236                                end
  3237                                els e
  3238                                  b egin
  3239                                     lstCIRNLo cations.Ch ecked[iInd ex] := fal se;
  3240                                     lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^',  1, 3) + '^ ' + TC_DGS R_SHOW;
  3241                                  e nd;
  3242                  else        begin
  3243                                Inf oBox(AMsg,  TC_DGSR_D ENY, MB_OK );
  3244                                lst CIRNLocati ons.Checke d[iIndex]  := false;
  3245                                lst CIRNLocati ons.Items[ iIndex] :=  pieces(s,  '^', 1, 3 ) + '^' +  TC_DGSR_DE NY;
  3246                                TRe moteSite(I tems[iCur] ).Selected  := false;
  3247                              end;
  3248                  end;
  3249                  with f rmReports  do
  3250                    if p iece(uRemo teType,'^' ,1) = '1'  then
  3251                      if  not(piece (uRemoteTy pe,'^',2)  = 'V') the n
  3252                         begin
  3253                           TabContr ol1.Visibl e := true;
  3254                           pnlRight Top.Height  := lblTit le.Height  + TabContr ol1.Height ;
  3255                         end;
  3256                  with f rmLabs do
  3257                    if p iece(uRemo teType,'^' ,1) = '1'  then
  3258                      if  not(piece (uRemoteTy pe,'^',2)  = 'V') the n
  3259                         begin
  3260                           TabContr ol1.Visibl e := true;
  3261                           pnlRight Top.Height  := lblTit le.Height  + TabContr ol1.Height ;
  3262                         end;
  3263                end;
  3264           en d;
  3265       end;
  3266     with Rem oteSites.S iteList do
  3267       for j  := 0 to Co unt - 1 do
  3268         if T RemoteSite (Items[j]) .Selected
  3269           an d (not(Lef tStr(TRemo teSite(Ite ms[j]).Sit eID ,4) =  '200N'))   then
  3270           be gin
  3271              frmReports .TabContro l1.Tabs.Ad dObject(TR emoteSite( Items[j]). SiteName,
  3272                TRemoteS ite(Items[ j]));
  3273              frmLabs.Ta bControl1. Tabs.AddOb ject(TRemo teSite(Ite ms[j]).Sit eName,
  3274                TRemoteS ite(Items[ j]));
  3275           en d;
  3276     if not(P iece(uRepo rtID,':',1 ) = 'OR_VW AL')
  3277       and no t(Piece(uR eportID,': ',1) = 'OR _VWRX')
  3278       and no t(Piece(uR eportID,': ',1) = 'OR _VWVS')
  3279       and (f rmReports. tvReports. SelectionC ount > 0)  then frmRe ports.tvRe portsClick (self);
  3280     if not(u LabRepID =  '6:GRAPH' ) and not( uLabRepID  = '5:WORKS HEET')
  3281       and no t(uLabRepI D = '4:SEL ECTED TEST S BY DATE' )
  3282       and (f rmLabs.tvR eports.Sel ectionCoun t > 0) the n frmLabs. tvReportsC lick(self) ;
  3283     StatusTe xt('');
  3284   end;
  3285  
  3286   procedure  TfrmFrame. popCIRNClo seClick(Se nder: TObj ect);
  3287   begin
  3288     lstCIRNL ocations.V isible :=  False;
  3289     lstCirnL ocations.S endToBack;
  3290     pnlCIRN. BevelOuter  := bvRais ed;
  3291   end;
  3292  
  3293   procedure  TfrmFrame. popCIRNSel ectAllClic k(Sender:  TObject);
  3294  
  3295   begin
  3296     lstCIRNL ocations.I temIndex : = 0;
  3297     lstCIRNL ocations.C hecked[0]  := true;
  3298     lstCIRNL ocations.O nClick(Sel f);
  3299   end;
  3300  
  3301   procedure  TfrmFrame. popCIRNSel ectNoneCli ck(Sender:  TObject);
  3302  
  3303   begin
  3304     lstCIRNL ocations.I temIndex : = 0;
  3305     lstCIRNL ocations.C hecked[0]  := false;
  3306     lstCIRNL ocations.O nClick(Sel f);
  3307   end;
  3308  
  3309   procedure  TfrmFrame. mnuFilePri ntSetupCli ck(Sender:  TObject);
  3310   var
  3311     CurrPrt:  string;
  3312   begin
  3313     CurrPrt  := SelectD evice(Self , Encounte r.Location , True, 'P rint Devic e Selectio n');
  3314     User.Cur rentPrinte r := Piece (CurrPrt,  U, 1);
  3315   end;
  3316  
  3317   procedure  TfrmFrame. LabInfo1Cl ick(Sender : TObject) ;
  3318   begin
  3319     ExecuteL abInfo;
  3320   end;
  3321  
  3322   procedure  TfrmFrame. mnuFileNot ifRemoveCl ick(Sender : TObject) ;
  3323   const
  3324     TC_REMOV E_ALERT  =  'Remove C urrent Ale rt';
  3325     TX_REMOV E_ALERT1 =  'This act ion will d elete the  alert you  are curren tly proces sing; the  alert will  ' + CRLF  +
  3326           'd isappear a utomatical ly when al l orders h ave been a cted on, b ut this ac tion may'  + CRLF +
  3327           'b e used to  remove the  alert if  some order s are to b e left unc hanged.' +  CRLF + CR LF +
  3328           'Y our ';
  3329     TX_REMOV E_ALERT2 =  ' alert f or ';
  3330     TX_REMOV E_ALERT3 =  ' will be  deleted!'  + CRLF +  CRLF + 'Ar e you sure ?';
  3331   var
  3332     AlertMsg , AlertTyp e: string;
  3333  
  3334     procedur e StopProc essingNoti fs;
  3335       begin
  3336         Noti fications. Clear;
  3337         FNex tButtonAct ive := Fal se;
  3338         stsA rea.Panels [2].Bevel  := pbLower ed;
  3339         mnuF ileNext.En abled := F alse;
  3340         mnuF ileNotifRe move.Enabl ed := Fals e;
  3341       end;
  3342  
  3343   begin
  3344     if not N otificatio ns.Active  then Exit;
  3345     case Not ifications .Followup  of
  3346       NF_MED ICATIONS_E XPIRING_IN PT    : Al ertType :=  'Expiring  Medicatio ns';
  3347       NF_MED ICATIONS_E XPIRING_OU TPT   : Al ertType :=  'Expiring  Medicatio ns';
  3348       NF_ORD ER_REQUIRE S_ELEC_SIG NATURE: Al ertType :=  'Unsigned  Orders';
  3349       NF_FLA GGED_ORDER S                : Al ertType :=  'Flagged  Orders (fo r clarific ation)';
  3350       NF_UNV ERIFIED_ME DICATION_O RDER  : Al ertType :=  'Unverifi ed Medicat ion Order' ;
  3351       NF_UNV ERIFIED_OR DER              : Al ertType :=  'Unverifi ed Order';
  3352       NF_FLA GGED_OI_EX P_INPT           : Al ertType :=  'Flagged  Orderable  Item (INPT )';
  3353       NF_FLA GGED_OI_EX P_OUTPT          : Al ertType :=  'Flagged  Orderable  Item (OUTP T)';
  3354     else
  3355       Exit;
  3356     end;
  3357     AlertMsg  := TX_REM OVE_ALERT1  + AlertTy pe + TX_RE MOVE_ALERT 2 + Patien t.Name + T X_REMOVE_A LERT3;
  3358     if InfoB ox(AlertMs g, TC_REMO VE_ALERT,  MB_YESNO)  = ID_YES t hen
  3359       begin
  3360         Noti fications. DeleteForC urrentUser ;
  3361         Noti fications. Next;   //  avoid pro mpt if no  more alert s selected  to proces s  {v14a R V}
  3362         if N otificatio ns.Active  then
  3363           be gin
  3364              if (InfoBo x(TX_NOTIF _STOP, TC_ NOTIF_STOP , MB_YESNO ) = ID_NO)  then
  3365                begin
  3366                  Notifi cations.Pr ior;
  3367                  mnuFil eNextClick (Self);
  3368                end
  3369              else
  3370                StopProc essingNoti fs;
  3371           en d
  3372         else
  3373           St opProcessi ngNotifs;
  3374       end;
  3375   end;
  3376  
  3377   procedure  TfrmFrame. mnuToolsOp tionsClick (Sender: T Object);
  3378   // persona l preferen ces - chan ges may ne ed to be a pplied to  chart
  3379   var
  3380     i: integ er;
  3381   begin
  3382     i := 0;
  3383     DialogOp tions(i);
  3384   end;
  3385  
  3386   procedure  TfrmFrame. LoadUserPr eferences;
  3387   begin
  3388     LoadSize sForUser;
  3389     GetUserT emplateDef aults(TRUE );
  3390   end;
  3391  
  3392   procedure  TfrmFrame. SaveUserPr eferences;
  3393   begin
  3394     SaveSize sForUser;          //  position  & size set tings
  3395     SaveUser TemplateDe faults;
  3396   end;
  3397  
  3398   procedure  TfrmFrame. mnuFileRef reshClick( Sender: TO bject);
  3399   begin
  3400     FRefresh ing := TRU E;
  3401     try
  3402       mnuFil eOpenClick (Self);
  3403     finally
  3404       FRefre shing := F ALSE;
  3405       OrderP rintForm : = FALSE;
  3406     end;
  3407   end;
  3408  
  3409   procedure  TfrmFrame. AppActivat ed(Sender:  TObject);
  3410   begin
  3411     if assig ned(FOldAc tivate) th en
  3412       FOldAc tivate(Sen der);
  3413     SetActiv eWindow(Ap plication. Handle);
  3414     if Scree nReaderSys temActive  and assign ed(Patient ) and (Pat ient.Name  <> '') and  (Patient. Status <>  '') then
  3415         Spea kTabAndPat ient;
  3416   end;
  3417  
  3418   // close T reatment F actor hint  window if  alt-tab p ressed.
  3419   procedure  TfrmFrame. AppDeActiv ated(Sende r: TObject );
  3420   begin
  3421     if FRVTF hintWindow Active the n
  3422     begin
  3423        FRVTF HintWindow .ReleaseHa ndle;
  3424        FRVTF HintWindow Active :=  False;
  3425     end
  3426     else
  3427     if FOSTF HintWndAct ive then
  3428     begin
  3429        FOSTF hintWindow .ReleaseHa ndle;
  3430        FOSTF HintWndAct ive := Fal se ;
  3431     end;
  3432     if FHint WinActive  then   //  graphing -  hints on  values
  3433     begin
  3434       FHintW in.Release Handle;
  3435       FHintW inActive : = false;
  3436     end;
  3437   end;
  3438  
  3439  
  3440   procedure  TfrmFrame. CreateTab( ATabID: in teger; ALa bel: strin g);
  3441   begin
  3442     //  old  comment -  try making  owner sel f (instead  of applic ation) to  see if sol ves TMenuI tem.Insert  bug
  3443     case ATa bID of
  3444       CT_PRO BLEMS : be gin
  3445                         frmProblem s := TfrmP roblems.Cr eate(Self) ;
  3446                         frmProblem s.Parent : = pnlPage;
  3447                      en d;
  3448       CT_MED S     : be gin
  3449                         frmMeds :=  TfrmMeds. Create(Sel f);
  3450                         frmMeds.Pa rent := pn lPage;
  3451                         frmMeds.In itfMedsSiz e;
  3452                      en d;
  3453       CT_ORD ERS   : be gin
  3454                         frmOrders  := TfrmOrd ers.Create (Self);
  3455                         frmOrders. Parent :=  pnlPage;
  3456                      en d;
  3457       CT_HP        : be gin
  3458                         // not yet
  3459                      en d;
  3460       CT_NOT ES    : be gin
  3461                         frmNotes : = TfrmNote s.Create(S elf);
  3462                         frmNotes.P arent := p nlPage;
  3463                      en d;
  3464       CT_CON SULTS : be gin
  3465                         frmConsult s := TfrmC onsults.Cr eate(Self) ;
  3466                         frmConsult s.Parent : = pnlPage;
  3467                      en d;
  3468       CT_DCS UMM   : be gin
  3469                         frmDCSumm  := TfrmDCS umm.Create (Self);
  3470                         frmDCSumm. Parent :=  pnlPage;
  3471                      en d;
  3472       CT_LAB S     : be gin
  3473                         frmLabs :=  TfrmLabs. Create(Sel f);
  3474                         frmLabs.Pa rent := pn lPage;
  3475                      en d;
  3476       CT_REP ORTS  : be gin
  3477                         frmReports  := TfrmRe ports.Crea te(Self);
  3478                         frmReports .Parent :=  pnlPage;
  3479                      en d;
  3480       CT_SUR GERY  : be gin
  3481                         frmSurgery  := TfrmSu rgery.Crea te(Self);
  3482                         frmSurgery .Parent :=  pnlPage;
  3483                      en d;
  3484       CT_COV ER    : be gin
  3485                         frmCover : = TfrmCove r.Create(S elf);
  3486                         frmCover.P arent := p nlPage;
  3487                      en d;
  3488     else
  3489       Exit;
  3490     end;
  3491     if ATabI D = CT_COV ER then
  3492       begin
  3493         uTab List.Inser t(0, IntTo Str(ATabID ));
  3494         tabP age.Tabs.I nsert(0, A Label);
  3495         tabP age.TabInd ex := 0;
  3496       end
  3497     else
  3498       begin
  3499         uTab List.Add(I ntToStr(AT abID));
  3500         tabP age.Tabs.A dd(ALabel) ;
  3501       end;
  3502   end;
  3503  
  3504   procedure  TfrmFrame. ShowHideCh artTabMenu s(AMenuIte m: TMenuIt em);
  3505   var
  3506     i: integ er;
  3507   begin
  3508     for i :=  0 to AMen uItem.Coun t - 1 do
  3509       AMenuI tem.Items[ i].Visible  := TabExi sts(AMenuI tem.Items[ i].Tag);
  3510   end;
  3511  
  3512   function T frmFrame.T abExists(A TabID: int eger): boo lean;
  3513   begin
  3514     Result : = (uTabLis t.IndexOf( IntToStr(A TabID)) >  -1)
  3515   end;
  3516  
  3517   procedure  TfrmFrame. ReportsOnl yDisplay;
  3518   begin
  3519     // Confi gure "Edit " menu:
  3520     menuHide AllBut(mnu Edit, mnuE ditPref);      // Hid e everythi ng under E dit menu e xcept Pref erences.
  3521     menuHide AllBut(mnu EditPref,  Prefs1); / / Hide eve rything un der Prefer ences menu  except Fo nts.
  3522  
  3523     // Remai ning pull- down menus :
  3524     mnuView. visible :=  false;
  3525     mnuFileR efresh.vis ible := fa lse;
  3526     mnuFileE ncounter.v isible :=  false;
  3527     mnuFileR eview.visi ble := fal se;
  3528     mnuFileN ext.visibl e := false ;
  3529     mnuFileN otifRemove .visible : = false;
  3530     mnuHelpB roker.visi ble := fal se;
  3531     mnuHelpL ists.visib le := fals e;
  3532     mnuHelpS ymbols.vis ible := fa lse;
  3533  
  3534     // Top p anel compo nents:
  3535     pnlVisit .hint := ' Provider/L ocation';
  3536     pnlVisit .onMouseDo wn := nil;
  3537     pnlVisit .onMouseUp  := nil;
  3538  
  3539     // Forms  for other  tabs:
  3540     frmCover .visible : = false;
  3541     frmProbl ems.visibl e := false ;
  3542     frmMeds. visible :=  false;
  3543     frmOrder s.visible  := false;
  3544     frmNotes .visible : = false;
  3545     frmConsu lts.visibl e := false ;
  3546     frmDCSum m.visible  := false;
  3547     if Assig ned(frmSur gery) then
  3548       frmSur gery.visib le := fals e;
  3549     frmLabs. visible :=  false;
  3550  
  3551     // Other  tabs (so  to speak):
  3552     tabPage. tabs.clear ;
  3553     tabPage. tabs.add(' Reports');
  3554   end;
  3555  
  3556   procedure  TfrmFrame. UpdatePtIn foOnRefres h;
  3557   var
  3558     tmpDFN:  string;
  3559   begin
  3560     tmpDFN : = Patient. DFN;
  3561     Patient. Clear;
  3562     Patient. DFN := tmp DFN;
  3563     uCore.Te mpEncounte rLoc := 0;   //hds759 1  Clinic/ Ward movem ent.
  3564     uCore.Te mpEncounte rLocName : = ''; //hd s7591  Cli nic/Ward m ovement.
  3565     uCore.Te mpEncounte rText := ' ';
  3566     uCore.Te mpEncounte rDateTime  := 0;
  3567     uCore.Te mpEncounte rVistCat : = #0;
  3568     if (not  FRefreshin g) and (FR eviewClick  = false)  then DoNot ChangeEncW indow := f alse;
  3569     if (FPre vInPatient  and Patie nt.Inpatie nt) then                  //tran sfering in side hospi tal
  3570       begin
  3571              if FReview Click = Tr ue then
  3572                begin
  3573                  ucore. TempEncoun terLoc :=  Encounter. Location;
  3574                  uCore. TempEncoun terLocName  := Encoun ter.Locati onName;
  3575                  uCore. TempEncoun terText :=  Encounter .LocationT ext;
  3576                  uCore. TempEncoun terDateTim e := Encou nter.DateT ime;
  3577                  uCore. TempEncoun terVistCat  := Encoun ter.VisitC ategory;
  3578                end
  3579              else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm =  false) th en
  3580                    begi n
  3581                      fr mPrintLoca tion.Switc hEncounter Loction(En counter.Lo cation, En counter.lo cationName , Encounte r.Location Text,
  3582                                                                  En counter.Da teTime, En counter.Vi sitCategor y);
  3583                      Di splayEncou nterText;
  3584                      ex it;
  3585                    end
  3586              else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm =  True) the n
  3587                begin
  3588                  OrderP rintForm : = false;
  3589                  Exit;
  3590                end;
  3591              if orderpr intform =  false then  Encounter .Location  := Patient .Location;
  3592       end
  3593     else if  (FPrevInPa tient and  (not Patie nt.Inpatie nt)) then      //pati ent was di scharged
  3594     begin
  3595       Encoun ter.Inpati ent := Fal se;
  3596       Encoun ter.Locati on := 0;
  3597       FPrevI nPatient : = False;
  3598       lblPtN ame.Captio n := '';
  3599       lblPtN ame.Captio n := Patie nt.Name +  Patient.St atus; //CQ  #17491: R efresh pat ient statu s indicato r in heade r bar on d ischarge.
  3600     end
  3601     else if  ((not FPre vInPatient ) and Pati ent.Inpati ent) then      //pati ent was ad mitted
  3602     begin
  3603       Encoun ter.Inpati ent := Tru e;
  3604       uCore. TempEncoun terLoc :=  Encounter. Location;   //hds7591   Clinic/W ard moveme nt.
  3605       uCore. TempEncoun terLocName  := Encoun ter.Locati onName; // hds7591  C linic/Ward  movement.
  3606       uCore. TempEncoun terText :=  Encounter .LocationT ext;
  3607       uCore. TempEncoun terDateTim e := Encou nter.DateT ime;
  3608       uCore. TempEncoun terVistCat  := Encoun ter.VisitC ategory;
  3609       lblPtN ame.Captio n := '';
  3610       lblPtN ame.Captio n := Patie nt.Name +  Patient.St atus; //CQ  #17491: R efresh pat ient statu s indicato r in heade r bar on a dmission.
  3611       if (FR eviewClick  = False)  and (encou nter.Locat ion <> pat ient.Locat ion) and ( OrderPrint Form = fal se) then
  3612           be gin
  3613              frmPrintLo cation.Swi tchEncount erLoction( Encounter. Location,  Encounter. locationNa me, Encoun ter.Locati onText,
  3614                                                       En counter.Da teTime, En counter.Vi sitCategor y);
  3615              //agp valu es are res et dependi ng on the  user proce ss
  3616              uCore.Temp EncounterL oc := 0;   //hds7591   Clinic/Wa rd movemen t.
  3617              uCore.Temp EncounterL ocName :=  ''; //hds7 591  Clini c/Ward mov ement.
  3618              uCore.Temp EncounterT ext := '';
  3619              uCore.Temp EncounterD ateTime :=  0;
  3620              uCore.Temp EncounterV istCat :=  #0;
  3621           en d
  3622       else
  3623       if Ord erPrintFor m = false  then
  3624         begi n
  3625           En counter.Lo cation :=  Patient.Lo cation;
  3626           En counter.Da teTime :=  Patient.Ad mitTime;
  3627           En counter.Vi sitCategor y := 'H';
  3628         end;
  3629       FPrevI nPatient : = True;
  3630     end;
  3631     DisplayE ncounterTe xt;
  3632   end;
  3633  
  3634   procedure  TfrmFrame. FormKeyDow n(Sender:  TObject; v ar Key: Wo rd; Shift:  TShiftSta te);
  3635   var
  3636     NewTabIn dex: integ er;
  3637   begin
  3638     inherite d;
  3639     FCtrlTab Used := FA LSE;
  3640     //CQ2844 : Toggle R emote Data  button us ing Alt+R
  3641      case Ke y of
  3642        82,11 4:  if (ss Alt in Shi ft) then
  3643                     frm Frame.pnlC IRNClick(S ender);
  3644        end;
  3645  
  3646     if (Key  = VK_TAB)  then
  3647     begin
  3648       if (ss Ctrl in Sh ift) then
  3649       begin
  3650         FCtr lTabUsed : = TRUE;
  3651         if n ot (Active Control is  TCustomMe mo) or not  TMemo(Act iveControl ).WantTabs  then begi n
  3652           Ne wTabIndex  := tabPage .TabIndex;
  3653           if  ssShift i n Shift th en
  3654              dec(NewTab Index)
  3655           el se
  3656              inc(NewTab Index);
  3657           if  NewTabInd ex >= tabP age.Tabs.C ount then
  3658              dec(NewTab Index,tabP age.Tabs.C ount)
  3659           el se if NewT abIndex <  0 then
  3660              inc(NewTab Index,tabP age.Tabs.C ount);
  3661           ta bPage.TabI ndex := Ne wTabIndex;
  3662           ta bPageChang e(tabPage) ;
  3663           Ke y := 0;
  3664         end;
  3665       end;
  3666     end;
  3667   end;
  3668  
  3669   procedure  TfrmFrame. FormActiva te(Sender:  TObject);
  3670   begin
  3671     if Assig ned(FLastP age) then
  3672       FLastP age.FocusF irstContro l;
  3673   end;
  3674  
  3675   procedure  TfrmFrame. pnlPrimary CareEnter( Sender: TO bject);
  3676   begin
  3677     with Sen der as TPa nel do
  3678       if (Co ntrolCount  > 0) and  (Controls[ 0] is TSpe edButton)  and (TSpee dButton(Co ntrols[0]) .Down)
  3679       then
  3680         Beve lInner :=  bvLowered
  3681       else
  3682         Beve lInner :=  bvRaised;
  3683   end;
  3684  
  3685   procedure  TfrmFrame. pnlPrimary CareExit(S ender: TOb ject);
  3686   var
  3687     ShiftIsD own,TabIsD own : bool ean;
  3688   begin
  3689     with Sen der as TPa nel do beg in
  3690       BevelI nner := bv None;
  3691       //Make  the lstCI RNLocation s act as i f between  pnlCIRN &  pnlReminde rs
  3692       //in t he Tab Ord er
  3693       if (ls tCIRNLocat ions.CanFo cus) then
  3694       begin
  3695         Shif tIsDown :=  Boolean(H i(GetKeySt ate(VK_SHI FT)));
  3696         TabI sDown := B oolean(Hi( GetKeyStat e(VK_TAB)) );
  3697         if T abIsDown t hen
  3698           if  (ShiftIsD own) and ( Name = 'pn lReminders ') then
  3699              lstCIRNLoc ations.Set Focus
  3700           el se if Not  (ShiftIsDo wn) and (N ame = 'pnl CIRN') the n
  3701              lstCIRNLoc ations.Set Focus;
  3702       end;
  3703     end;
  3704   end;
  3705  
  3706   procedure  TfrmFrame. pnlPatient Click(Send er: TObjec t);
  3707   begin
  3708     Screen.C ursor := c rHourglass ; //wat cq  18425 add ed hourgla ss and dis abled mnuF ileOpen
  3709     mnuFileO pen.Enable d := False ;
  3710     try
  3711     pnlPatie nt.Enabled  := false;
  3712     ViewInfo (mnuViewDe mo);
  3713     pnlPatie nt.Enabled  := true;
  3714     finally
  3715       Screen .Cursor :=  crDefault ;
  3716       mnuFil eOpen.Enab led := Tru e;
  3717     end;
  3718   end;
  3719  
  3720   procedure  TfrmFrame. pnlVisitCl ick(Sender : TObject) ;
  3721   begin
  3722     ViewInfo (mnuViewVi sits);
  3723   end;
  3724  
  3725   procedure  TfrmFrame. pnlPrimary CareClick( Sender: TO bject);
  3726   begin
  3727     ViewInfo (mnuViewPr imaryCare) ;
  3728   end;
  3729  
  3730   procedure  TfrmFrame. pnlReminde rsClick(Se nder: TObj ect);
  3731   begin
  3732     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  3733         View Info(mnuVi ewReminder s);
  3734  
  3735   end;
  3736  
  3737   procedure  TfrmFrame. pnlPosting sClick(Sen der: TObje ct);
  3738   begin
  3739     ViewInfo (mnuViewPo stings);
  3740   end;
  3741  
  3742   //======== ========== =========  CCOW main  changes == ========== ========== ==
  3743  
  3744   procedure  TfrmFrame. HandleCCOW Error(AMes sage: stri ng);
  3745   begin
  3746     {$ifdef  debugCPRS}
  3747      // Show 508Message (AMessage) ;
  3748     {$endif}
  3749     InfoBox( TX_CCOW_ER ROR, TC_CC OW_ERROR,  MB_ICONERR OR or MB_O K);
  3750     FCCOWIns talled :=  False;
  3751     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, 'BM P_CCOW_BRO KEN');
  3752     pnlCCOW. Hint := TX _CCOW_BROK EN;
  3753     mnuFileR esumeConte xt.Visible  := True;
  3754     mnuFileR esumeConte xt.Enabled  := False;
  3755     mnuFileB reakContex t.Visible  := True;
  3756     mnuFileB reakContex t.Enabled  := False;
  3757     FCCOWErr or := True ;
  3758   end;
  3759  
  3760   function T frmFrame.A llowCCOWCo ntextChang e(var CCOW Response:  UserRespon se; NewDFN : string):  boolean;
  3761   var
  3762     PtData :  IContextI temCollect ion;
  3763     PtDataIt em2, PtDat aItem3, Pt DataItem4  : IContext Item;
  3764     response  : UserRes ponse;
  3765     StationN umber: str ing;
  3766     IsProdAc ct: boolea n;
  3767   begin
  3768     Result : = False;
  3769     response  := 0;
  3770     try
  3771       // Sta rt a conte xt change  transactio n
  3772       if FCC OWInstalle d then
  3773          beg in
  3774              FCCOWError  := False;
  3775              imgCCOW.Pi cture.BitM ap.LoadFro mResourceN ame(hInsta nce, 'BMP_ CCOW_CHANG ING');
  3776              pnlCCOW.Hi nt := TX_C COW_CHANGI NG;
  3777              try
  3778                ctxConte xtor.Start ContextCha nge();
  3779              except
  3780                on E: Ex ception do  HandleCCO WError(E.M essage);
  3781              end;
  3782              if FCCOWEr ror then
  3783              begin
  3784                Result : = False;
  3785                Exit;
  3786              end;
  3787              // Set the  new propo sed contex t data.
  3788              PtData :=  CoContextI temCollect ion.Create ();
  3789              StationNum ber := Use r.StationN umber;
  3790              IsProdAcct  := User.I sProductio nAccount;
  3791  
  3792              {$IFDEF CC OWBROKER}
  3793              //IsProdAc ct := RPCB rokerV.Log in.IsProdu ction;  // not yet
  3794              {$ENDIF}
  3795  
  3796              PtDataItem 2 := CoCon textItem.C reate();
  3797              PtDataItem 2.Set_Name ('Patient. co.Patient Name');                  // Pati ent.Name
  3798              PtDataItem 2.Set_Valu e(Piece(Pa tient.Name , ',', 1)  + U + Piec e(Patient. Name, ',',  2) + '^^^ ^');
  3799              PtData.Add (PtDataIte m2);
  3800  
  3801              PtDataItem 3 := CoCon textItem.C reate();
  3802              if not IsP rodAcct th en
  3803                PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber  + '_TEST' )    // Pa tient.DFN
  3804              else
  3805                PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber );              // Pa tient.DFN
  3806              PtDataItem 3.Set_Valu e(Patient. DFN);
  3807              PtData.Add (PtDataIte m3);
  3808  
  3809              if Patient .ICN <> ''  then
  3810                begin
  3811                  PtData Item4 := C oContextIt em.Create( );
  3812                  if not  IsProdAcc t then
  3813                    PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber_ TEST')   / / Patient. ICN
  3814                  else
  3815                    PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber' );       / / Patient. ICN
  3816                  PtData Item4.Set_ Value(Pati ent.ICN);
  3817                  PtData .Add(PtDat aItem4);
  3818                end;
  3819  
  3820              // End the  context c hange tran saction.
  3821              FCCOWError  := False;
  3822              try
  3823                response  := ctxCon textor.End ContextCha nge(true,  PtData);
  3824              except
  3825                on E: Ex ception do  HandleCCO WError(E.M essage);
  3826              end;
  3827              if FCCOWEr ror then
  3828              begin
  3829                HideEver ything;
  3830                Result : = False;
  3831                Exit;
  3832              end;
  3833          end
  3834       else
  3835         begi n
  3836           Re sult := Tr ue;
  3837           Ex it;
  3838         end;
  3839  
  3840       CCOWRe sponse :=  response;
  3841       if (re sponse = U rCommit) t hen
  3842       begin
  3843         // N ew context  is commit ted.
  3844         mnuF ileResumeC ontext.Ena bled := Fa lse;
  3845         mnuF ileBreakCo ntext.Enab led := Tru e;
  3846         FCCO WIconName  := 'BMP_CC OW_LINKED' ;
  3847         pnlC COW.Hint : = TX_CCOW_ LINKED;
  3848         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  3849         Resu lt := True ;
  3850       end
  3851       else i f (respons e = UrCanc el) then
  3852       begin
  3853         // P roposed co ntext chan ge is canc eled. Retu rn to the  current co ntext.
  3854         PtDa ta.RemoveA ll;
  3855         mnuF ileResumeC ontext.Ena bled := Fa lse;
  3856         mnuF ileBreakCo ntext.Enab led := Tru e;
  3857         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  3858         Resu lt := Fals e;
  3859       end
  3860       else i f (respons e = UrBrea k) then
  3861       begin
  3862         // T he context or has bro ken the li nk by susp ending.  T his app sh ould
  3863         // u pdate the  Clinical L ink icon,  enable the  Resume me nu item, a nd
  3864         // d isable the  Suspend m enu item.
  3865         PtDa ta.RemoveA ll;
  3866         mnuF ileResumeC ontext.Ena bled := Tr ue;
  3867         mnuF ileBreakCo ntext.Enab led := Fal se;
  3868         FCCO WIconName  := 'BMP_CC OW_BROKEN' ;
  3869         pnlC COW.Hint : = TX_CCOW_ BROKEN;
  3870         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  3871         if P atient.Inp atient the n
  3872         begi n
  3873           En counter.In patient :=  True;
  3874           En counter.Lo cation :=  Patient.Lo cation;
  3875           En counter.Da teTime :=  Patient.Ad mitTime;
  3876           En counter.Vi sitCategor y := 'H';
  3877         end;
  3878         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  3879         Setu pPatient;
  3880         tabP age.TabInd ex := Page IDToTab(Us er.Initial Tab);
  3881         tabP ageChange( tabPage);
  3882         Resu lt := Fals e;
  3883       end;
  3884     except
  3885       on exc  : EOleExc eption do
  3886         Show Msg('EOleE xception:  ' + exc.Me ssage);
  3887     end;
  3888   end;
  3889  
  3890   procedure  TfrmFrame. ctxContext orCanceled (Sender: T Object);
  3891   begin
  3892     // Appli cation sho uld mainta in its sta te as the  current (e xisting) c ontext.
  3893     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  3894   end;
  3895  
  3896   procedure  TfrmFrame. ctxContext orPending( Sender: TO bject;
  3897     const aC ontextItem Collection : IDispatc h);
  3898   var
  3899     Reason,  HyperLinkR eason: str ing;
  3900     PtChange d: boolean ;
  3901   {$IFDEF CC OWBROKER}
  3902     UserChan ged: boole an;
  3903   {$ENDIF}
  3904   begin
  3905     // If th e app woul d lose dat a, or have  other pro blems chan ging conte xt at
  3906     // this  time, it s hould retu rn a messa ge using S etSurveyRe ponse. Not e that the
  3907     // user  may decide  to commit  the conte xt change  anyway.
  3908     //
  3909     // if (c annot-chan ge-context -without-a -problem)  then
  3910     //   con textor.Set SurveyResp onse('Cond itional ac cept reaso n...');
  3911     if FCCOW Busy then
  3912     begin
  3913       Sleep( 10000);
  3914     end;
  3915  
  3916     FCCOWErr or := Fals e;
  3917     try
  3918       CheckF orDifferen tPatient(a ContextIte mCollectio n, PtChang ed);
  3919   {$IFDEF CC OWBROKER}
  3920       CheckF orDifferen tUser(aCon textItemCo llection,  UserChange d);
  3921   {$ENDIF}
  3922     except
  3923       on E:  Exception  do HandleC COWError(E .Message);
  3924     end;
  3925     if FCCOW Error then
  3926     begin
  3927       HideEv erything;
  3928       Exit;
  3929     end;
  3930  
  3931   {$IFDEF CC OWBROKER}
  3932     if PtCha nged or Us erChanged  then
  3933   {$ELSE}
  3934     if PtCha nged then
  3935   {$ENDIF}
  3936       begin
  3937         FCCO WContextCh anging :=  True;
  3938         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  'BMP_CCOW _CHANGING' );
  3939         pnlC COW.Hint : = TX_CCOW_ CHANGING;
  3940         Allo wContextCh angeAll(Re ason);
  3941       end;
  3942     CheckHyp erlinkResp onse(aCont extItemCol lection, H yperlinkRe ason);
  3943     Reason : = Hyperlin kReason +  Reason;
  3944     if Pos(' COM_OBJECT _ACTIVE',  Reason) >  0 then
  3945       Sleep( 12000)
  3946     else if  Length(Rea son) > 0 t hen
  3947       ctxCon textor.Set SurveyResp onse(Reaso n)
  3948     else
  3949       begin
  3950         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  'BMP_CCOW _LINKED');
  3951         pnlC COW.Hint : = TX_CCOW_ LINKED;
  3952       end;
  3953     FCCOWCon textChangi ng := Fals e;
  3954   end;
  3955  
  3956   procedure  TfrmFrame. ctxContext orCommitte d(Sender:  TObject);
  3957   var
  3958     Reason:  string;
  3959     PtChange d: boolean ;
  3960     i: integ er;
  3961   begin
  3962     // Appli cation sho uld now ac cess the n ew context  and updat e its stat e.
  3963     FCCOWErr or := Fals e;
  3964     try
  3965     {$IFDEF  CCOWBROKER }
  3966       with R PCBrokerV  do if (Was UserDefine d and IsUs erCleared  and (ctxCo ntextor.Cu rrentConte xt.Present (CCOW_USER _NAME) = n il)) then     // RV 0 5/11/04
  3967       begin
  3968         Reas on := 'COM MIT';
  3969         if A llowContex tChangeAll (Reason) t hen
  3970         begi n
  3971           Cl ose;
  3972           Ex it;
  3973         end;
  3974       end;
  3975     {$ENDIF}
  3976       CheckF orDifferen tPatient(c txContexto r.CurrentC ontext, Pt Changed);
  3977     except
  3978       on E:  Exception  do HandleC COWError(E .Message);
  3979     end;
  3980     if FCCOW Error then
  3981     begin
  3982       HideEv erything;
  3983       Exit;
  3984     end;
  3985     if not P tChanged t hen exit;
  3986     FCCOWDri vedChange  := True;
  3987     i := 0;
  3988     while Le ngth(Scree n.Forms[i] .Name) > 0  do
  3989     begin
  3990       if fsM odal in Sc reen.Forms [i].FormSt ate then
  3991       begin
  3992         Scre en.Forms[i ].ModalRes ult := mrC ancel;
  3993         i :=  i + 1;
  3994       end el se  // the  fsModal f orms alway s sequence d prior to  the none- fsModal fo rms
  3995         Brea k;
  3996     end;
  3997     Reason : = 'COMMIT' ;
  3998     if Allow ContextCha ngeAll(Rea son) then  UpdateCCOW Context;
  3999     FCCOWIco nName := ' BMP_CCOW_L INKED';
  4000     pnlCCOW. Hint := TX _CCOW_LINK ED;
  4001     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4002   end;
  4003  
  4004   function T frmFrame.F indBestCCO WDFN: stri ng;
  4005   var
  4006     data: IC ontextItem Collection ;
  4007     anItem:  IContextIt em;
  4008     StationN umber, tem pDFN: stri ng;
  4009     IsProdAc ct:  Boole an;
  4010  
  4011     procedur e FindNext BestDFN;
  4012     begin
  4013       Statio nNumber :=  User.Stat ionNumber;
  4014       if IsP rodAcct th en
  4015         anIt em := data .Present(' Patient.id .MRN.DFN_'  + Station Number)
  4016       else
  4017         anIt em := data .Present(' Patient.id .MRN.DFN_'  + Station Number + ' _TEST');
  4018       if anI tem <>  ni l then tem pDFN := an Item.Get_V alue();
  4019     end;
  4020  
  4021   begin
  4022     if uCore .User = ni l then
  4023     begin
  4024       Result  := '';
  4025       exit;
  4026     end;
  4027     IsProdAc ct := User .IsProduct ionAccount ;
  4028     // Get a n item col lection of  the curre nt context
  4029     FCCOWErr or := Fals e;
  4030     try
  4031       data : = ctxConte xtor.Curre ntContext;
  4032     except
  4033       on E:  Exception  do HandleC COWError(E .Message);
  4034     end;
  4035     if FCCOW Error then
  4036     begin
  4037       HideEv erything;
  4038       Exit;
  4039     end;
  4040     // Retri eve the Co ntextItem  name and v alue as st rings
  4041     if IsPro dAcct then
  4042       anItem  := data.P resent('Pa tient.id.M RN.Nationa lIDNumber' )
  4043     else
  4044       anItem  := data.P resent('Pa tient.id.M RN.Nationa lIDNumber_ TEST');
  4045     if anIte m <> nil t hen
  4046       begin
  4047         temp DFN := Get DFNFromICN (anItem.Ge t_Value()) ;                        // "Pub lic" RPC c all
  4048         if t empDFN = ' -1' then F indNextBes tDFN;
  4049       end
  4050     else
  4051       FindNe xtBestDFN;
  4052     Result : = tempDFN;
  4053     data :=  nil;
  4054     anItem : = nil;
  4055   end;
  4056  
  4057   procedure  TfrmFrame. UpdateCCOW Context;
  4058   var
  4059     PtDFN(*,  PtName*):  string;
  4060   begin
  4061     if not F CCOWInstal led then e xit;
  4062     DoNotCha ngeEncWind ow := fals e;
  4063     PtDFN :=  FindBestC COWDFN;
  4064     if StrTo Int64Def(P tDFN, 0) >  0 then
  4065       begin
  4066         // S elect new  patient ba sed on con text value
  4067         if P atient.DFN  = PtDFN t hen exit;
  4068         Pati ent.DFN :=  PtDFN;
  4069         if ( Patient.Na me = '-1')  then
  4070           be gin
  4071              HideEveryt hing;
  4072              exit;
  4073           en d
  4074         else
  4075           Sh owEverythi ng;
  4076         Enco unter.Clea r;
  4077         if P atient.Inp atient the n
  4078         begi n
  4079           En counter.In patient :=  True;
  4080           En counter.Lo cation :=  Patient.Lo cation;
  4081           En counter.Da teTime :=  Patient.Ad mitTime;
  4082           En counter.Vi sitCategor y := 'H';
  4083         end;
  4084         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  4085         if n ot FFirstL oad then S etupPatien t;
  4086         frmC over.Updat eVAAButton ; //VAA
  4087         Dete rmineNextT ab;
  4088         tabP age.TabInd ex := Page IDToTab(Ne xtTab);
  4089         tabP ageChange( tabPage);
  4090       end
  4091     else
  4092       HideEv erything;
  4093   end;
  4094  
  4095   procedure  TfrmFrame. mnuFileBre akContextC lick(Sende r: TObject );
  4096   begin
  4097     FCCOWErr or := Fals e;
  4098     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4099     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4100     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4101     try
  4102       ctxCon textor.Sus pend;
  4103     except
  4104       on E:  Exception  do HandleC COWError(E .Message);
  4105     end;
  4106     if FCCOW Error then  exit;
  4107     FCCOWIco nName := ' BMP_CCOW_B ROKEN';
  4108     pnlCCOW. Hint := TX _CCOW_BROK EN;
  4109     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4110     mnuFileR esumeConte xt.Enabled  := True;
  4111     mnuFileB reakContex t.Enabled  := False;
  4112   end;
  4113  
  4114   procedure  TfrmFrame. mnuFileRes umeContext GetClick(S ender: TOb ject);
  4115   var
  4116     Reason:  string;
  4117   begin
  4118     Reason : = '';
  4119     if not A llowContex tChangeAll (Reason) t hen exit;
  4120     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4121     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4122     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4123     FCCOWErr or := Fals e;
  4124     try
  4125       ctxCon textor.Res ume;
  4126     except
  4127       on E:  Exception  do HandleC COWError(E .Message);
  4128     end;
  4129     if FCCOW Error then  exit;
  4130     UpdateCC OWContext;
  4131     if not F NoPatientS elected th en
  4132     begin
  4133       FCCOWI conName :=  'BMP_CCOW _LINKED';
  4134       pnlCCO W.Hint :=  TX_CCOW_LI NKED;
  4135       imgCCO W.Picture. BitMap.Loa dFromResou rceName(hI nstance, F CCOWIconNa me);
  4136       mnuFil eResumeCon text.Enabl ed := Fals e;
  4137       mnuFil eBreakCont ext.Visibl e := True;
  4138       mnuFil eBreakCont ext.Enable d := True;
  4139     end;
  4140   end;
  4141  
  4142   procedure  TfrmFrame. mnuFileRes umeContext SetClick(S ender: TOb ject);
  4143   var
  4144     CCOWResp onse: User Response;
  4145     Reason:  string;
  4146   begin
  4147     Reason : = '';
  4148     if not A llowContex tChangeAll (Reason) t hen exit;
  4149     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4150     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4151     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4152     FCCOWErr or := Fals e;
  4153     try
  4154       ctxCon textor.Res ume;
  4155     except
  4156       on E:  Exception  do HandleC COWError(E .Message);
  4157     end;
  4158     if FCCOW Error then  exit;
  4159     if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n
  4160       begin
  4161         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4162         mnuF ileBreakCo ntext.Visi ble := Tru e;
  4163         mnuF ileBreakCo ntext.Enab led := Tru e;
  4164         FCCO WIconName  := 'BMP_CC OW_LINKED' ;
  4165         pnlC COW.Hint : = TX_CCOW_ LINKED;
  4166         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4167       end
  4168     else
  4169       begin
  4170         mnuF ileResumeC ontext.Ena bled := Tr ue;
  4171         mnuF ileBreakCo ntext.Enab led := Fal se;
  4172         FCCO WIconName  := 'BMP_CC OW_BROKEN' ;
  4173         pnlC COW.Hint : = TX_CCOW_ BROKEN;
  4174         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4175         try
  4176           if  ctxContex tor.State  in [csPart icipating]  then ctxC ontextor.S uspend;
  4177         exce pt
  4178           on  E: Except ion do Han dleCCOWErr or(E.Messa ge);
  4179         end;
  4180      end;
  4181     SetupPat ient;
  4182     tabPage. TabIndex : = PageIDTo Tab(User.I nitialTab) ;
  4183     tabPageC hange(tabP age);
  4184   end;
  4185  
  4186   procedure  TfrmFrame. CheckForDi fferentPat ient(aCont extItemCol lection: I Dispatch;  var PtChan ged: boole an);
  4187   var
  4188     data : I ContextIte mCollectio n;
  4189     anItem:  IContextIt em;
  4190     PtDFN, P tName: str ing;
  4191   begin
  4192     if uCore .Patient =  nil then
  4193     begin
  4194       PtChan ged := Fal se;
  4195       Exit;
  4196     end;
  4197     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4198     PtDFN :=  FindBestC COWDFN;
  4199     // Retri eve the Co ntextItem  name and v alue as st rings
  4200     anItem : = data.Pre sent('Pati ent.co.Pat ientName') ;
  4201     if anIte m <> nil t hen PtName  := anItem .Get_Value ();
  4202     PtChange d := not ( (PtDFN = P atient.DFN ) and (PtN ame = Piec e(Patient. Name, ',',  1) + U +  Piece(Pati ent.Name,  ',', 2) +  '^^^^'));
  4203   end;
  4204  
  4205   {$IFDEF CC OWBROKER}
  4206   procedure  TfrmFrame. CheckForDi fferentUse r(aContext ItemCollec tion: IDis patch; var  UserChang ed: boolea n);
  4207   var
  4208     data : I ContextIte mCollectio n;
  4209   begin
  4210     if uCore .User = ni l then
  4211     begin
  4212       UserCh anged := F alse;
  4213       Exit;
  4214     end;
  4215     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4216     UserChan ged := RPC BrokerV.Is UserContex tPending(d ata);
  4217   end;
  4218   {$ENDIF}
  4219  
  4220   procedure  TfrmFrame. CheckHyper linkRespon se(aContex tItemColle ction: IDi spatch; va r Hyperlin kReason: s tring);
  4221   var
  4222     data : I ContextIte mCollectio n;
  4223     anItem :  IContextI tem;
  4224     itemvalu e: string;
  4225     PtSubjec t: string;
  4226   begin
  4227     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4228       anItem :=  data.Prese nt('[hds_m ed_ DOMAIN . EXT ]request.i d.name');
  4229     // Retri eve the Co ntextItem  name and v alue as st rings
  4230     if anIte m <> nil t hen
  4231       begin
  4232         item Value := a nItem.Get_ Value();
  4233         if i temValue =  'GetWindo wHandle' t hen
  4234           be gin
  4235              PtSubject  := 'patien t.id.mrn.d fn_' + Use r.StationN umber;
  4236              if not Use r.IsProduc tionAccoun t then PtS ubject :=  PtSubject  + '_test';
  4237              if data.Pr esent(PtSu bject) <>  nil then
  4238                Hyperlin kReason :=  '!@#$' +  IntToStr(S elf.Handle ) + ':0:'
  4239              else
  4240                Hyperlin kReason :=  '';
  4241           en d;
  4242       end;
  4243   end;
  4244  
  4245   procedure  TfrmFrame. HideEveryt hing(AMess age: strin g = 'No pa tient is c urrently s elected.') ;
  4246   begin
  4247     FNoPatie ntSelected  := TRUE;
  4248     pnlNoPat ientSelect ed.Caption  := AMessa ge;
  4249     pnlNoPat ientSelect ed.Visible  := True;
  4250     pnlNoPat ientSelect ed.BringTo Front;
  4251     mnuFileR eview.Enab led := Fal se;
  4252     mnuFileP rint.Enabl ed := Fals e;
  4253     mnuFileP rintSelect edItems.En abled := F alse;
  4254     mnuFileE ncounter.E nabled :=  False;
  4255     mnuFileN ext.Enable d := False ;
  4256     mnuFileR efresh.Ena bled := Fa lse;
  4257     mnuFileP rintSetup. Enabled :=  False;
  4258     mnuFileP rintSelect edItems.En abled := F alse;
  4259     mnuFileN otifRemove .Enabled : = False;
  4260     mnuFileR esumeConte xt.Enabled  := False;
  4261     mnuFileB reakContex t.Enabled  := False;
  4262     mnuEdit. Enabled :=  False;
  4263     mnuView. Enabled :=  False;
  4264     mnuTools .Enabled : = False;
  4265     if FNext ButtonActi ve then FN extButton. Visible :=  False;
  4266   end;
  4267  
  4268   procedure  TfrmFrame. ShowEveryt hing;
  4269   begin
  4270     FNoPatie ntSelected  := FALSE;
  4271     pnlNoPat ientSelect ed.Caption  := '';
  4272     pnlNoPat ientSelect ed.Visible  := False;
  4273     pnlNoPat ientSelect ed.SendToB ack;
  4274     mnuFileR eview.Enab led := Tru e;
  4275     mnuFileP rint.Enabl ed := True ;
  4276     mnuFileE ncounter.E nabled :=  True;
  4277     mnuFileN ext.Enable d := True;
  4278     mnuFileR efresh.Ena bled := Tr ue;
  4279     mnuFileP rintSetup. Enabled :=  True;
  4280     mnuFileP rintSelect edItems.En abled := T rue;
  4281     mnuFileN otifRemove .Enabled : = True;
  4282     if not F CCOWError  then
  4283     begin
  4284       if FCC OWIconName = 'BMP_CCO W_BROKEN'  then
  4285       begin
  4286         mnuF ileResumeC ontext.Ena bled := Tr ue;
  4287         mnuF ileBreakCo ntext.Enab led := Fal se;
  4288       end el se
  4289       begin
  4290         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4291         mnuF ileBreakCo ntext.Enab led := Tru e;
  4292       end;
  4293     end;
  4294     mnuEdit. Enabled :=  True;
  4295     mnuView. Enabled :=  True;
  4296     mnuTools .Enabled : = True;
  4297     if FNext ButtonActi ve then FN extButton. Visible :=  True;
  4298   end;
  4299  
  4300  
  4301   procedure  TfrmFrame. pnlFlagMou seDown(Sen der: TObje ct; Button : TMouseBu tton;
  4302     Shift: T ShiftState ; X, Y: In teger);
  4303   begin
  4304     pnlFlag. BevelOuter  := bvLowe red;
  4305   end;
  4306  
  4307   procedure  TfrmFrame. pnlFlagMou seUp(Sende r: TObject ; Button:  TMouseButt on;
  4308     Shift: T ShiftState ; X, Y: In teger);
  4309   begin
  4310     pnlFlag. BevelOuter  := bvRais ed;
  4311   end;
  4312  
  4313   procedure  TfrmFrame. pnlFlagCli ck(Sender:  TObject);
  4314   begin
  4315     ViewInfo (mnuViewFl ags);
  4316   end;
  4317  
  4318   procedure  TfrmFrame. mnuFilePri ntSelected ItemsClick (Sender: T Object);
  4319   begin
  4320       case T abToPageID (tabPage.T abIndex) o f
  4321         CT_N OTES:    f rmNotes.Ls tNotesToPr int;
  4322         CT_C ONSULTS: f rmConsults .LstConsul tsToPrint;
  4323         CT_D CSUMM:   f rmDCSumm.L stSummsToP rint;
  4324    end; {cas e}
  4325   end;
  4326  
  4327   procedure  TfrmFrame. mnuAlertRe newClick(S ender: TOb ject);
  4328   var XQAID:  string;
  4329   begin
  4330     XQAID :=  Piece(Not ifications .RecordID,  '^', 2);
  4331     RenewAle rt(XQAID);
  4332   end;
  4333  
  4334   procedure  TfrmFrame. mnuAlertFo rwardClick (Sender: T Object);
  4335   var
  4336     XQAID, A lertMsg: s tring;
  4337   begin
  4338     XQAID :=  Piece(Not ifications .RecordID, '^', 2);
  4339     AlertMsg  := Piece( Notificati ons.Record ID, '^', 1 );
  4340     RenewAle rt(XQAID);   // must  renew/rest ore an ale rt before  it can be  forwarded
  4341     ForwardA lertTo(XQA ID + '^' +  AlertMsg) ;
  4342   end;
  4343  
  4344   procedure  TfrmFrame. mnuGECStat usClick(Se nder: TObj ect);
  4345   var
  4346   ans, Resul t,str,str1 ,title: st ring;
  4347   cnt,i: int eger;
  4348   fin: boole an;
  4349  
  4350   begin
  4351     Result : = sCallV(' ORQQPXRM G EC STATUS  PROMPT', [ Patient.DF N]);
  4352     if Piece (Result,U, 1) <> '0'  then
  4353       begin
  4354         titl e := Piece (Result,U, 2);
  4355           if  pos('~',P iece(Resul t,U,1))>0  then
  4356                   begin
  4357                   str:= '';
  4358                   str1  := Piece(R esult,U,1) ;
  4359                   cnt : = DelimCou nt(str1, ' ~');
  4360                   for i :=1 to cnt +1 do
  4361                       b egin
  4362                       i f i = 1 th en str :=  Piece(str1 ,'~',i);
  4363                       i f i > 1 th en str :=s tr+CRLF+Pi ece(str1,' ~',i);
  4364                       e nd;
  4365                 end
  4366                 else st r := Piece (Result,U, 1);
  4367           if  Piece(Res ult,U,3)=' 1' then
  4368              begin
  4369                 fin :=  (InfoBox(s tr,title,  MB_YESNO o r MB_DEFBU TTON2)=IDY ES);
  4370                 if fin  = true the n ans := ' 1';
  4371                 if fin  = false th en ans :=  '0';
  4372                 CallV(' ORQQPXRM G EC FINISHE D?',[Patie nt.DFN,ans ]);
  4373              end
  4374           el se
  4375           In foBox(str, title, MB_ OK);
  4376       end;
  4377   end;
  4378  
  4379   procedure  TfrmFrame. pnlFlagEnt er(Sender:  TObject);
  4380   begin
  4381     pnlFlag. BevelInner  := bvRais ed;
  4382     pnlFlag. BevelOuter  := bvNone ;
  4383     pnlFlag. BevelWidth  := 3;
  4384   end;
  4385  
  4386   procedure  TfrmFrame. pnlFlagExi t(Sender:  TObject);
  4387   begin
  4388     pnlFlag. BevelWidth  := 2;
  4389     pnlFlag. BevelInner  := bvNone ;
  4390     pnlFlag. BevelOuter  := bvRais ed;
  4391   end;
  4392  
  4393   procedure  TfrmFrame. tabPageMou seDown(Sen der: TObje ct; Button : TMouseBu tton;
  4394     Shift: T ShiftState ; X, Y: In teger);
  4395   begin
  4396     inherite d;
  4397     TabCtrlC licked :=  True;
  4398   end;
  4399  
  4400   procedure  TfrmFrame. tabPageMou seUp(Sende r: TObject ; Button:  TMouseButt on;
  4401     Shift: T ShiftState ; X, Y: In teger);
  4402   begin
  4403     LastTab  := TabToPa geID((send er as TTab Control).T abIndex);
  4404   end;
  4405  
  4406   procedure  TfrmFrame. lstCIRNLoc ationsExit (Sender: T Object);
  4407   begin
  4408       //Make  the lstCI RNLocation s act as i f between  pnlCIRN &  pnlReminde rs
  4409       //in t he Tab Ord er
  4410     if Boole an(Hi(GetK eyState(VK _TAB))) th en
  4411       if Boo lean(Hi(Ge tKeyState( VK_SHIFT)) ) then
  4412         pnlC IRN.SetFoc us
  4413       else
  4414         pnlR eminders.S etFocus;
  4415   end;
  4416  
  4417   procedure  TfrmFrame. AppEventsA ctivate(Se nder: TObj ect);
  4418   begin
  4419     FJustEnt eredApp :=  True;
  4420   end;
  4421  
  4422   procedure  TfrmFrame. AppEventsM essage(var  Msg: tagM SG; var Ha ndled: Boo lean);
  4423   var
  4424     Control:  TComponen t;
  4425   begin
  4426     Handled  := false;
  4427     if (Msg. message =  WM_MOUSEWH EEL) and ( GetKeyStat e(VK_LBUTT ON) < 0) t hen begin
  4428       Contro l := FindC ontrol(Msg .hwnd);
  4429       if not  Assigned( Control) t hen
  4430         Hand led := Tru e
  4431       else i f (Control  is TRichE dit) then  begin
  4432         Hand led := Tru e;
  4433         Send Message(se lf.Handle,  EM_SETZOO M, 0, 0);
  4434       end;
  4435      end;
  4436   end;
  4437  
  4438   procedure  TfrmFrame. ScreenActi veFormChan ge(Sender:  TObject);
  4439   begin
  4440     if(assig ned(FOldAc tiveFormCh ange)) the n
  4441       FOldAc tiveFormCh ange(Sende r);
  4442     //Focus  the Form t hat Stays  on Top aft er the App lication R egains foc us.
  4443     if FJust EnteredApp  then
  4444       FocusA pplication TopForm;
  4445     FJustEnt eredApp :=  false;
  4446   end;
  4447  
  4448   procedure  TfrmFrame. FocusAppli cationTopF orm;
  4449   var
  4450     I : inte ger;
  4451   begin
  4452     for I :=  (Screen.F ormCount-1 ) downto 0  do //Set  the last o ne opened  last
  4453     begin
  4454       with S creen.Form s[I] do
  4455         if ( FormStyle  = fsStayOn Top) and ( Enabled) a nd (Visibl e) then
  4456           Se tFocus;
  4457     end;
  4458   end;
  4459  
  4460   procedure  TfrmFrame. AppEventsS hortCut(va r Msg: TWM Key;
  4461     var Hand led: Boole an);
  4462   begin
  4463     if ((Boo lean(Hi(Ge tKeyState( VK_MENU{AL T})))) and  (Msg.Char Code = VK_ F1)) then
  4464     begin
  4465       FocusA pplication TopForm;
  4466       Handle d := True;
  4467     end;
  4468   end;
  4469  
  4470   procedure  TfrmFrame. mnuToolsGr aphingClic k(Sender:  TObject);
  4471   var
  4472     contexth int: strin g;
  4473   begin
  4474     Screen.C ursor := c rHourGlass ;
  4475     contexth int := mnu ToolsGraph ing.Hint;
  4476     if Graph Float = ni l then                // new gra ph
  4477     begin
  4478       GraphF loat := Tf rmGraphs.C reate(self );
  4479       try
  4480         with  GraphFloa t do
  4481         begi n
  4482           if  btnClose. Tag = 1 th en
  4483           be gin
  4484              Screen.Cur sor := crD efault;
  4485              exit;
  4486           en d;
  4487           In itialize;
  4488           Ca ption := ' CPRS Graph ing - Pati ent: ' + M ixedCase(P atient.Nam e);
  4489           Bo rderIcons  := [biSyst emMenu, bi Maximize,  biMinimize ];
  4490           Bo rderStyle  := bsSizea ble;
  4491           Bo rderWidth  := 1;
  4492           //  context s ensitive        type  (tabPage.T abIndex)   & [item]
  4493           Re sizeAnchor edFormToFo nt(GraphFl oat);
  4494           Gr aphFloat.p nlFooter.H int := con texthint;    // conte xt from la b most rec ent
  4495           Sh ow;
  4496         end;
  4497       finall y
  4498         if G raphFloat. btnClose.T ag = 1 the n
  4499         begi n
  4500           Gr aphFloatAc tive := fa lse;
  4501           Gr aphFloat.F ree;
  4502           Gr aphFloat : = nil;
  4503         end
  4504         else
  4505           Gr aphFloatAc tive := tr ue;
  4506       end;
  4507     end
  4508     else
  4509     begin
  4510       GraphF loat.Capti on := 'CPR S Graphing  - Patient : ' + Mixe dCase(Pati ent.Name);
  4511       GraphF loat.pnlFo oter.Hint  := context hint;   //  context f rom lab mo st recent
  4512       if Gra phFloat.bt nClose.Tag  = 1 then
  4513       begin
  4514         Scre en.Cursor  := crDefau lt;
  4515         exit ;
  4516       end
  4517       else i f GraphFlo atActive a nd (frmGra phData.pnl Data.Hint  = Patient. DFN) then
  4518       begin
  4519         if l ength(Grap hFloat.pnl Footer.Hin t) > 1 the n
  4520         begi n
  4521           Gr aphFloat.C lose;
  4522           Gr aphFloatAc tive := tr ue;
  4523           Gr aphFloat.S how;
  4524         end;
  4525         Grap hFloat.Bri ngToFront;               // grap h is activ e, same pa tient
  4526       end
  4527       else i f frmGraph Data.pnlDa ta.Hint =  Patient.DF N then
  4528       begin                                     // graph  is not ac tive, same  patient
  4529         // c ontext sen sitive
  4530         Grap hFloat.Sho w;
  4531         Grap hFloatActi ve := true ;
  4532       end
  4533       else
  4534       //with  GraphFloa t do                      // new  patient
  4535       begin
  4536         Grap hFloat.Ini tialRetain ;
  4537         Grap hFloatActi ve := fals e;
  4538         Grap hFloat.Fre e;
  4539         Grap hFloat :=  nil;
  4540         mnuT oolsGraphi ngClick(se lf);           // del ete and re curse
  4541       end;
  4542     end;
  4543     mnuTools Graphing.H int := '';
  4544     Screen.C ursor := c rDefault;
  4545   end;
  4546  
  4547   procedure  TfrmFrame. pnlCIRNMou seDown(Sen der: TObje ct; Button : TMouseBu tton; Shif t: TShiftS tate; X, Y : Integer) ;
  4548   begin
  4549     pnlCIRN. BevelOuter  := bvLowe red;
  4550   end;
  4551  
  4552   procedure  TfrmFrame. pnlCIRNMou seUp(Sende r: TObject ; Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  4553   begin
  4554     pnlCIRN. BevelOuter  := bvRais ed;
  4555   end;
  4556  
  4557   procedure  TfrmFrame. laMHVClick (Sender: T Object);
  4558   begin
  4559     ViewInfo (mnuViewMy HealtheVet );
  4560   end;
  4561  
  4562   procedure  TfrmFrame. laVAA2Clic k(Sender:  TObject);
  4563   begin
  4564     ViewInfo (mnuInsura nce);
  4565   end;
  4566  
  4567   procedure  TfrmFrame. ViewInfo(S ender: TOb ject);
  4568   var
  4569     SelectNe w: Boolean ;
  4570     Insuranc eSubscribe rName: str ing;
  4571     ReportSt ring: TStr ingList;
  4572     aAddress : string;
  4573     ID: inte ger;
  4574   begin
  4575     if Sende r is TMenu Item then  begin
  4576       ID :=  TMenuItem( Sender).Ta g;
  4577     end else  if Sender  is TActio n then beg in
  4578       ID :=  TAction(Se nder).Tag;
  4579     end else  begin
  4580       ID :=  -1;
  4581     end;
  4582     case ID  of
  4583       1:begi n { displa ys patient  inquiry r eport (whi ch optiona lly allows  new patie nt to be s elected) }
  4584           St atusText(T X_PTINQ);
  4585           Pa tientInqui ry(SelectN ew);
  4586           if  Assigned( FLastPage)  then
  4587              FLastPage. FocusFirst Control;
  4588           St atusText(' ');
  4589           if  SelectNew  then mnuF ileOpenCli ck(mnuView Demo);
  4590         end;
  4591       2:begi n
  4592           if  (not User .IsReports Only) then  // Report s Only tab .
  4593              mnuFileEnc ounterClic k(Self);
  4594         end;
  4595       3:begi n
  4596           Re portBox(De tailPrimar yCare(Pati ent.DFN),  'Primary C are', True );
  4597         end;
  4598       4:begi n
  4599           if  laMHV.Cap tion = 'MH V' then
  4600               ShellExecu te(laMHV.H andle, 'op en', PChar ('http://w ww.myhealt h. DNS     /'), '', ' ', SW_NORM AL);
  4601         end;
  4602       5:begi n
  4603           if  fCover.VA AFlag[0] < > '0' then  //'0' mea ns subscri ber not fo und
  4604           be gin
  4605            / /  CQ:1553 4-GE  Remo ve leading  spaces fr om Patient  Name
  4606              InsuranceS ubscriberN ame := ( ( Piece(fCov er.VAAFlag [12],':',1 )) + ':  '  +
  4607                                           (TR IM(Piece(f Cover.VAAF lag[12],': ',2)) ));/ /fCover.VA AFlag[12];
  4608              ReportStri ng := VAAF lag;
  4609              ReportStri ng[0] := ' ';
  4610              ReportBox( ReportStri ng, Insura nceSubscri berName, T rue);
  4611           en d;
  4612         end;
  4613       6:begi n
  4614           Sh owFlags;
  4615         end;
  4616       7:begi n
  4617           if  uUseVista Web = true  then
  4618              begin
  4619                lblCIRN. Alignment  := taCente r;
  4620                lstCIRNL ocations.V isible :=  false;
  4621                lstCIRNL ocations.S endToBack;
  4622                aAddress  := GetVis taWebAddre ss(Patient .DFN);
  4623                ShellExe cute(pnlCi rn.Handle,  'open', P Char(aAddr ess), PCha r(''), '',  SW_NORMAL );
  4624                pnlCIRN. BevelOuter  := bvRais ed;
  4625                Exit;
  4626              end;
  4627           if  not Remot eSites.Rem oteDataExi sts then E xit;
  4628           if  (not lstC IRNLocatio ns.Visible ) then
  4629              begin
  4630                pnlCIRN. BevelOuter  := bvLowe red;
  4631                lstCIRNL ocations.V isible :=  True;
  4632                lstCIRNL ocations.B ringToFron t;
  4633                lstCIRNL ocations.S etFocus;
  4634                pnlCIRN. Hint := 'C lick to cl ose list.' ;
  4635              end
  4636           el se
  4637              begin
  4638                pnlCIRN. BevelOuter  := bvRais ed;
  4639                lstCIRNL ocations.V isible :=  False;
  4640                lstCIRNL ocations.S endToBack;
  4641                pnlCIRN. Hint := 'C lick to di splay othe r faciliti es having  data for t his patien t.';
  4642              end;
  4643         end;
  4644       8:begi n
  4645           Vi ewReminder Tree;
  4646         end;
  4647       9:begi n { displa ys the win dow that s hows crisi s notes, w arnings, a llergies,  & advance  directives  }
  4648           Sh owCWAD;
  4649         end;
  4650     end;
  4651   end;
  4652  
  4653   procedure  TfrmFrame. mnuViewInf ormationCl ick(Sender : TObject) ;
  4654   begin
  4655     mnuViewD emo.Enable d := frmFr ame.pnlPat ient.Enabl ed;
  4656     mnuViewV isits.Enab led := frm Frame.pnlV isit.Enabl ed;
  4657     mnuViewP rimaryCare .Enabled : = frmFrame .pnlPrimar yCare.Enab led;
  4658     mnuViewM yHealtheVe t.Enabled  := not (Co py(frmFram e.laMHV.Hi nt, 1, 2)  = 'No');
  4659     mnuInsur ance.Enabl ed := not  (Copy(frmF rame.laVAA 2.Hint, 1,  2) = 'No' );
  4660     mnuViewF lags.Enabl ed := frmF rame.lblFl ag.Enabled ;
  4661     mnuViewR emoteData. Enabled :=  frmFrame. lblCirn.En abled;
  4662     mnuViewR eminders.E nabled :=  frmFrame.p nlReminder s.Enabled;
  4663     mnuViewP ostings.En abled := f rmFrame.pn lPostings. Enabled;
  4664   end;
  4665  
  4666   procedure  TfrmFrame. SetActiveT ab(PageID:  Integer);
  4667   begin
  4668     tabPage. TabIndex : = frmFrame .PageIDToT ab(PageID) ;
  4669     tabPageC hange(tabP age);
  4670   end;
  4671  
  4672   procedure  TfrmFrame. NextButton Click(Send er: TObjec t);
  4673   begin
  4674     if FProc cessingNex tClick the n Exit;
  4675     FProcces singNextCl ick := tru e;
  4676     popAlert s.AutoPopu p := TRUE;
  4677     mnuFileN ext.Enable d := True;
  4678     mnuFileN extClick(S elf);
  4679     FProcces singNextCl ick := fal se;
  4680   end;
  4681  
  4682   procedure  TfrmFrame. NextButton MouseDown( Sender: TO bject; But ton: TMous eButton;
  4683         Shif t: TShiftS tate; X, Y : Integer) ;
  4684   begin
  4685      popAler ts.AutoPop up := TRUE ;
  4686   end;
  4687  
  4688   procedure  TfrmFrame. SetUpNextB utton;
  4689    begin
  4690      if FNex tButton <>  nil then
  4691      begin
  4692         FNex tButton.fr ee;
  4693         FNex tButton :=  nil;
  4694      end;
  4695      FNextBu tton := TB itBtn.Crea te(self);
  4696      FNextBu tton.Paren t:= frmFra me;
  4697      FNextBu tton.Glyph  := FNextB uttonBitma p;
  4698      FNextBu tton.OnMou seDown :=  NextButton MouseDown;
  4699      FNextBu tton.OnCli ck := Next ButtonClic k;
  4700      FNextBu tton.Capti on := '&Ne xt';
  4701      FNextBu tton.Popup Menu := po pAlerts;
  4702      FNextBu tton.Top : = stsArea. Top;
  4703      FNextBu tton.Left  := FNextBu ttonL;
  4704      FNextBu tton.Heigh t := stsAr ea.Height;
  4705      FNextBu tton.Width  := stsAre a.Panels[2 ].Width;
  4706      FNextBu tton.TabSt op := True ;
  4707      FNextBu tton.TabOr der := 1;
  4708      FNextBu tton.show;
  4709   end;
  4710  
  4711   initializa tion
  4712     SpecifyF ormIsNotAD ialog(Tfrm Frame);
  4713  
  4714   finalizati on
  4715  
  4716  
  4717   end.
  4718  
  4719  

Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.