23. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 8/3/2017 10:10:44 AM 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.

23.1 Files compared

# Location File Last Modified
1 V31A.zip\V31A\434\OR_30_434V114_SRC fFrame.pas Tue Jun 13 18:16:44 2017 UTC
2 V31A.zip\V31A\434\OR_30_434V114_SRC fFrame.pas Thu Aug 3 14:38:16 2017 UTC

23.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 9398
Changed 1 2
Inserted 0 0
Removed 0 0

23.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

23.4 Active regular expressions

No regular expressions were active.

23.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     end;
  1307     lstCIRNL ocations.V isible :=  False;
  1308     pnlCIRN. BevelOuter  := bvRais ed;
  1309     lstCIRNL ocations.S endToBack;
  1310     mnuFileP rint.Enabl ed := Fals e;            // let  individual  page enab le this
  1311     mnuFileP rintSetup. Enabled :=  False;       // let  individual  page enab le this
  1312     mnuFileP rintSelect edItems.En abled := F alse;
  1313     FLastPag e := NewFo rm;
  1314     if NewFo rm <> nil  then
  1315     begin
  1316       if New Form.Name  = frmNotes .Name then  frmNotes. Align := a lClient
  1317         else  frmNotes. Align := a lNone;
  1318       if New Form.Name  = frmConsu lts.Name t hen frmCon sults.Alig n := alCli ent
  1319         else  frmConsul ts.Align : = alNone;
  1320       if New Form.Name  = frmRepor ts.Name th en frmRepo rts.Align  := alClien t
  1321         else  frmReport s.Align :=  alNone;
  1322       if New Form.Name  = frmDCSum m.Name the n frmDCSum m.Align :=  alClient
  1323         else  frmDCSumm .Align :=  alNone;
  1324       if Ass igned(frmS urgery) th en
  1325         if N ewForm.Nam e = frmSur gery.Name  then frmSu rgery.Alig n := alcli ent
  1326           el se frmSurg ery.Align  := alNone;
  1327       NewFor m.BringToF ront;                      // to  cause tab  switch to  happen im mediately
  1328       Applic ation.Proc essMessage s;
  1329       PostMe ssage(Hand le, UM_SHO WPAGE, 0,  0);  // th is calls D isplayPage  for the f orm
  1330     end;
  1331   end;
  1332  
  1333   procedure  TfrmFrame. mnuDebugRe portClick( Sender: TO bject);
  1334   begin
  1335     inherite d;
  1336     if not A ssigned(fr mDebugRepo rt) then f rmDebugRep ort := Tfr mDebugRepo rt.Create( self);
  1337      frmDebu gReport.Sh ow;
  1338   end;
  1339  
  1340   procedure  TfrmFrame. mnuChartTa bClick(Sen der: TObje ct);
  1341   { use the  Tag proper ty of the  menu item  to switch  to proper  page }
  1342   begin
  1343     with Sen der as TMe nuItem do  tabPage.Ta bIndex :=  PageIDToTa b(Tag);
  1344     LastTab  := TabToPa geID(tabPa ge.TabInde x) ;
  1345     tabPageC hange(tabP age);
  1346   end;
  1347  
  1348   procedure  TfrmFrame. tabPageCha nge(Sender : TObject) ;
  1349   { switches  to form l inked to N ewTab }
  1350   var
  1351     PageID :  integer;
  1352   begin
  1353     PageID : = TabToPag eID((sende r as TTabC ontrol).Ta bIndex);
  1354     if (Page ID <> CT_N OPAGE) and  (TabPage. CanFocus)  and Assign ed(FLastPa ge) and
  1355        (not  TabPage.Fo cused) the n
  1356       TabPag e.SetFocus ;  //CQ: 1 4854
  1357     if (not  User.IsRep ortsOnly)  then
  1358     begin
  1359       case P ageID of
  1360         CT_N OPAGE:   S witchToPag e(nil);
  1361         CT_C OVER:    S witchToPag e(frmCover );
  1362         CT_P ROBLEMS: S witchToPag e(frmProbl ems);
  1363         CT_M EDS:     S witchToPag e(frmMeds) ;
  1364         CT_O RDERS:   S witchToPag e(frmOrder s);
  1365         CT_N OTES:    S witchToPag e(frmNotes );
  1366         CT_C ONSULTS: S witchToPag e(frmConsu lts);
  1367         CT_D CSUMM:   S witchToPag e(frmDCSum m);
  1368         CT_S URGERY:  S witchToPag e(frmSurge ry);
  1369         CT_L ABS:     S witchToPag e(frmLabs) ;
  1370         CT_R EPORTS:  S witchToPag e(frmRepor ts);
  1371       end; { case}
  1372     end
  1373     else //  Reports On ly tab.
  1374       Switch ToPage(frm Reports);
  1375     if Scree nReaderSys temActive  and FCtrlT abUsed the n
  1376       SpeakP atient;
  1377     Changing Tab := Pag eID;
  1378   end;
  1379  
  1380   function T frmFrame.P ageIDToTab (PageID: I nteger): I nteger;
  1381   { returns  the tab in dex that c orresponds  to a give n PageID }
  1382   VAR
  1383     i: integ er;
  1384   begin
  1385     i :=  uT abList.Ind exOf(IntTo Str(PageID ));
  1386     Result : = i;
  1387   end;
  1388  
  1389   function T frmFrame.T abToPageID (Tab: Inte ger): Inte ger;
  1390   { returns  the consta nt that id entifies t he page gi ven a TabI ndex }
  1391   begin
  1392     if (Tab  > -1) and  (Tab < uTa bList.Coun t) then
  1393       Result  := StrToI ntDef(uTab List[Tab],  CT_UNKNOW N)
  1394     else
  1395       Result  := CT_NOP AGE;
  1396   end;
  1397  
  1398   { File Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  1399  
  1400   procedure  TfrmFrame. SetupPatie nt(AFlagge dList : TS tringList) ;
  1401   var
  1402     AMsg, Se lectMsg: s tring;
  1403   begin
  1404     with Pat ient do
  1405     begin
  1406       ClearP atient;  / / must be  called to  avoid leav ing previo us patient 's informa tion visib le!
  1407       btnCom batVet.Cap tion := 'C V '+ Comba tVet.Expir ationDate;
  1408       btnCom batVet.Vis ible := Pa tient.Comb atVet.IsEl igible;
  1409       Visibl e := True;
  1410       Applic ation.Proc essMessage s;
  1411       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 .
  1412       lblPtS SN.Caption  := SSN;
  1413       lblPtA ge.Caption  := Format FMDateTime ('mmm dd,y yyy', DOB)  + ' (' +  IntToStr(A ge) + ')';
  1414       pnlPat ient.Capti on := lblP tName.Capt ion + ' '  + lblPtSSN .Caption +  ' ' + lbl PtAge.Capt ion;
  1415       if Len gth(CWAD)  > 0
  1416         then  lblPtPost ings.Capti on := 'Pos tings'
  1417         else  lblPtPost ings.Capti on := 'No  Postings';
  1418       lblPtC WAD.Captio n := CWAD;
  1419       pnlPos tings.Capt ion := lbl PtPostings .Caption +  ' ' + lbl PtCWAD.Cap tion;
  1420       if (Le ngth(Prima ryTeam) >  0) or (Len gth(Primar yProvider)  > 0) then
  1421       begin
  1422         lblP tCare.Capt ion := Pri maryTeam +  ' / ' + M ixedCase(P rimaryProv ider);
  1423         if L ength(Asso ciate)>0 t hen lblPtC are.Captio n :=  lblP tCare.Capt ion + ' /  ' + MixedC ase(Associ ate);
  1424       end;
  1425       if Len gth(Attend ing) > 0 t hen lblPtA ttending.C aption :=  '(Inpatien t) Attendi ng:  ' + M ixedCase(A ttending);
  1426       pnlPri maryCare.C aption :=  lblPtCare. Caption +  ' ' + lblP tAttending .Caption;
  1427       if Len gth(InProv ider) > 0   then lblP tAttending .Caption : = lblPtAtt ending.Cap tion + ' -  (Inpatien t) Provide r: ' + Mix edCase(InP rovider);
  1428       if Len gth(MHTC)  > 0 then l blPtMHTC.C aption :=  'MH Treatm ent Coordi nator: ' +  MixedCase (MHTC);
  1429       if (Le ngth(MHTC)  = 0) and  (Inpatient  = True) a nd (Specia ltySvc = ' P') then
  1430         lblP tMHTC.Capt ion := 'MH  Treatment  Coordinat or Unassig ned';
  1431       pnlPri maryCare.C aption :=  lblPtCare. Caption +  ' ' + lblP tAttending .Caption +  ' ' + lbl PtMHTC.Cap tion;
  1432       SetUpC IRN;
  1433       Displa yEncounter Text;
  1434       SetSha reNode(DFN , Handle);
  1435       with P atient do
  1436         Noti fyOtherApp s(NAE_NEWP T, SSN + U  + FloatTo Str(DOB) +  U + Name) ;
  1437       Select Msg := '';
  1438       if Mea nsTestRequ ired(Patie nt.DFN, AM sg) then S electMsg : = AMsg;
  1439       if Has LegacyData (Patient.D FN, AMsg)      then S electMsg : = SelectMs g + CRLF +  AMsg;
  1440  
  1441       HasAct iveFlg(Fla gList, Has Flag, Pati ent.DFN);
  1442       if Has Flag then  begin
  1443         txtC mdFlags.Vi sible := f alse;
  1444         pnlF lag.Enable d := True;
  1445         lblF lag.Font.C olor := Ge t508Compli antColor(c lMaroon);
  1446         lblF lag.Enable d := True;
  1447         if ( not FReFre shing) and  (TriggerP RFPopUp(Pa tient.DFN) ) then
  1448           Sh owFlags;
  1449       end el se begin
  1450         txtC mdFlags.Vi sible := S creenReade rSystemAct ive;
  1451         pnlF lag.Enable d := False ;
  1452         lblF lag.Font.C olor := cl BtnFace;
  1453         lblF lag.Enable d := False ;
  1454       end;
  1455       FPrevP tID := pat ient.DFN;
  1456       frmCov er.UpdateV AAButton;  //VAA CQ75 25  (moved  here in v 26.30 (RV) )
  1457       Proces sPatientCh angeEventH ook;
  1458       if Len gth(Select Msg) > 0 t hen ShowPa tientSelec tMessages( SelectMsg) ;
  1459     end;
  1460   end;
  1461  
  1462   procedure  TfrmFrame. mnuFileNex tClick(Sen der: TObje ct);
  1463   var
  1464     SaveDFN,  NewDFN: s tring; //  *DFN*
  1465     NextInde x: Integer ;
  1466     Reason:  string;
  1467     CCOWResp onse: User Response;
  1468     AccessSt atus: inte ger;
  1469  
  1470       proced ure Update PatientInf oForAlert;
  1471       begin
  1472         if P atient.Inp atient the n begin
  1473           En counter.In patient :=  True;
  1474           En counter.Lo cation :=  Patient.Lo cation;
  1475           En counter.Da teTime :=  Patient.Ad mitTime;
  1476           En counter.Vi sitCategor y := 'H';
  1477         end;
  1478         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  1479         Setu pPatient(F laggedPTLi st);
  1480         if ( FlaggedPTL ist.IndexO f(Patient. DFN) < 0)  then
  1481           Fl aggedPTLis t.Add(Pati ent.DFN);
  1482       end;
  1483  
  1484   begin
  1485     DoNotCha ngeEncWind ow := Fals e;
  1486     OrderPri ntForm :=  False;
  1487     mnuFile. Tag := 0;
  1488     SaveDFN  := Patient .DFN;
  1489     Notifica tions.Next ;
  1490     if Notif ications.A ctive then
  1491     begin
  1492       NewDFN  := Notifi cations.DF N;
  1493       if Sav eDFN <> Ne wDFN then
  1494       begin
  1495         // n ewdfn does  not have  new patien t.co infor mation for  CCOW call
  1496         if ( (Sender =  mnuFileOpe n) or (All owContextC hangeAll(R eason)))
  1497              and AllowA ccessToSen sitivePati ent(NewDFN , AccessSt atus) then
  1498         begi n
  1499           Re mindersSta rted := FA LSE;
  1500           Pa tient.DFN  := NewDFN;
  1501           En counter.Cl ear;
  1502           Ch anges.Clea r;
  1503           if  Assigned( FlagList)  then
  1504           be gin
  1505            F lagList.Cl ear;
  1506            H asFlag :=  False;
  1507            H asActiveFl g(FlagList , HasFlag,  NewDFN);
  1508           en d;
  1509           if  FCCOWInst alled and  (ctxContex tor.State  = csPartic ipating) t hen
  1510              begin
  1511                if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n
  1512                  Update PatientInf oForAlert
  1513                else
  1514                  begin
  1515                    case  CCOWRespo nse of
  1516                      ur Cancel:
  1517                         begin
  1518                           Patient. DFN := Sav eDFN;
  1519                           Notifica tions.Prio r;
  1520                           Exit;
  1521                         end;
  1522                      ur Break:
  1523                         begin
  1524                           // do no t revert t o old DFN  if context  was manua lly broken  by user -  v26 (RV)
  1525                           if (ctxC ontextor.S tate = csP articipati ng) then P atient.DFN  := SaveDF N;
  1526                           UpdatePa tientInfoF orAlert;
  1527                         end;
  1528                      el se
  1529                         UpdatePati entInfoFor Alert;
  1530                    end;
  1531                  end;
  1532              end
  1533           el se
  1534              UpdatePati entInfoFor Alert
  1535         end  else
  1536         begi n
  1537           if  AccessSta tus in [DG SR_ASK, DG SR_DENY] t hen
  1538           be gin
  1539              Notificati ons.Clear;
  1540              // hide th e 'next no tification ' button
  1541              FNextButto nActive :=  False;
  1542              FNextButto n.Free;
  1543              FNextButto n := nil;
  1544              mnuFileNex t.Enabled  := False;
  1545              mnuFileNot ifRemove.E nabled :=  False;
  1546              Patient.DF N := '';
  1547              mnuFileOpe nClick(mnu FileNext);
  1548              exit;
  1549           en d
  1550           el se
  1551           if  SaveDFN < > '' then
  1552           be gin
  1553              Patient.DF N := SaveD FN;
  1554              Notificati ons.Prior;
  1555              Exit;
  1556           en d
  1557           el se
  1558           be gin
  1559              Notificati ons.Clear;
  1560              Patient.DF N := '';
  1561              mnuFileOpe nClick(mnu FileNext);
  1562              exit;
  1563           en d;
  1564         end;
  1565       end;
  1566       stsAre a.Panels.I tems[1].Te xt := Noti fications. Text;
  1567       FChang eSource :=  CC_NOTIFI CATION;
  1568       NextIn dex := Pag eIDToTab(C T_COVER);
  1569       tabPag e.TabIndex  := CT_NOP AGE;
  1570       tabPag eChange(ta bPage);
  1571       mnuFil eNotifRemo ve.Enabled  := Notifi cations.Fo llowup in  [NF_FLAGGE D_ORDERS,
  1572                                                                      NF_ORDER_ REQUIRES_E LEC_SIGNAT URE,
  1573                                                                      NF_MEDICA TIONS_EXPI RING_INPT,
  1574                                                                      NF_MEDICA TIONS_EXPI RING_OUTPT ,
  1575                                                                      NF_UNVERI FIED_MEDIC ATION_ORDE R,
  1576                                                                      NF_UNVERI FIED_ORDER ,
  1577                                                                      NF_FLAGGE D_OI_EXP_I NPT,
  1578                                                                      NF_FLAGGE D_OI_EXP_O UTPT];
  1579       case N otificatio ns.FollowU p of
  1580         NF_L AB_RESULTS                     :  NextIndex  := PageID ToTab(CT_L ABS);
  1581         NF_F LAGGED_ORD ERS                 :  NextIndex  := PageID ToTab(CT_O RDERS);
  1582         NF_O RDER_REQUI RES_ELEC_S IGNATURE :  NextIndex  := PageID ToTab(CT_O RDERS);
  1583         NF_A BNORMAL_LA B_RESULTS           :  NextIndex  := PageID ToTab(CT_L ABS);
  1584         NF_I MAGING_RES ULTS                :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1585         NF_C ONSULT_REQ UEST_RESOL UTION    :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1586         NF_A BNORMAL_IM AGING_RESU LTS      :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1587         NF_I MAGING_REQ UEST_CANCE L_HELD   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1588         NF_N EW_SERVICE _CONSULT_R EQUEST   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1589         NF_C ONSULT_REQ UEST_CANCE L_HOLD   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1590         NF_S ITE_FLAGGE D_RESULTS           :  NextIndex  := PageID ToTab(CT_O RDERS);
  1591         NF_O RDERER_FLA GGED_RESUL TS       :  NextIndex  := PageID ToTab(CT_O RDERS);
  1592         NF_O RDER_REQUI RES_COSIGN ATURE    :  NextIndex  := PageID ToTab(CT_O RDERS);
  1593         NF_L AB_ORDER_C ANCELED             :  NextIndex  := PageID ToTab(CT_O RDERS);
  1594         NF_S TAT_RESULT S                   :
  1595           if  Piece(Pie ce(Notific ations.Ale rtData, '| ', 2), '@' , 2) = 'LR CH' then
  1596              NextIndex  := PageIDT oTab(CT_LA BS)
  1597           el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2)  = 'GMRC' t hen
  1598              NextIndex  := PageIDT oTab(CT_CO NSULTS)
  1599           el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2)  = 'RA' the n
  1600              NextIndex  := PageIDT oTab(CT_RE PORTS);
  1601         NF_D NR_EXPIRIN G                   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1602         NF_M EDICATIONS _EXPIRING_ INPT     :  NextIndex  := PageID ToTab(CT_O RDERS);
  1603         NF_M EDICATIONS _EXPIRING_ OUTPT    :  NextIndex  := PageID ToTab(CT_O RDERS);
  1604         NF_U NVERIFIED_ MEDICATION _ORDER   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1605         NF_R X_RENEWAL_ REQUEST             :
  1606           be gin
  1607              if (Notifi cations.Al ertData =  '') then
  1608              begin
  1609                Notifica tions.Dele te;
  1610              end;
  1611              NextIndex  := PageIDT oTab(CT_OR DERS);
  1612           en d;
  1613         NF_L APSED_ORDE R                   :  NextIndex  := PageID ToTab(CT_O RDERS);
  1614         NF_N EW_ORDER                       :  NextIndex  := PageID ToTab(CT_O RDERS);
  1615         NF_I MAGING_RES ULTS_AMEND ED       :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1616         NF_C RITICAL_LA B_RESULTS           :  NextIndex  := PageID ToTab(CT_L ABS);
  1617         NF_U NVERIFIED_ ORDER               :  NextIndex  := PageID ToTab(CT_O RDERS);
  1618         NF_F LAGGED_OI_ RESULTS             :  NextIndex  := PageID ToTab(CT_O RDERS);
  1619         NF_F LAGGED_OI_ ORDER               :  NextIndex  := PageID ToTab(CT_O RDERS);
  1620         NF_D C_ORDER                        :  NextIndex  := PageID ToTab(CT_O RDERS);
  1621         NF_D EA_AUTO_DC _CS_MED_OR DER      :  NextIndex  := PageID ToTab(CT_O RDERS);
  1622         NF_D EA_CERT_RE VOKED               :  NextIndex  := PageID ToTab(CT_O RDERS);
  1623         NF_C ONSULT_UNS IGNED_NOTE          :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1624         NF_D CSUMM_UNSI GNED_NOTE           :  NextIndex  := PageID ToTab(CT_D CSUMM);
  1625         NF_N OTES_UNSIG NED_NOTE            :  NextIndex  := PageID ToTab(CT_N OTES);
  1626         NF_C ONSULT_REQ UEST_UPDAT ED       :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1627         NF_F LAGGED_OI_ EXP_INPT            :  NextIndex  := PageID ToTab(CT_O RDERS);
  1628         NF_F LAGGED_OI_ EXP_OUTPT           :  NextIndex  := PageID ToTab(CT_O RDERS);
  1629         NF_C ONSULT_PRO C_INTERPRE TATION   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  1630         NF_R TC_CANCEL_ ORDERS              :  NextIndex  := PageID ToTab(CT_O RDERS);
  1631         NF_I MAGING_REQ UEST_CHANG ED       :
  1632           be gin
  1633              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);
  1634              Notificati ons.Delete ;
  1635           en d;
  1636         NF_L AB_THRESHO LD_EXCEEDE D        :  NextIndex  := PageID ToTab(CT_L ABS);
  1637         NF_M AMMOGRAM_R ESULTS              :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1638         NF_P AP_SMEAR_R ESULTS              :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1639         NF_A NATOMIC_PA THOLOGY_RE SULTS    :  NextIndex  := PageID ToTab(CT_R EPORTS);
  1640         NF_S URGERY_UNS IGNED_NOTE          :  if TabExi sts(CT_SUR GERY) then
  1641                                                  NextInd ex := Page IDToTab(CT _SURGERY)
  1642                                                else
  1643                                                  InfoBox (TX_NO_SUR G_NOTIF, T C_NO_SURG_ NOTIF, MB_ OK);
  1644       else
  1645         Info Box(TX_UNK _NOTIF, TC _UNK_NOTIF , MB_OK);
  1646       end;
  1647       tabPag e.TabIndex  := NextIn dex;
  1648       tabPag eChange(ta bPage);
  1649     end else
  1650       mnuFil eOpenClick (mnuFileNe xt);
  1651   end;
  1652  
  1653   procedure  TfrmFrame. SetBADxLis t;
  1654   var
  1655     i: small int;
  1656   begin
  1657     if not A ssigned(UB AGlobals.t empDxList)  then
  1658        begin
  1659        UBAGl obals.temp DxList :=  TList.Crea te;
  1660        UBAGl obals.temp DxList.Cou nt := 0;
  1661        Appli cation.Pro cessMessag es;
  1662        end
  1663     else
  1664        begin
  1665        //Kil l the old  Dx list
  1666        for i  := 0 to p red(UBAGlo bals.tempD xList.Coun t) do
  1667           TO bject(UBAG lobals.tem pDxList[i] ).Free;
  1668  
  1669        UBAGl obals.temp DxList.Cle ar;
  1670        Appli cation.Pro cessMessag es;
  1671  
  1672        //Cre ate new Dx  list for  newly sele cted patie nt
  1673         if n ot Assigne d(UBAGloba ls.tempDxL ist) then
  1674            b egin
  1675            U BAGlobals. tempDxList  := TList. Create;
  1676            U BAGlobals. tempDxList .Count :=  0;
  1677            A pplication .ProcessMe ssages;
  1678            e nd;
  1679        end;
  1680   end;
  1681  
  1682   procedure  TfrmFrame. mnuFileOpe nClick(Sen der: TObje ct);
  1683   { select a  new patie nt & updat e the head er display s (patient  id, encou nter, post ings) }
  1684   var
  1685     SaveDFN,  Reason: s tring;
  1686     ok, OldR emindersSt arted, PtS elCancelle d: boolean ;
  1687     CCOWResp onse: User Response;
  1688     ThisSess ionChanges : TChanges ;
  1689     I: Integ er;
  1690   begin
  1691     pnlPatie nt.Enabled  := false;
  1692     if (Send er = mnuFi leOpen) or  (FRefresh ing) then  PTSwitchRe fresh := T rue
  1693     else PTS witchRefre sh := Fals e;  //part  of a chan ge to CQ # 11529
  1694     PtSelCan celled :=  FALSE;
  1695     if not F Refreshing  then mnuF ile.Tag :=  0
  1696     else mnu File.Tag : = 1;
  1697     Determin eNextTab;
  1698     //if Sen der <> mnu FileNext t hen         //CQ 1627 3 & 16419  - Missing  Review/Sig n Changes  dialog whe n clicking  'Next' bu tton.
  1699     ThisSess ionChanges  := TChang es.Create;
  1700     try
  1701       //Loop  through a nd add in  the docume nts
  1702       for i  := 0 to Ch anges.Docu ments.Coun t - 1 do b egin
  1703         This SessionCha nges.Add(C H_DOC, TCh angeItem(C hanges.Doc uments.Ite ms[i]).ID,  TChangeIt em(Changes .Documents .Items
  1704         [i]) .Text, TCh angeItem(C hanges.Doc uments.Ite ms[i]).Gro upName, TC hangeItem( Changes.Do cuments.It ems[i]).Si gnState,
  1705         TCha ngeItem(Ch anges.Docu ments.Item s[i]).Pare ntID, TCha ngeItem(Ch anges.Docu ments.Item s[i]).User ,
  1706         TCha ngeItem(Ch anges.Docu ments.Item s[i]).Orde rDG, TChan geItem(Cha nges.Docum ents.Items [i]).DCOrd er,
  1707         TCha ngeItem(Ch anges.Docu ments.Item s[i]).Dela y);
  1708       end;
  1709       //Loop  through a nd add in  the orders
  1710       for i  := 0 to Ch anges.Orde rs.Count -  1 do begi n
  1711        ThisS essionChan ges.Add(CH _ORD, TCha ngeItem(Ch anges.Orde rs.Items[i ]).ID, TCh angeItem(C hanges.Ord ers.Items[ i]).Text,
  1712        TChan geItem(Cha nges.Order s.Items[i] ).GroupNam e, TChange Item(Chang es.Orders. Items[i]). SignState,
  1713        TChan geItem(Cha nges.Order s.Items[i] ).ParentID , TChangeI tem(Change s.Orders.I tems[i]).U ser,
  1714        TChan geItem(Cha nges.Order s.Items[i] ).OrderDG,  TChangeIt em(Changes .Orders.It ems[i]).DC Order,
  1715        TChan geItem(Cha nges.Order s.Items[i] ).Delay);
  1716       end;
  1717       //Loop  through a nd add in  PCE
  1718       for i  := 0 to Ch anges.PCE. Count - 1  do begin
  1719         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,
  1720         TCha ngeItem(Ch anges.PCE. Items[i]). GroupName,  TChangeIt em(Changes .PCE.Items [i]).SignS tate,
  1721         TCha ngeItem(Ch anges.PCE. Items[i]). ParentID,  TChangeIte m(Changes. PCE.Items[ i]).User,
  1722         TCha ngeItem(Ch anges.PCE. Items[i]). OrderDG, T ChangeItem (Changes.P CE.Items[i ]).DCOrder ,
  1723         TCha ngeItem(Ch anges.PCE. Items[i]). Delay);
  1724       end;
  1725       if not  AllowCont extChangeA ll(Reason)  then
  1726         begi n
  1727           pn lPatient.E nabled :=  True;
  1728           // If this is  cancelled  then relo ad this se ssions cha nges.
  1729           Ch anges.Clea r;
  1730           // Loop throu gh and add  in the do cuments
  1731           fo r i := 0 t o ThisSess ionChanges .Documents .Count - 1  do begin
  1732              Changes.Ad d(CH_DOC,
  1733              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .ID,
  1734              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .Text,
  1735              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .GroupName ,
  1736              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .SignState ,
  1737              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .ParentID,
  1738              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .User,
  1739              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .OrderDG,
  1740              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .DCOrder,
  1741              TChangeIte m(ThisSess ionChanges .Documents .Items[i]) .Delay);
  1742           en d;
  1743           // Loop throu gh and add  in the or ders
  1744           fo r i := 0 t o ThisSess ionChanges .Orders.Co unt - 1 do  begin
  1745              Changes.Ad d(CH_ORD,  TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).ID ,
  1746              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Te xt,
  1747              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Gr oupName,
  1748              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Si gnState,
  1749              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Pa rentID,
  1750              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Us er,
  1751              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).Or derDG,
  1752              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).DC Order,
  1753              TChangeIte m(ThisSess ionChanges .Orders.It ems[i]).De lay);
  1754           en d;
  1755           // Loop throu gh and add  in PCE
  1756           fo r i := 0 t o ThisSess ionChanges .PCE.Count  - 1 do be gin
  1757              Changes.Ad d(CH_PCE,  TChangeIte m(ThisSess ionChanges .PCE.Items [i]).ID,
  1758              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Text,
  1759              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Group Name,
  1760              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).SignS tate,
  1761              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Paren tID,
  1762              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).User,
  1763              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Order DG,
  1764              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).DCOrd er,
  1765              TChangeIte m(ThisSess ionChanges .PCE.Items [i]).Delay );
  1766           en d;
  1767           Ex it;
  1768         end;
  1769     finally
  1770       ThisSe ssionChang es.Clear;
  1771       ThisSe ssionChang es.Free;
  1772     end;
  1773     // updat e status t ext here
  1774     stsArea. Panels.Ite ms[1].Text  := '';
  1775     if (not  User.IsRep ortsOnly)  then
  1776     begin
  1777       if not  FRefreshi ng then
  1778       begin
  1779         Noti fications. Next;   //  avoid pro mpt if no  more alert s selected  to proces s  {v14a R V}
  1780         if N otificatio ns.Active  then
  1781         begi n
  1782           if  (InfoBox( TX_NOTIF_S TOP, TC_NO TIF_STOP,  MB_YESNO)  = ID_NO) t hen
  1783           be gin
  1784              Notificati ons.Prior;
  1785              pnlPatient .Enabled : = True;
  1786              Exit;
  1787           en d;
  1788         end;
  1789         if N otificatio ns.Active  then Notif ications.P rior;
  1790       end;
  1791     end;
  1792  
  1793     if FNoPa tientSelec ted then
  1794       SaveDF N := ''
  1795     else
  1796       SaveDF N := Patie nt.DFN;
  1797  
  1798     OldRemin dersStarte d := Remin dersStarte d;
  1799     Reminder sStarted : = FALSE;
  1800     try
  1801       if FRe freshing t hen
  1802       begin
  1803         Upda tePtInfoOn Refresh;
  1804         ok : = TRUE;
  1805       end
  1806       else
  1807       begin
  1808         ok : = FALSE;
  1809         if ( not User.I sReportsOn ly) then
  1810         begi n
  1811           if  FCCOWInst alled and  (ctxContex tor.State  = csPartic ipating) t hen
  1812              begin
  1813                UpdateCC OWContext;
  1814                if not F CCOWError  then
  1815                begin
  1816                  FCCOWI conName :=  'BMP_CCOW _LINKED';
  1817                  pnlCCO W.Hint :=  TX_CCOW_LI NKED;
  1818                  imgCCO W.Picture. Bitmap.Loa dFromResou rceName(hI nstance, F CCOWIconNa me);
  1819                end;
  1820              end
  1821           el se
  1822              begin
  1823                FCCOWIco nName := ' BMP_CCOW_B ROKEN';
  1824                pnlCCOW. Hint := TX _CCOW_BROK EN;
  1825                imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  1826              end;
  1827           if  (Patient. DFN = '')  or (Sender  = mnuFile Open) or ( Sender = m nuFileNext ) or (Send er = mnuVi ewDemo) th en
  1828              SelectPati ent(SHOW_N OTIFICATIO NS, Font.S ize, PtSel Cancelled) ;
  1829           if  PtSelCanc elled then
  1830              begin
  1831                pnlPatie nt.Enabled  := True;
  1832                exit;
  1833              end;
  1834           Sh owEverythi ng;
  1835           // HideEveryt hing('Retr ieving inf ormation -  please wa it....');   //v27 (pe nding) RV
  1836           Di splayEncou nterText;
  1837           FP revInPatie nt := Pati ent.Inpati ent;
  1838           if  Notificat ions.Activ e then
  1839           be gin
  1840              // display  'next not ification'  button
  1841              SetUpNextB utton;
  1842              FNextButto nActive :=  True;
  1843              mnuFileNex t.Enabled  := True;
  1844              mnuFileNex tClick(mnu FileOpen);
  1845           en d
  1846           el se
  1847           be gin
  1848              // hide th e 'next no tification ' button
  1849              FNextButto nActive :=  False;
  1850              FNextButto n.Free;
  1851              FNextButto n := nil;
  1852              mnuFileNex t.Enabled  := False;
  1853              mnuFileNot ifRemove.E nabled :=  False;
  1854              if Patient .DFN <> Sa veDFN then
  1855                ok := TR UE;
  1856           en d
  1857         end
  1858         else
  1859         begi n
  1860           No tification s.Clear;
  1861           Se lectPatien t(False, F ont.Size,  PtSelCance lled); //  Call Pt. S el. w/o no tification s.
  1862           if  PtSelCanc elled then  exit;
  1863           Sh owEverythi ng;
  1864           Di splayEncou nterText;
  1865           FP revInPatie nt := Pati ent.Inpati ent;
  1866           ok  := TRUE;
  1867         end;
  1868       end;
  1869       if ok  then
  1870       begin
  1871         if F CCOWInstal led and (c txContexto r.State =  csParticip ating) and  (not FRef reshing) t hen
  1872           be gin
  1873              if (AllowC COWContext Change(CCO WResponse,  Patient.D FN)) then
  1874                begin
  1875                  SetupP atient;
  1876                  tabPag e.TabIndex  := PageID ToTab(Next Tab);
  1877                  tabPag eChange(ta bPage);
  1878                end
  1879              else
  1880                begin
  1881                  case C COWRespons e of
  1882                    urCa ncel: Upda teCCOWCont ext;
  1883                    urBr eak:
  1884                      be gin
  1885                         // do not  revert to  old DFN if  context w as manuall y broken b y user - v 26 (RV)
  1886                         if (ctxCon textor.Sta te = csPar ticipating ) then Pat ient.DFN : = SaveDFN;
  1887                         SetupPatie nt;
  1888                         tabPage.Ta bIndex :=  PageIDToTa b(NextTab) ;
  1889                         tabPageCha nge(tabPag e);
  1890                      en d;
  1891                    else
  1892                      be gin
  1893                         SetupPatie nt;
  1894                         tabPage.Ta bIndex :=  PageIDToTa b(NextTab) ;
  1895                         tabPageCha nge(tabPag e);
  1896                      en d;
  1897                  end;
  1898                end;
  1899           en d
  1900         else
  1901           be gin
  1902              SetupPatie nt;
  1903              tabPage.Ta bIndex :=  PageIDToTa b(NextTab) ;
  1904              tabPageCha nge(tabPag e);
  1905           en d;
  1906       end;
  1907     finally
  1908       if (no t FRefresh ing) and ( Patient.DF N = SaveDF N) then
  1909         Remi ndersStart ed := OldR emindersSt arted;
  1910       FFirst Load := Fa lse;
  1911     end;
  1912    {Begin Bi llingAware }
  1913     if  BILL ING_AWARE  then frmFr ame.SetBAD xList; //e nd IsBilli ngAware
  1914    {End Bill ingAware}
  1915    if not FR efreshing  then
  1916      begin
  1917         DoNo tChangeEnc Window :=  false;
  1918         Orde rPrintForm  := false;
  1919         uCor e.TempEnco unterLoc : = 0;
  1920         uCor e.TempEnco unterLocNa me := '';
  1921      end;
  1922    pnlPatien t.Enabled  := True;
  1923   end;
  1924  
  1925   procedure  TfrmFrame. DetermineN extTab;
  1926   begin
  1927     if (FRef reshing or  User.UseL astTab) an d (not FFi rstLoad) t hen
  1928       begin
  1929         if ( tabPage.Ta bIndex < 0 ) then
  1930           Ne xtTab := L astTab
  1931         else
  1932           Ne xtTab := T abToPageID (tabPage.T abIndex);
  1933       end
  1934     else
  1935       NextTa b := User. InitialTab ;
  1936     if NextT ab = CT_NO PAGE then  NextTab :=  User.Init ialTab;
  1937     if User. IsReportsO nly then / / Reports  Only tab.
  1938       NextTa b := CT_RE PORTS; //  Only one t ab should  exist by t his point  in "REPORT S ONLY" mo de.
  1939     if not T abExists(N extTab) th en NextTab  := CT_COV ER;
  1940     if NextT ab = CT_NO PAGE then  NextTab :=  User.Init ialTab;
  1941     if NextT ab = CT_OR DERS then
  1942       if frm Orders <>  nil then w ith frmOrd ers do
  1943       begin
  1944         if ( lstSheets. ItemIndex  > -1 ) and  (TheCurre ntView <>  nil) and ( theCurrent View.Event Delay.PtEv entIFN>0)  then
  1945           Pt EvtComplet ed(TheCurr entView.Ev entDelay.P tEventIFN,  TheCurren tView.Even tDelay.Eve ntName);
  1946       end;
  1947   end;
  1948  
  1949   procedure  TfrmFrame. mnuFileEnc ounterClic k(Sender:  TObject);
  1950   { displays  encounter  window an d updates  encounter  display in  case enco unter was  updated }
  1951   begin
  1952     UpdateEn counter(NP F_ALL); {* KCM*}
  1953     DisplayE ncounterTe xt;
  1954   end;
  1955  
  1956   procedure  TfrmFrame. mnuFileRev iewClick(S ender: TOb ject);
  1957   { displays  the Revie w Changes  window (wh ich resets  the Encou nter objec t) }
  1958   var
  1959     EventCha nges: bool ean;
  1960     NameNeed Look: stri ng;
  1961   begin
  1962     FReviewC lick := Tr ue;
  1963     mnuFile. Tag := 1;
  1964     EventCha nges := Fa lse;
  1965     NameNeed Look := '' ;
  1966     //Update PtInfoOnRe fresh;
  1967     if Chang es.Count >  0 then
  1968     begin
  1969      if (frm Orders <>  nil) and ( frmOrders. TheCurrent View <> ni l) and ( f rmOrders.T heCurrentV iew.EventD elay.Event IFN>0) the n
  1970      begin
  1971        Event Changes :=  True;
  1972        NameN eedLook :=  frmOrders .TheCurren tView.View Name;
  1973        frmOr ders.PtEvt Completed( frmOrders. TheCurrent View.Event Delay.PtEv entIFN, fr mOrders.Th eCurrentVi ew.EventDe lay.EventN ame);
  1974      end;
  1975      ReviewC hanges(Tim edOut, Eve ntChanges) ;
  1976      if TabT oPageID(ta bPage.TabI ndex)= CT_ MEDS then
  1977      begin
  1978        frmOr ders.InitO rderSheets 2(NameNeed Look);
  1979      end;
  1980     end
  1981     else Inf oBox('No n ew changes  to review /sign.', ' Review Cha nges', MB_ OK);
  1982     //CQ #17 491: Moved  UpdatePtI nfoOnRefre sh here to  allow for  the updat ing of the  patient s tatus indi cator
  1983     //in the  header ba r (after t he Review  Changes di alog close s) if the  patient be comes admi tted/disch arged.
  1984     UpdatePt InfoOnRefr esh;
  1985     FOrderPr intForm :=  false;
  1986     FReviewC lick := fa lse;
  1987   end;
  1988  
  1989   procedure  TfrmFrame. mnuFileExi tClick(Sen der: TObje ct);
  1990   { see the  CloseQuery  event }
  1991   var
  1992     i: small int;
  1993   begin
  1994     try
  1995        if  B ILLING_AWA RE then
  1996            b egin
  1997            i f Assigned (tempDxLis t) then
  1998                for i :=  0 to pred (UBAGlobal s.tempDxLi st.Count)  do
  1999                   TObje ct(UBAGlob als.tempDx List[i]).F ree;
  2000  
  2001            U BAGlobals. tempDxList .Clear;
  2002            A pplication .ProcessMe ssages;
  2003            e nd; //end  IsBillingA ware
  2004     except
  2005        on EA ccessViola tion do
  2006           be gin
  2007           {$ ifdef debu gCPRS}{Sho w508Messag e('Access  Violation  in procedu re TfrmFra me.mnuFile ExitClick( )');}{$end if}
  2008           ra ise;
  2009           en d;
  2010        on E:  Exception  do
  2011           be gin
  2012           {$ ifdef debu gCPRS}{Sho w508Messag e('Unhandl ed excepti on in proc edure Tfrm Frame.mnuF ileExitCli ck()');}{$ endif}
  2013           ra ise;
  2014           en d;
  2015     end;
  2016  
  2017     Close;
  2018   end;
  2019  
  2020   { View Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2021  
  2022   procedure  TfrmFrame. mnuViewPos tingsClick (Sender: T Object);
  2023   begin
  2024   end;
  2025  
  2026   { Tool Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2027  
  2028   function T frmFrame.E xpandComma nd(x: stri ng): strin g;
  2029   { look for  'macros'  on the com mand line  and expand  them usin g current  context }
  2030  
  2031     procedur e Substitu te(const K ey, Data:  string);
  2032     var
  2033       Stop,  Start: Int eger;
  2034     begin
  2035       Stop   := Pos(Key , x) - 1;
  2036       Start  := Stop +  Length(Key ) + 1;
  2037       x := C opy(x, 1,  Stop) + Da ta + Copy( x, Start,  Length(x)) ;
  2038     end;
  2039  
  2040   begin
  2041     if Pos(' %MREF', x)  > 0 then  Substitute ('%MREF',
  2042       '^TMP( ''ORWCHART '',' + MSc alar('$J')  + ',''' +  DottedIPS tr + ''','  + IntToHe x(Handle,  8) + ')');
  2043     if Pos(' %SRV',  x)  > 0 then  Substitute ('%SRV',   String(RPC BrokerV.Se rver));
  2044     if Pos(' %PORT', x)  > 0 then  Substitute ('%PORT',  IntToStr(R PCBrokerV. ListenerPo rt));
  2045     if Pos(' %DFN',  x)  > 0 then  Substitute ('%DFN',   Patient.DF N);  //*DF N*
  2046     if Pos(' %DUZ',  x)  > 0 then  Substitute ('%DUZ',   IntToStr(U ser.DUZ));
  2047     if Pos(' %H', x) >  0  then Su bstitute(' %H', Strin g(RPCBroke rV.LogIn.L ogInHandle ));
  2048     Result : = x;
  2049   end;
  2050  
  2051   procedure  TfrmFrame. ToolClick( Sender: TO bject);
  2052   { executes  the progr am associa ted with a n item on  the Tools  menu, the  command li ne is stor ed
  2053     in the i tem's hint  property  }
  2054   const
  2055     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?';
  2056     TC_ECS_N OTFOUND =  'Applicati on Not Fou nd';
  2057   var
  2058     x, AFile , Param, M enuCommand , ECSAppen d, CapNm,  curPath :  string;
  2059     IsECSInt erface: bo olean;
  2060  
  2061     function  TakeOutAm ps(AString : string):  string;
  2062     var
  2063       S1,S2:  string;
  2064     begin
  2065       if Pos ('&',AStri ng)=0 then
  2066       begin
  2067         Resu lt := AStr ing;
  2068         Exit ;
  2069       end;
  2070       S1 :=  Piece(AStr ing,'&',1) ;
  2071       S2 :=  Piece(AStr ing,'&',2) ;
  2072       Result  := S1 + S 2;
  2073     end;
  2074  
  2075     function  ExcuteEC( AFile,APar a: string) : boolean;
  2076     begin
  2077       if (Sh ellExecute (Handle, ' open', PCh ar(AFile),  PChar(Par am), '', S W_NORMAL)  > 32 ) the n Result : = True
  2078       else
  2079       begin
  2080         if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO  or MB_ICO NERROR) =  IDYES then
  2081         begi n
  2082           if  OROpenDlg .Execute t hen
  2083           be gin
  2084               AFile :=  OROpenDlg. FileName;
  2085               if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then
  2086               begin
  2087                 ShowMsg ('This is  not a vali d ECS appl ication.') ;
  2088                 Result  := True;
  2089               end else
  2090               begin
  2091                 if (She llExecute( Handle, 'o pen', PCha r(AFile),  PChar(Para m), '', SW _NORMAL)<3 2) then Re sult := Fa lse
  2092                 else Re sult := Tr ue;
  2093               end;
  2094           en d
  2095           el se Result  := True;
  2096         end  else Resul t := True;
  2097       end;
  2098     end;
  2099  
  2100     function  ExcuteECS (AFile, AP ara: strin g; var cur rPath: str ing): bool ean;
  2101     var
  2102       comman dline,RPCH andle: str ing;
  2103       Startu pInfo: TSt artupInfo;
  2104       Proces sInfo: TPr ocessInfor mation;
  2105     begin
  2106       FillCh ar(Startup Info, Size Of(TStartu pInfo), 0) ;
  2107       with S tartupInfo  do
  2108       begin
  2109         cb : = SizeOf(T StartupInf o);
  2110         dwFl ags := STA RTF_USESHO WWINDOW;
  2111         wSho wWindow :=  SW_SHOWNO RMAL;
  2112       end;
  2113       comman dline := A File + Par am;
  2114       RPCHan dle := Get AppHandle( RPCBrokerV );
  2115       comman dline := c ommandline  + ' H=' +  RPCHandle ;
  2116       if Cre ateProcess (nil, PCha r(commandl ine), nil,  nil, Fals e,
  2117         NORM AL_PRIORIT Y_CLASS, n il, nil, S tartupInfo , ProcessI nfo) then  Result :=  True
  2118       else
  2119       begin
  2120         if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO  or MB_ICO NERROR) =  IDYES then
  2121         begi n
  2122           if  OROpenDlg .Execute t hen
  2123           be gin
  2124               AFile :=  OROpenDlg. FileName;
  2125               if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then
  2126               begin
  2127                 ShowMsg ('This is  not a vali d ECS appl ication.') ;
  2128                 Result  := True;
  2129               end else
  2130               begin
  2131                 SaveUse rPath('Eve nt Capture  Interface ='+AFile,  currPath);
  2132                 FillCha r(StartupI nfo, SizeO f(TStartup Info), 0);
  2133                 with St artupInfo  do
  2134                 begin
  2135                   cb :=  SizeOf(TS tartupInfo );
  2136                   dwFla gs := STAR TF_USESHOW WINDOW;
  2137                   wShow Window :=  SW_SHOWNOR MAL;
  2138                 end;
  2139                 command line := AF ile + Para m;
  2140                 RPCHand le := GetA ppHandle(R PCBrokerV) ;
  2141                 command line := co mmandline  + ' H=' +  RPCHandle;
  2142                 if not  CreateProc ess(nil, P Char(comma ndline), n il, nil, F alse,
  2143                    NORM AL_PRIORIT Y_CLASS, n il, nil,St artupInfo, ProcessInf o) then Re sult := Fa lse
  2144                 else Re sult := Tr ue;
  2145               end;
  2146           en d
  2147           el se Result  := True;
  2148         end  else Resul t := True;
  2149       end;
  2150     end;
  2151  
  2152   begin
  2153     MenuComm and := '';
  2154     ECSAppen d   := '';
  2155     IsECSInt erface :=  False;
  2156     curPath  := '';
  2157     CapNm :=  LowerCase (TMenuItem (Sender).C aption);
  2158     CapNm :=  TakeOutAm ps(CapNm);
  2159     if AnsiC ompareText ('event ca pture inte rface',Cap Nm)=0 then
  2160     begin
  2161       IsECSI nterface : = True;
  2162       if FEC SAuthUser  then Updat eECSParame ter(ECSApp end)
  2163       else b egin
  2164         Show Msg('You d on''t have  permissio n to use E CS.');
  2165         exit ;
  2166       end;
  2167     end;
  2168     MenuComm and := TMe nuItem(Sen der).Hint  + ECSAppen d;
  2169     x := Exp andCommand (MenuComma nd);
  2170     if CharA t(x, 1) =  '"' then
  2171     begin
  2172       x      := Copy(x,  2, Length (x));
  2173       AFile  := Copy(x,  1, Pos('" ',x)-1);
  2174       Param  := Copy(x,  Pos('"',x )+1, Lengt h(x));
  2175     end else
  2176     begin
  2177       AFile  := Piece(x , ' ', 1);
  2178       Param  := Copy(x,  Length(AF ile)+1, Le ngth(x));
  2179     end;
  2180     if IsECS Interface  then
  2181     begin
  2182       if not  ExcuteECS (AFile,Par am,curPath ) then
  2183         Excu teECS(AFil e,Param,cu rPath);
  2184       if Len gth(curPat h)>0 then
  2185         TMen uItem(Send er).Hint : = curPath;
  2186     end
  2187     else if  (Pos('ecs' ,LowerCase (AFile))>0 ) and (not  IsECSInte rface) the n
  2188     begin
  2189       if not  ExcuteEC( AFile,Para m) then
  2190         Excu teEC(AFile ,Param);
  2191     end else
  2192     begin
  2193       ShellE xecute(Han dle, 'open ', PChar(A File), PCh ar(Param),  '', SW_NO RMAL);
  2194     end;
  2195   end;
  2196  
  2197   { Help Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2198  
  2199   procedure  TfrmFrame. mnuHelpBro kerClick(S ender: TOb ject);
  2200   { used for  debugging  - shows l ast n brok er calls }
  2201   begin
  2202     ShowBrok er;
  2203   end;
  2204  
  2205   procedure  TfrmFrame. mnuHelpLis tsClick(Se nder: TObj ect);
  2206   { used for  debugging  - shows i nternal co ntents of  TORListBox  }
  2207   begin
  2208     if Scree n.ActiveCo ntrol is T ListBox
  2209       then D ebugListIt ems(TListB ox(Screen. ActiveCont rol))
  2210       else I nfoBox('Fo cus contro l is not a  listbox',  'ListBox  Data', MB_ OK);
  2211   end;
  2212  
  2213   procedure  TfrmFrame. mnuHelpSym bolsClick( Sender: TO bject);
  2214   { used for  debugging  - shows c urrent sym bol table  }
  2215   begin
  2216     DebugSho wServer;
  2217   end;
  2218  
  2219   procedure  TfrmFrame. mnuHelpAbo utClick(Se nder: TObj ect);
  2220   { displays  the about  screen }
  2221   begin
  2222     ShowAbou t;
  2223   end;
  2224  
  2225   { Status B ar Methods  }
  2226  
  2227   procedure  TfrmFrame. UMStatusTe xt(var Mes sage: TMes sage);
  2228   { displays  status ba r text (us ing the po inter to a  text buff er passed  in LParam)  }
  2229   begin
  2230     stsArea. Panels.Ite ms[0].Text  := StrPas (PChar(Mes sage.LPara m));
  2231     stsArea. Refresh;
  2232   end;
  2233  
  2234   { Toolbar  Methods (m ake panels  act like  buttons) - ---------- ---------- ---------- ---------- -- }
  2235  
  2236   procedure  TfrmFrame. pnlPatient MouseDown( Sender: TO bject; But ton: TMous eButton;
  2237     Shift: T ShiftState ; X, Y: In teger);
  2238   { emulate  a button p ress in th e patient  identifica tion panel  }
  2239   begin
  2240     if pnlPa tient.Beve lOuter = b vLowered t hen exit;
  2241     pnlPatie nt.BevelOu ter := bvL owered;
  2242     with lbl PtName do  SetBounds( Left+2, To p+2, Width , Height);
  2243     with lbl PtSSN  do  SetBounds( Left+2, To p+2, Width , Height);
  2244     with lbl PtAge  do  SetBounds( Left+2, To p+2, Width , Height);
  2245   end;
  2246  
  2247   procedure  TfrmFrame. pnlPatient MouseUp(Se nder: TObj ect; Butto n: TMouseB utton;
  2248     Shift: T ShiftState ; X, Y: In teger);
  2249   { emulate  the button  raising i n the pati ent identi fication p anel & cal l Patient  Inquiry }
  2250   begin
  2251     if pnlPa tient.Beve lOuter = b vRaised th en exit;
  2252     pnlPatie nt.BevelOu ter := bvR aised;
  2253     with lbl PtName do  SetBounds( Left-2, To p-2, Width , Height);
  2254     with lbl PtSSN  do  SetBounds( Left-2, To p-2, Width , Height);
  2255     with lbl PtAge  do  SetBounds( Left-2, To p-2, Width , Height);
  2256   end;
  2257  
  2258   procedure  TfrmFrame. pnlVisitMo useDown(Se nder: TObj ect; Butto n: TMouseB utton;
  2259     Shift: T ShiftState ; X, Y: In teger);
  2260   { emulate  a button p ress in th e encounte r panel }
  2261   begin
  2262     if User. IsReportsO nly then
  2263       exit;
  2264     if pnlVi sit.BevelO uter = bvL owered the n exit;
  2265     pnlVisit .BevelOute r := bvLow ered;
  2266     with lbl PtLocation  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2267     with lbl PtProvider  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2268   end;
  2269  
  2270   procedure  TfrmFrame. pnlVisitMo useUp(Send er: TObjec t; Button:  TMouseBut ton;
  2271     Shift: T ShiftState ; X, Y: In teger);
  2272   { emulate  a button r aising in  the encoun ter panel  and call U pdate Prov ider/Locat ion }
  2273   begin
  2274     if User. IsReportsO nly then
  2275       exit;
  2276     if pnlVi sit.BevelO uter = bvR aised then  exit;
  2277     pnlVisit .BevelOute r := bvRai sed;
  2278     with lbl PtLocation  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2279     with lbl PtProvider  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2280   end;
  2281  
  2282   procedure  TfrmFrame. pnlVistaWe bClick(Sen der: TObje ct);
  2283   begin
  2284     inherite d;
  2285     uUseVist aWeb := tr ue;
  2286     pnlVista Web.BevelO uter := bv Lowered;
  2287     pnlCIRNC lick(self) ;
  2288     uUseVist aWeb := fa lse;
  2289   end;
  2290  
  2291   procedure  TfrmFrame. pnlVistaWe bMouseDown (Sender: T Object; Bu tton: TMou seButton;
  2292     Shift: T ShiftState ; X, Y: In teger);
  2293   begin
  2294     inherite d;
  2295     pnlVista Web.BevelO uter := bv Lowered;
  2296   end;
  2297  
  2298   procedure  TfrmFrame. pnlVistaWe bMouseUp(S ender: TOb ject; Butt on: TMouse Button;
  2299     Shift: T ShiftState ; X, Y: In teger);
  2300   begin
  2301     inherite d;
  2302     pnlVista Web.BevelO uter := bv Raised;
  2303   end;
  2304  
  2305   procedure  TfrmFrame. pnlPrimary CareMouseD own(Sender : TObject;
  2306     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2307   begin
  2308     if pnlPr imaryCare. BevelOuter  = bvLower ed then ex it;
  2309     pnlPrima ryCare.Bev elOuter :=  bvLowered ;
  2310     with lbl PtCare       do SetBo unds(Left+ 2, Top+2,  Width, Hei ght);
  2311     with lbl PtAttendin g do SetBo unds(Left+ 2, Top+2,  Width, Hei ght);
  2312     with lbl PtMHTC do  SetBounds( Left+2, To p+2, Width , Height);
  2313   end;
  2314  
  2315   procedure  TfrmFrame. pnlPrimary CareMouseU p(Sender:  TObject;
  2316     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2317   begin
  2318     if pnlPr imaryCare. BevelOuter  = bvRaise d then exi t;
  2319     pnlPrima ryCare.Bev elOuter :=  bvRaised;
  2320     with lbl PtCare       do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2321     with lbl PtAttendin g do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2322     with lbl PtMHTC       do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2323   end;
  2324  
  2325   procedure  TfrmFrame. pnlPosting sMouseDown (Sender: T Object;
  2326     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2327   { emulate  a button p ress in th e postings  panel }
  2328   begin
  2329     if pnlPo stings.Bev elOuter =  bvLowered  then exit;
  2330     pnlPosti ngs.BevelO uter := bv Lowered;
  2331     with lbl PtPostings  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2332     with lbl PtCWAD      do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2333   end;
  2334  
  2335   procedure  TfrmFrame. pnlPosting sMouseUp(S ender: TOb ject;
  2336     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2337   { emulate  a button r aising in  the postin g panel an d call Pos tings }
  2338   begin
  2339     if pnlPo stings.Bev elOuter =  bvRaised t hen exit;
  2340     pnlPosti ngs.BevelO uter := bv Raised;
  2341     with lbl PtPostings  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2342     with lbl PtCWAD      do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2343   end;
  2344  
  2345   { Resize a nd Font-Ch ange proce dures ---- ---------- ---------- ---------- ---------- ---------- -- }
  2346  
  2347   procedure  TfrmFrame. LoadSizesF orUser;
  2348   var
  2349     s1, s2,  s3, s4, Du mmy: integ er;
  2350     panelBot tom, panel MedIn, Res toreWidth,  MinCnst :  integer;
  2351  
  2352     procedur e GetMinCo ntraint(aC ontrol: TW inControl;  var LastM inWidth: I nteger);
  2353     var
  2354      I: inte ger;
  2355     begin
  2356      if aCon trol.Const raints.Min Width > La stMinWidth  then
  2357        LastM inWidth :=  aControl. Constraint s.MinWidth ;
  2358  
  2359      for I : = 0 to aCo ntrol.Cont rolCount -  1 do
  2360      begin
  2361        if aC ontrol.Con trols[i] i s TWinCont rol then
  2362         GetM inContrain t(TWinCont rol(aContr ol.Control s[i]), Las tMinWidth) ;
  2363      end;
  2364  
  2365     end;
  2366  
  2367   begin
  2368     ChangeFo nt(UserFon tSize);
  2369     SetUserB ounds(TCon trol(frmFr ame));
  2370     SetUserW idths(TCon trol(frmPr oblems.pnl Left));
  2371     SetUserW idths(TCon trol(frmOr ders.pnlLe ft));
  2372     RestoreW idth := fr mNotes.pnl Left.Width ;
  2373     SetUserW idths(TCon trol(frmNo tes.pnlLef t));
  2374     MinCnst  := 0;
  2375     GetMinCo ntraint(fr mNotes.pnl Left, MinC nst);
  2376     if frmNo tes.pnlLef t.Width <  MinCnst th en
  2377      frmNote s.pnlLeft. Width := R estoreWidt h;
  2378  
  2379     frmNotes .splHorz.L eft := frm Notes.pnlL eft.left +  1;
  2380     SetUserW idths(TCon trol(frmCo nsults.pnl Left));
  2381     SetUserW idths(TCon trol(frmDC Summ.pnlLe ft));
  2382     if Assig ned(frmSur gery) then  SetUserWi dths(TCont rol(frmSur gery.pnlLe ft));
  2383     SetUserW idths(TCon trol(frmLa bs.pnlLeft ));
  2384     SetUserW idths(TCon trol(frmRe ports.pnlL eft));
  2385     SetUserC olumns(TCo ntrol(frmO rders.hdrO rders));
  2386     SetUserC olumns(TCo ntrol(frmM eds.hdrMed sIn));  //  still nee d conversi on
  2387     SetUserC olumns(TCo ntrol(frmM eds.hdrMed sOut));
  2388     SetUserS tring('frm PtSel.lstv Alerts',En duringPtSe lColumns);
  2389     SetUserS tring(Spel lCheckerSe ttingName,  SpellChec kerSetting s);
  2390     SetUserB ounds2(Tem plateEdito rSplitters , tmplEdit orSplitter Middle,
  2391                     tmp lEditorSpl itterPrope rties, tmp lEditorSpl itterMain,  tmplEdito rSplitterB oil);
  2392     SetUserB ounds2(Tem plateEdito rSplitters 2, tmplEdi torSplitte rNotes, Du mmy, Dummy , Dummy);
  2393     SetUserB ounds2(Rem inderTreeN ame, RemTr eeDlgLeft,  RemTreeDl gTop, RemT reeDlgWidt h, RemTree DlgHeight) ;
  2394     SetUserB ounds2(Rem DlgName, R emDlgLeft,  RemDlgTop , RemDlgWi dth, RemDl gHeight);
  2395     SetUserB ounds2(Rem DlgSplitte rs, RemDlg Spltr1, Re mDlgSpltr2 , Dummy ,D ummy);
  2396     SetUserB ounds2(Dra werSplitte rs,s1, s2,  s3, S4);
  2397     frmNotes .Drawers.L astOpenSiz e := s1;
  2398     frmConsu lts.Drawer s.LastOpen Size := s2 ;
  2399     frmDCSum m.Drawers. LastOpenSi ze := s3;
  2400     if Assig ned(frmSur gery) then  frmSurger y.Drawers. LastOpenSi ze := S4;  //CQ7315
  2401  
  2402     SetUserB ounds2(Lab Splitters, s1, s2, s3 , s4);
  2403     frmLabs. LoadUserSe ttings(s1,  s2, s3, s 4);
  2404  
  2405     with frm Meds do
  2406        begin
  2407        SetUs erBounds2( frmMeds.Na me+'Split' , panelBot tom, panel MedIn, Dum my, Dummy) ;
  2408        if (p anelBottom  > frmMeds .Height-50 ) then pan elBottom : = frmMeds. Height-50;
  2409        if (p anelMedIn  > panelBot tom-50) th en panelMe dIn := pan elBottom-5 0;
  2410        frmMe ds.pnlBott om.Height  := panelBo ttom;
  2411        frmMe ds.pnlMedI n.Height : = panelMed In;
  2412        //Med s Tab Non- VA meds co lumns
  2413        SetUs erColumns( TControl(h drMedsNonV A)); //CQ7 314
  2414        end;
  2415  
  2416        frmCo ver.Disabl eAlign;
  2417     try
  2418       SetUse rBounds2(C overSplitt ers1, s1,  s2, s3, s4 );
  2419       if s1  > 0 then
  2420         frmC over.pnl_1 .Width :=  LowerOf( f rmCover.pn l_not3.Cli entWidth -  5, s1);
  2421       if s2  > 0 then
  2422         frmC over.pnl_3 .Width :=  LowerOf( f rmCover.pn lTop.Clien tWidth - 5 , s2);
  2423       if s3  > 0 then
  2424         frmC over.pnlTo p.Height : = LowerOf(  frmCover. pnlBase.Cl ientHeight  - 5, s3);
  2425       if s4  > 0 then
  2426         frmC over.pnl_4 .Width :=  LowerOf( f rmCover.pn lMiddle.Cl ientWidth  - 5, s4);
  2427  
  2428       SetUse rBounds2(C overSplitt ers2, s1,  s2, s3, Du mmy);
  2429       if s1  > 0 then
  2430         frmC over.pnlBo ttom.Heigh t := Lower Of( frmCov er.pnlBase .ClientHei ght - 5, s 1);
  2431       if s2  > 0 then
  2432         frmC over.pnl_6 .Width :=  LowerOf( f rmCover.pn lBottom.Cl ientWidth  - 5, s2);
  2433       if s3  > 0 then
  2434         frmC over.pnl_8 .Width :=  LowerOf( f rmCover.pn lBottom.Cl ientWidth  - 5, s3);
  2435  
  2436     finally
  2437      frmCove r.EnableAl ign;
  2438     end;
  2439     if Param Search('re z') = '640 ' then Set Bounds(Lef t, Top, 64 8, 488);   // for tes ting
  2440  
  2441   end;
  2442  
  2443   procedure  TfrmFrame. SaveSizesF orUser;
  2444   var
  2445     SizeList : TStringL ist;
  2446     SurgTemp Ht: intege r;
  2447     s1, s2,  s3, s4: in teger;
  2448   begin
  2449     SaveUser FontSize(M ainFontSiz e);
  2450     SizeList  := TStrin gList.Crea te;
  2451     try
  2452       with S izeList do
  2453       begin
  2454         Add( StrUserBou nds(frmFra me));
  2455         Add( StrUserWid th(frmProb lems.pnlLe ft));
  2456         Add( StrUserWid th(frmOrde rs.pnlLeft ));
  2457         Add( StrUserWid th(frmNote s.pnlLeft) );
  2458         Add( StrUserWid th(frmCons ults.pnlLe ft));
  2459         Add( StrUserWid th(frmDCSu mm.pnlLeft ));
  2460         if A ssigned(fr mSurgery)  then Add(S trUserWidt h(frmSurge ry.pnlLeft ));
  2461         Add( StrUserWid th(frmLabs .pnlLeft)) ;
  2462         Add( StrUserWid th(frmRepo rts.pnlLef t));
  2463         Add( StrUserCol umns(frmOr ders.hdrOr ders));
  2464         Add( StrUserCol umns(frmMe ds.hdrMeds In));
  2465         Add( StrUserCol umns(frmMe ds.hdrMeds Out));
  2466         Add( StrUserStr ing(SpellC heckerSett ingName, S pellChecke rSettings) );
  2467         Add( StrUserBou nds2(Templ ateEditorS plitters,  tmplEditor SplitterMi ddle,
  2468                  tmplEd itorSplitt erProperti es, tmplEd itorSplitt erMain, tm plEditorSp litterBoil ));
  2469         Add( StrUserBou nds2(Templ ateEditorS plitters2,  tmplEdito rSplitterN otes, 0, 0 , 0));
  2470         Add( StrUserBou nds2(Remin derTreeNam e, RemTree DlgLeft, R emTreeDlgT op, RemTre eDlgWidth,  RemTreeDl gHeight));
  2471         Add( StrUserBou nds2(RemDl gName, Rem DlgLeft, R emDlgTop,  RemDlgWidt h, RemDlgH eight));
  2472         Add( StrUserBou nds2(RemDl gSplitters , RemDlgSp ltr1, RemD lgSpltr2,  0 ,0));
  2473  
  2474         //v2 6.47 - RV  - access v iolation i f Surgery  Tab not en abled.  Se t to desig ner height  as defaul t.
  2475         if A ssigned(fr mSurgery)  then SurgT empHt := f rmSurgery. Drawers.pn lTemplates .Height el se SurgTem pHt := 85;
  2476         Add( StrUserBou nds2(Drawe rSplitters , frmNotes .Drawers.L astOpenSiz e,
  2477                                                    frmCo nsults.Dra wers.LastO penSize,
  2478                                                    frmDC Summ.Drawe rs.LastOpe nSize,
  2479                                                    SurgT empHt)); / / last par ameter = C Q7315
  2480  
  2481         frmL abs.SaveUs erSettings (s1, s2, s 3, s4);
  2482         Add( StrUserBou nds2(LabSp litters, s 1, s2, s3,  s4));
  2483         Add( StrUserBou nds2(Cover Splitters1 ,
  2484           fr mCover.pnl _1.Width,
  2485           fr mCover.pnl _3.Width,
  2486           fr mCover.pnl Top.Height ,
  2487           fr mCover.pnl _4.Width)) ;
  2488         Add( StrUserBou nds2(Cover Splitters2 ,
  2489           fr mCover.pnl Bottom.Hei ght,
  2490           fr mCover.pnl _6.Width,
  2491           fr mCover.pnl _8.Width,
  2492           0) );
  2493  
  2494         //Me ds Tab Spl itters
  2495         Add( StrUserBou nds2(frmMe ds.Name+'S plit',frmM eds.pnlBot tom.Height ,frmMeds.p nlMedIn.He ight,0,0)) ;
  2496  
  2497         //Me ds Tab Non -VA meds c olumns
  2498         Add( StrUserCol umns(fMeds .frmMeds.h drMedsNonV A)); //CQ7 314
  2499  
  2500         //Or ders Tab c olumns
  2501         Add( StrUserCol umns(fOrde rs.frmOrde rs.hdrOrde rs)); //CQ 6328
  2502  
  2503         if E nduringPtS elSplitter Pos <> 0 t hen
  2504           Ad d(StrUserB ounds2('fr mPtSel.spt Vert', End uringPtSel SplitterPo s, 0, 0, 0 ));
  2505         if E nduringPtS elColumns  <> '' then
  2506           Ad d('C^frmPt Sel.lstvAl erts^' + E nduringPtS elColumns) ;
  2507  
  2508         //** ** Copy/Pa ste
  2509   //      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.
  2510       end;
  2511       //Add  sizes for  forms that  used Save UserBounds () to save  thier pos itions
  2512       SizeHo lder.AddSi zesToStrLi st(SizeLis t);
  2513       //Send  the SizeL ist to the  Database
  2514       SaveUs erSizes(Si zeList);
  2515     finally
  2516       SizeLi st.Free;
  2517     end;
  2518   end;
  2519  
  2520   procedure  TfrmFrame. FormResize (Sender: T Object);
  2521   { need to  resize tab  forms spe cifically  since they  don't inh erit resiz e event (b ecause the y
  2522     are deri ved from T Form itsel f) }
  2523   begin
  2524     if FTerm inate or F Closing th en Exit;
  2525     if csDes troying in  Component State then  Exit;
  2526     MoveWind ow(frmCove r.Handle,     0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2527     MoveWind ow(frmProb lems.Handl e, 0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2528     MoveWind ow(frmMeds .Handle,      0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2529     MoveWind ow(frmOrde rs.Handle,    0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2530     MoveWind ow(frmNote s.Handle,     0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2531     MoveWind ow(frmCons ults.Handl e, 0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2532     MoveWind ow(frmDCSu mm.Handle,    0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2533     if Assig ned(frmSur gery) then  MoveWindo w(frmSurge ry.Handle,      0, 0,  pnlPage.C lientWidth , pnlPage. ClientHeig ht, True);
  2534     MoveWind ow(frmLabs .Handle,      0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2535     MoveWind ow(frmRepo rts.Handle ,  0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2536     with sts Area do
  2537     begin
  2538       Panels [1].Width  := stsArea .Width - F FixedStatu sWidth;
  2539       FNextB uttonL :=  Panels[0]. Width + Pa nels[1].Wi dth;
  2540       FNextB uttonR :=  FNextButto nL + Panel s[2].Width ;
  2541     end;
  2542     if Notif ications.A ctive then  SetUpNext Button;
  2543     lstCIRNL ocations.L eft  := FN extButtonL  - ScrollB arWidth -  100;
  2544     lstCIRNL ocations.W idth := Cl ientWidth  - lstCIRNL ocations.L eft;
  2545     //cq: 15 641
  2546     if frmFr ame.FNextB uttonActiv e then //  keeps butt on aligned  if cancel  is presse d
  2547     begin
  2548       FNextB utton.Left  := FNextB uttonL;
  2549       FNextB utton.Top  := stsArea .Top;
  2550     end;
  2551     Self.Rep aint;
  2552   end;
  2553  
  2554   procedure  TfrmFrame. ChangeFont (NewFontSi ze: Intege r);
  2555   { Makes ch anges in a ll compone nts whenev er the fon t size is  changed.   This is ha rdcoded an d
  2556     based on  MS Sans S erif for n ow, as onl y the font  size may  be selecte d. Courier  New is us ed
  2557     wherever  non-propo rtional fo nts are re quired. }
  2558   const
  2559     TAB_VOFF SET = 7;
  2560   var
  2561     OldFont:  TFont;
  2562   begin
  2563   // Ho ho!   ResizeAnc horedFormT oFont(self ) doesn't  work here  because th e
  2564   // Form si ze is alia sed with M ainFormSiz e.
  2565     OldFont  := TFont.C reate;
  2566     try
  2567       Disabl eAlign;
  2568       try
  2569         OldF ont.Assign (Font);
  2570         with  Self           do Fo nt.Size :=  NewFontSi ze;
  2571         with  lblPtName      do Fo nt.Size :=  NewFontSi ze;   // m ust change  BOLDED la bels by ha nd
  2572         with  lblPtSSN       do Fo nt.Size :=  NewFontSi ze;
  2573         with  lblPtAge       do Fo nt.Size :=  NewFontSi ze;
  2574         with  lblPtLoca tion do Fo nt.Size :=  NewFontSi ze;
  2575         with  lblPtProv ider do Fo nt.Size :=  NewFontSi ze;
  2576         with  lblPtPost ings do Fo nt.Size :=  NewFontSi ze;
  2577         with  lblPtCare      do Fo nt.Size :=  NewFontSi ze;
  2578         with  lblPtAtte nding do F ont.Size : = NewFontS ize;
  2579         with  lblPtMHTC       do F ont.Size : = NewFontS ize;
  2580         with  lblFlag        do Fo nt.Size :=  NewFontSi ze;
  2581         with  lblPtCWAD      do Fo nt.Size :=  NewFontSi ze;
  2582         with  lblCIRN        do Fo nt.Size :=  NewFontSi ze;
  2583         with  lblVistaW eb   do Fo nt.Size :=  NewFontSi ze;
  2584         with  lstCIRNLo cations do
  2585           be gin
  2586              Font.Size  := NewFont Size;
  2587              ItemHeight  := NewFon tSize + 6;
  2588           en d;
  2589         with  tabPage        do Fo nt.Size :=  NewFontSi ze;
  2590         with  laMHV          do Fo nt.Size :=  NewFontSi ze; //VAA
  2591         with  laVAA2         do Fo nt.Size :=  NewFontSi ze; //VAA
  2592  
  2593         frmF rameHeight  := frmFra me.Height;
  2594         pnlP atientSele ctedHeight  := pnlPat ientSelect ed.Height;
  2595         tabP age.Height  := MainFo ntHeight +  TAB_VOFFS ET;   // r esize tab  selector
  2596         FitT oolbar;                                           // r esize tool bar
  2597         stsA rea.Font.S ize := New FontSize;
  2598         stsA rea.Height  := MainFo ntHeight +  TAB_VOFFS ET;
  2599         stsA rea.Panels [0].Width  := ResizeW idth( OldF ont, Font,  stsArea.P anels[0].W idth);
  2600         stsA rea.Panels [2].Width  := ResizeW idth( OldF ont, Font,  stsArea.P anels[2].W idth);
  2601  
  2602         //VA A CQ8271
  2603         if ( (fCover.Pt IsVAA and  fCover.PtI sMHV)) the n
  2604           be gin
  2605            l aMHV.Heigh t := (pnlT oolBar.Hei ght div 2)  -1;
  2606            w ith laVAA2  do
  2607               begin
  2608               Top := la MHV.Top +  laMHV.Heig ht;
  2609               Height :=  (pnlToolB ar.Height  div 2) -1;
  2610               end;
  2611            e nd;
  2612         //en d VAA
  2613  
  2614         Refr eshFixedSt atusWidth;
  2615         Form Resize( se lf );
  2616       finall y
  2617         Enab leAlign;
  2618       end;
  2619     finally
  2620       OldFon t.Free;
  2621     end;
  2622  
  2623     case (Ne wFontSize)  of
  2624      8: mnu8 pt.Checked  := true;
  2625     10: mnu1 0pt1.Check ed := true ;
  2626     12: mnu1 2pt1.Check ed := true ;
  2627     14: mnu1 4pt1.Check ed := true ;
  2628     18: mnu1 8pt1.Check ed := true ;
  2629     end;
  2630  
  2631     //Now th at the for m elements  are resiz ed, the pa ges will k now what s ize to tak e.
  2632     frmCover .SetFontSi ze(NewFont Size);                  // child  pages lac k a Parent Font prope rty
  2633     frmProbl ems.SetFon tSize(NewF ontSize);
  2634     frmMeds. SetFontSiz e(NewFontS ize);
  2635     frmOrder s.SetFontS ize(NewFon tSize);
  2636     frmNotes .SetFontSi ze(NewFont Size);
  2637     frmConsu lts.SetFon tSize(NewF ontSize);
  2638     frmDCSum m.SetFontS ize(NewFon tSize);
  2639     if Assig ned(frmSur gery) then  frmSurger y.SetFontS ize(NewFon tSize);
  2640     frmLabs. SetFontSiz e(NewFontS ize);
  2641     frmRepor ts.SetFont Size(NewFo ntSize);
  2642     TfrmIcon Legend.Set FontSize(N ewFontSize );
  2643     uOrders. SetFontSiz e(NewFontS ize);
  2644     if Assig ned(frmRem Dlg) then  frmRemDlg. SetFontSiz e;
  2645     //if (Tf rmRemDlg.G etInstance  <> nil) t hen TfrmRe mDlg.GetIn stance.Set FontSize;
  2646     if Assig ned(frmRem inderTree)  then frmR eminderTre e.SetFontS ize(NewFon tSize);
  2647     if Graph Float <> n il then Re sizeAnchor edFormToFo nt(GraphFl oat);
  2648   end;
  2649  
  2650   procedure  TfrmFrame. FitToolBar ;
  2651   { resizes  and reposi tions the  panels & l abels used  in the to olbar }
  2652   const
  2653     PATIENT_ WIDTH = 29 ;
  2654     VISIT_WI DTH   = 36 ;
  2655     POSTING_ WIDTH = 11 .5;
  2656     FLAG_WID TH    = 5;
  2657     CV_WIDTH       = 15 ; //14; WA T
  2658     CIRN_WID TH    = 11 ;
  2659     MHV_WIDT H     = 6;
  2660     LINES_HI GH2    = 2 ;
  2661     LINES_HI GH3    = 3 ;    //lbl PtMHTC lin e change
  2662     M_HORIZ        = 4;
  2663     M_MIDDLE       = 2;
  2664     M_NVERT        = 4;
  2665     M_WVERT        = 6;
  2666     TINY_MAR GIN   = 2;
  2667   begin
  2668     if lblPt MHTC.capti on = '' th en
  2669     begin
  2670       lblPtM HTC.Visibl e := false ;
  2671       pnlToo lbar.Heigh t  := (LIN ES_HIGH2 *  lblPtName .Height) +  M_HORIZ +  M_MIDDLE  + M_HORIZ  + M_MIDDLE
  2672     end
  2673     else
  2674     begin
  2675       if (lb lPtAttendi ng.Caption  <> '') an d (lblPtAt tending.Ca ption <> l blPtMHTC.C aption) th en
  2676       begin
  2677         lblP tMHTC.Visi ble := tru e;
  2678         pnlT oolbar.Hei ght  := (L INES_HIGH3  * lblPtNa me.Height)  + M_HORIZ  + M_MIDDL E + M_HORI Z + M_HORI Z;
  2679       end;
  2680       if lbl PtAttendin g.Caption  = '' then
  2681       begin
  2682         lblP tAttending .Caption : = lblPtMHT C.Caption;
  2683         lblP tMHTC.Visi ble := fal se;
  2684         pnlT oolbar.Hei ght  := (L INES_HIGH2  * lblPtNa me.Height)  + M_HORIZ  + M_MIDDL E + M_HORI Z + M_MIDD LE;
  2685       end;
  2686     end;
  2687     pnlPatie nt.Width    := Higher Of(PATIENT _WIDTH * M ainFontWid th, lblPtN ame.Width  + (M_WVERT  * 2));
  2688     lblPtSSN .Top        := M_HORI Z + lblPtN ame.Height  + M_MIDDL E;
  2689     lblPtAge .Top        := lblPtS SN.Top;
  2690     lblPtAge .Left       := pnlPat ient.Width  - lblPtAg e.Width -  M_WVERT;
  2691     pnlVisit .Width      := Higher Of(LowerOf (VISIT_WID TH * MainF ontWidth,
  2692                                                HigherOf( lblPtProvi der.Width  + (M_WVERT  * 2),
  2693                                                          lblPtLocat ion.Width  + (M_WVERT  * 2))),
  2694                                       PATIENT _WIDTH * M ainFontWid th);
  2695     lblPtPro vider.Top   := lblPtS SN.Top;
  2696     lblPtAtt ending.Top  := lblPtS SN.Top;
  2697     lblPtMHT C.Top        := M_MID DLE + lblP tSSN.Heigh t + lblPtS SN.Top;
  2698     pnlPosti ngs.Width   := Round( POSTING_WI DTH * Main FontWidth) ;
  2699     if btnCo mbatVet.Vi sible then
  2700      begin
  2701       pnlCVn Flag.Width    := Roun d(CV_WIDTH  * MainFon tWidth);
  2702       pnlFla g.Width       := Roun d(CV_WIDTH  * MainFon tWidth);
  2703       btnCom batVet.Hei ght := Rou nd(pnlCVnF lag.Height  div 2);
  2704      end
  2705     else
  2706      begin
  2707       pnlCVn Flag.Width    := Roun d(FLAG_WID TH * MainF ontWidth);
  2708       pnlFla g.Width       := Roun d(FLAG_WID TH * MainF ontWidth);
  2709      end;
  2710     pnlRemot eData.Widt h := Round (CIRN_WIDT H * MainFo ntWidth) +  M_WVERT;
  2711     pnlVista Web.Height  := pnlRem oteData.He ight div 2 ;
  2712     paVAA.Wi dth         := Round( MHV_WIDTH  * MainFont Width) + M _WVERT + 2 ;
  2713     with lbl PtPostings  do
  2714       SetBou nds(M_WVER T, M_HORIZ , pnlPosti ngs.Width- M_WVERT-M_ WVERT, lbl PtName.Hei ght);
  2715     with lbl PtCWAD      do
  2716       SetBou nds(M_WVER T, lblPtSS N.Top, lbl PtPostings .Width, lb lPtName.He ight);
  2717     //Low re solution h andling: F irst, try  to fit eve rything on  by shrink ing fields
  2718     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
  2719     //if pnl PrimaryCar e.Width <  HigherOf(  lblPtCare. Left + lbl PtCare.Wid th, lblPtA ttending.L eft + lblP tAttending .Width) +  TINY_MARGI N then
  2720     begin
  2721       lblPtA ge.Left :=  lblPtAge. Left - (lb lPtName.Le ft - TINY_ MARGIN);
  2722       lblPtN ame.Left : = TINY_MAR GIN;
  2723       lblPTS SN.Left :=  TINY_MARG IN;
  2724       pnlPat ient.Width  := Higher Of( lblPtN ame.Left +  lblPtName .Width, lb lPtAge.Lef t + lblPtA ge.Width)+  TINY_MARG IN;
  2725       lblPtL ocation.Le ft := TINY _MARGIN;
  2726       lblPtP rovider.Le ft := TINY _MARGIN;
  2727       pnlVis it.Width : = HigherOf ( lblPtLoc ation.Left  + lblPtLo cation.Wid th, lblPtP rovider.Le ft + lblPt Provider.W idth)+ TIN Y_MARGIN;
  2728     end;
  2729     HorzScro llBar.Rang e := 0;
  2730   end;
  2731  
  2732   { Temporar y Calls -- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2733  
  2734   procedure  TfrmFrame. ToggleMenu ItemChecke d(Sender:  TObject);
  2735   begin
  2736     TMenuIte m(Sender). Checked :=  not TMenu Item(Sende r).Checked ;
  2737   end;
  2738  
  2739   {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------}
  2740   {  mnuFocu sChangesCl ick - togg les the Fo cused Cont rols windo w for form s that sup port it  }
  2741   {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------}
  2742   procedure  TfrmFrame. mnuFocusCh angesClick (Sender: T Object);
  2743   begin
  2744     inherite d;
  2745     ShowFocu sedControl Dialog :=  mnuFocusCh anges.Chec ked;
  2746   end;
  2747  
  2748   procedure  TfrmFrame. mnuFontSiz eClick(Sen der: TObje ct);
  2749   begin
  2750     if (frmR emDlg <> n il) then
  2751       ShowMs g('Please  close the  reminder d ialog befo re changin g font siz es.')
  2752     else if  (dlgProbs  <> nil) th en
  2753       ShowMs g('Font si ze cannot  be changed  while add ing or edi ting a pro blem.')
  2754     else beg in
  2755       with ( Sender as  TMenuItem)  do begin
  2756         Togg leMenuItem Checked(Se nder);
  2757         fMed s.oldFont  := MainFon tSize; //C Q9182
  2758         Chan geFont(Tag );
  2759       end;
  2760     end;
  2761   end;
  2762  
  2763   procedure  TfrmFrame. mnuEditCli ck(Sender:  TObject);
  2764   var
  2765     IsReadOn ly: Boolea n;
  2766   begin
  2767     FEditCtr l := nil;
  2768     if Scree n.ActiveCo ntrol is T CustomEdit  then FEdi tCtrl := T CustomEdit (Screen.Ac tiveContro l);
  2769     if FEdit Ctrl <> ni l then beg in
  2770       if       FEditCtr l is TMemo      then  IsReadOnly  := TMemo( FEditCtrl) .ReadOnly
  2771       else i f FEditCtr l is TEdit      then  IsReadOnly  := TEdit( FEditCtrl) .ReadOnly
  2772       else i f FEditCtr l is TRich Edit then  IsReadOnly  := TRichE dit(FEditC trl).ReadO nly
  2773       else I sReadOnly  := True;
  2774  
  2775       mnuEdi tRedo.Enab led := FEd itCtrl.Per form(EM_CA NREDO, 0,  0) <> 0;
  2776       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);
  2777  
  2778       mnuEdi tCut.Enabl ed := FEdi tCtrl.SelL ength > 0;
  2779       mnuEdi tCopy.Enab led := mnu EditCut.En abled;
  2780       mnuEdi tPaste.Ena bled := (I sReadOnly  = False) a nd Clipboa rd.HasForm at(CF_TEXT );
  2781     end else  begin
  2782       mnuEdi tUndo.Enab led  := Fa lse;
  2783       mnuEdi tCut.Enabl ed   := Fa lse;
  2784       mnuEdi tCopy.Enab led  := Fa lse;
  2785       mnuEdi tPaste.Ena bled := Fa lse;
  2786     end;
  2787   end;
  2788  
  2789   procedure  TfrmFrame. mnuEditUnd oClick(Sen der: TObje ct);
  2790   begin
  2791     FEditCtr l.Perform( EM_UNDO, 0 , 0);
  2792   end;
  2793  
  2794   procedure  TfrmFrame. mnuEditRed oClick(Sen der: TObje ct);
  2795   begin
  2796     FEditCtr l.Perform( EM_REDO, 0 , 0);
  2797   end;
  2798  
  2799  
  2800   procedure  TfrmFrame. mnuEditCut Click(Send er: TObjec t);
  2801   begin
  2802     FEditCtr l.CutToCli pboard;
  2803   end;
  2804  
  2805   procedure  TfrmFrame. mnuEditCop yClick(Sen der: TObje ct);
  2806   begin
  2807     FEditCtr l.CopyToCl ipboard;
  2808   end;
  2809  
  2810   procedure  TfrmFrame. mnuEditPas teClick(Se nder: TObj ect);
  2811   begin
  2812     FEditCtr l.PasteFro mClipboard ;  // use  AsText to  prevent fo rmatting f rom being  pasted
  2813   end;
  2814  
  2815   procedure  TfrmFrame. mnuFilePri ntClick(Se nder: TObj ect);
  2816   begin
  2817     case mnu FilePrint. Tag of
  2818     CT_NOTES :    frmNo tes.Reques tPrint;
  2819     CT_CONSU LTS: frmCo nsults.Req uestPrint;
  2820     CT_DCSUM M:   frmDC Summ.Reque stPrint;
  2821     CT_REPOR TS:  frmRe ports.Requ estPrint;
  2822     CT_LABS:      frmLa bs.Request Print;
  2823     CT_ORDER S:   frmOr ders.Reque stPrint;
  2824     CT_PROBL EMS: frmPr oblems.Req uestPrint;
  2825     CT_SURGE RY:  if As signed(frm Surgery) t hen frmSur gery.Reque stPrint;
  2826     end;
  2827   end;
  2828  
  2829   procedure  TfrmFrame. WMSysComma nd(var Mes sage: TMes sage);
  2830   begin
  2831     case Tab ToPageID(t abPage.Tab Index) of
  2832       CT_NOT ES:
  2833           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then
  2834              with Messa ge do
  2835                begin
  2836                  SendMe ssage(frmN otes.Handl e, Msg, WP aram, LPar am);
  2837                  Result  := 0;
  2838                end
  2839           el se
  2840              inherited;
  2841       CT_DCS UMM:
  2842           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboAttendi ng') then
  2843              with Messa ge do
  2844                begin
  2845                  SendMe ssage(frmD CSumm.Hand le, Msg, W Param, lPa ram);
  2846                  Result  := 0;
  2847                end
  2848           el se
  2849              inherited;
  2850       CT_CON SULTS:
  2851           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then
  2852              with Messa ge do
  2853                begin
  2854                  SendMe ssage(frmC onsults.Ha ndle, Msg,  WParam, l Param);
  2855                  Result  := 0;
  2856                end
  2857           el se
  2858              inherited;
  2859     else
  2860       inheri ted;
  2861     end;
  2862     if Messa ge.WParam  = SC_MAXIM IZE then
  2863     begin
  2864       // for m becomes  maximized;
  2865       frmOrd ers.mnuOpt imizeField sClick(sel f);
  2866       frmPro blems.mnuO ptimizeFie ldsClick(s elf);
  2867       frmMed s.mnuOptim izeFieldsC lick(self) ;
  2868     end
  2869     else if  Message.WP aram = SC_ MINIMIZE t hen
  2870     begin
  2871       // for m becomes  maximized;
  2872     end
  2873     else if  Message.WP aram = SC_ RESTORE th en
  2874     begin
  2875       // for m is resto red (from  maximized) ;
  2876       frmOrd ers.mnuOpt imizeField sClick(sel f);
  2877       frmPro blems.mnuO ptimizeFie ldsClick(s elf);
  2878       frmMed s.mnuOptim izeFieldsC lick(self) ;
  2879     end;
  2880   end;
  2881  
  2882   procedure  TfrmFrame. RemindersC hanged(Sen der: TObje ct);
  2883   var
  2884     ImgName:  string;
  2885   begin
  2886     pnlRemin ders.tag : = HAVE_REM INDERS;
  2887     pnlRemin ders.Hint  := 'Click  to display  reminders ';
  2888     case Get ReminderSt atus of
  2889       rsUnkn own:
  2890         begi n
  2891           Im gName := ' BMP_REMIND ERS_UNKNOW N';
  2892           pn lReminders .Caption : = 'Reminde rs';
  2893         end;
  2894       rsDue:
  2895         begi n
  2896           Im gName := ' BMP_REMIND ERS_DUE';
  2897           pn lReminders .Caption : = 'Due Rem inders';
  2898         end;
  2899       rsAppl icable:
  2900         begi n
  2901           Im gName := ' BMP_REMIND ERS_APPLIC ABLE';
  2902           pn lReminders .Caption : = 'Applica ble Remind ers';
  2903         end;
  2904       rsNotA pplicable:
  2905         begi n
  2906           Im gName := ' BMP_REMIND ERS_OTHER' ;
  2907           pn lReminders .Caption : = 'Other R eminders';
  2908         end;
  2909       else
  2910         begi n
  2911           Im gName := ' BMP_REMIND ERS_NONE';
  2912           pn lReminders .Hint := ' There are  currently  no reminde rs availab le';
  2913           pn lReminders .Caption : = pnlRemin ders.Hint;
  2914           pn lReminders .tag := NO _REMINDERS ;
  2915         end;
  2916     end;
  2917     if(Remin dersEvalua tingInBack ground) th en
  2918     begin
  2919       if(anm tRemSearch .ResName =  '') then
  2920       begin
  2921         TORE xposedAnim ate(anmtRe mSearch).O nMouseDown  := pnlRem indersMous eDown;
  2922         TORE xposedAnim ate(anmtRe mSearch).O nMouseUp    := pnlRem indersMous eUp;
  2923         anmt RemSearch. ResHandle  := 0;
  2924         anmt RemSearch. ResName :=  'REMSEARC HAVI';
  2925       end;
  2926       imgRem inder.Visi ble := FAL SE;
  2927       anmtRe mSearch.Ac tive := TR UE;
  2928       anmtRe mSearch.Vi sible := T RUE;
  2929       if(pnl Reminders. Hint <> '' ) then
  2930         pnlR eminders.H int := CRL F + pnlRem inders.Hin t + '.';
  2931       pnlRem inders.Hin t := 'Eval uating Rem inders...   ' + pnlRe minders.Hi nt;
  2932       pnlRem inders.Cap tion := pn lReminders .Hint;
  2933     end
  2934     else
  2935     begin
  2936       anmtRe mSearch.Vi sible := F ALSE;
  2937       imgRem inder.Visi ble := TRU E;
  2938       imgRem inder.Pict ure.Bitmap .LoadFromR esourceNam e(hInstanc e, ImgName );
  2939       anmtRe mSearch.Ac tive := FA LSE;
  2940     end;
  2941     mnuViewR eminders.E nabled :=  (pnlRemind ers.tag =  HAVE_REMIN DERS);
  2942   end;
  2943  
  2944   procedure  TfrmFrame. pnlReminde rsMouseDow n(Sender:  TObject;
  2945     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2946   begin
  2947     if(not I nitialRemi ndersLoade d) then
  2948       Startu pReminders ;
  2949     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  2950       pnlRem inders.Bev elOuter :=  bvLowered ;
  2951   end;
  2952  
  2953   procedure  TfrmFrame. pnlReminde rsMouseUp( Sender: TO bject;
  2954     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2955   begin
  2956     pnlRemin ders.Bevel Outer := b vRaised;
  2957     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  2958       ViewIn fo(mnuView Reminders) ;
  2959   end;
  2960  
  2961   //-------- ---------- --- CIRN-r elated pro cedures -- ---------- ---------- ----------
  2962  
  2963   procedure  TfrmFrame. SetUpCIRN;
  2964   var
  2965     i: integ er;
  2966     iNwHIN,  iRDVOnly:  integer;
  2967     aAutoQue ry,aVistaW ebLabel: s tring;
  2968     ASite: T RemoteSite ;
  2969     item: TV A508Access ibilityIte m;
  2970     id: inte ger;
  2971   begin
  2972     uUseVist aWeb := fa lse;
  2973     with Rem oteSites d o
  2974     begin
  2975       Change Patient(Pa tient.DFN) ;
  2976       lblCIR N.Caption  := ' Remot e Data';
  2977       lblCIR N.Alignmen t := taCen ter;
  2978       aVista WebLabel : = GetVista Web_JLV_La belName;
  2979       if aVi staWebLabe l = '' the n aVistaWe bLabel :=  'VistaWeb' ;
  2980       lblVis taWeb.Capt ion := aVi staWebLabe l;
  2981       pnlVis taWeb.Beve lOuter :=  bvRaised;
  2982       iNwHIN  := 0;
  2983       iRDVOn ly := 0;
  2984       for i  := 0 to Re moteSites. Count - 1  do
  2985         begi n
  2986           if  not(LeftS tr(TRemote Site(Remot eSites.Sit eList.Item s[i]).Site ID, 4) = ' 200N') the n
  2987              begin
  2988                iRDVOnly  := 1;
  2989                continue ;
  2990              end
  2991           el se
  2992              iNwHIN :=  1;
  2993         end;
  2994  
  2995       if Rem oteDataExi sts and (( iRDVOnly =  1) or (iN wHIN = 1))  and (Remo teSites.Co unt > 0) t hen
  2996         begi n
  2997           if  ScreenRea derSystemA ctive then
  2998           be gin
  2999            i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData,  False);
  3000            i d:= item.I NDEX;
  3001            a mgrMain.Ac cessData[i d].AccessT ext := '';
  3002           en d;
  3003           lb lCIRN.Enab led     :=  True;
  3004           pn lCIRN.TabS top     :=  True;
  3005           lb lCIRN.Font .Color  :=  Get508Com pliantColo r(clBlue);
  3006           ls tCIRNLocat ions.Font. Color  :=  Get508Comp liantColor (clBlue);
  3007           lb lCIRN.Capt ion := 'Re mote Data' ;
  3008           pn lCIRN.Hint  := 'Click  to displa y other fa cilities h aving data  for this  patient.';
  3009           lb lVistaWeb. Font.Color  := Get508 CompliantC olor(clBlu e);
  3010           pn lVistaWeb. Hint := 'C lick to go  to ' + aV istaWebLab el + ' to  see data f rom other  facilities  for this  patient.';
  3011           if  RemoteSit es.Count >  0 then
  3012              lstCIRNLoc ations.Ite ms.Add('0'  + U + 'Al l Availabl e Sites');
  3013           fo r i := 0 t o RemoteSi tes.Count  - 1 do
  3014              begin
  3015                ASite :=  TRemoteSi te(SiteLis t[i]);
  3016                lstCIRNL ocations.I tems.Add(A Site.SiteI D + U + AS ite.SiteNa me + U +
  3017                  Format FMDateTime ('mmm dd y yyy hh:nn' , ASite.La stDate));
  3018              end;
  3019         end
  3020       else
  3021         begi n
  3022           if  ScreenRea derSystemA ctive then
  3023           be gin
  3024            i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData,  False);
  3025            i d:= item.I NDEX;
  3026            a mgrMain.Ac cessData[i d].AccessT ext := 'No  remote da ta availab le';
  3027           en d;
  3028           lb lCIRN.Font .Color  :=  clWindowT ext;
  3029           lb lVistaWeb. Font.Color  := clWind owText;
  3030           lb lCIRN.Enab led     :=  False;
  3031           pn lCIRN.TabS top     :=  False;
  3032           pn lCIRN.Hint  := NoData Reason;
  3033           if  (iNwHIN =  1) and (i RDVOnly =  0) then
  3034              begin
  3035               lblVistaW eb.Font.Co lor := Get 508Complia ntColor(cl Blue);
  3036               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).';
  3037              end;
  3038         end;
  3039       aAutoQ uery := Au toRDV;         //Chec k to see i f Remote Q ueries sho uld be use d for all  available  sites
  3040       if (aA utoQuery =  '1') and  (lstCIRNLo cations.Co unt > 0) t hen
  3041         begi n
  3042           ls tCIRNLocat ions.ItemI ndex := 1;
  3043           ls tCIRNLocat ions.Check ed[1] := t rue;
  3044           ls tCIRNLocat ionsClick( self);
  3045         end;
  3046     end;
  3047   end;
  3048  
  3049   procedure  TfrmFrame. pnlCIRNCli ck(Sender:  TObject);
  3050   begin
  3051     ViewInfo (mnuViewRe moteData);
  3052   end;
  3053  
  3054   procedure  TfrmFrame. lstCIRNLoc ationsClic k(Sender:  TObject);
  3055   var
  3056     iIndex,j ,iAll,iCur : integer;
  3057     aMsg,s:  string;
  3058     AccessSt atus: inte ger;
  3059   begin
  3060     iAll :=  1;
  3061     AccessSt atus := 0;
  3062     iIndex : = lstCIRNL ocations.I temIndex;
  3063     if not C heckHL7TCP Link then
  3064       begin
  3065         Info Box('Local  HL7 TCP L ink is dow n.' + CRLF  + 'Unable  to retrie ve remote  data.', TC _DGSR_ERR,  MB_OK);
  3066         lstC IRNLocatio ns.Checked [iIndex] : = false;
  3067         Exit ;
  3068       end;
  3069     if lstCI RNLocation s.Items.Co unt > 1 th en
  3070       if pie ce(lstCIRN Locations. Items[1],' ^',1) = '0 ' then
  3071         iAll  := 2;
  3072     with frm Reports do
  3073       if pie ce(uRemote Type,'^',2 ) = 'V' th en
  3074         begi n
  3075           lv Reports.It ems.BeginU pdate;
  3076           lv Reports.It ems.Clear;
  3077           lv Reports.Co lumns.Clea r;
  3078           lv Reports.It ems.EndUpd ate;
  3079         end;
  3080     uReportI nstruction  := '';
  3081     frmRepor ts.TabCont rol1.Tabs. Clear;
  3082     frmLabs. TabControl 1.Tabs.Cle ar;
  3083     frmRepor ts.TabCont rol1.Tabs. AddObject( 'Local',ni l);
  3084     frmLabs. TabControl 1.Tabs.Add Object('Lo cal',nil);
  3085     StatusTe xt('Checki ng Remote  Sites...') ;
  3086     if piece (lstCIRNLo cations.It ems[iIndex ],'^',1) =  '0' then  // All sit es have be en clicked
  3087       if lst CIRNLocati ons.Checke d[iIndex]  = false th en // All  selection  is being t urned off
  3088         begi n
  3089           wi th RemoteS ites.SiteL ist do
  3090           fo r j := 0 t o Count -  1 do
  3091              if lstCIRN Locations. Checked[j+ 1] = true  then
  3092                begin
  3093                  lstCIR NLocations .Checked[j +1] := fal se;
  3094                  TRemot eSite(Remo teSites.Si teList[j]) .Selected  := false;
  3095                  TRemot eSite(Remo teSites.Si teList[j]) .ReportCle ar;
  3096                  TRemot eSite(Remo teSites.Si teList[j]) .LabClear;
  3097                end;
  3098         end
  3099       else
  3100         begi n
  3101           wi th RemoteS ites.SiteL ist do
  3102           fo r j := 0 t o Count -  1 do
  3103                begin
  3104                  Screen .Cursor :=  crHourGla ss;
  3105                  Screen .Cursor :=  crDefault ;
  3106                  aMsg : = aMsg + '  at site:  ' + TRemot eSite(Item s[j]).Site Name;
  3107                  s := l stCIRNLoca tions.Item s[j+1];
  3108                  lstCIR NLocations .Items[j+1 ] := piece s(s, '^',  1, 3);
  3109                  case A ccessStatu s of
  3110                  DGSR_F AIL: begin
  3111                                if  piece(aMsg ,':',1) =  'RPC name  not found  at site' t hen //Allo w for back ward compa tibility
  3112                                  b egin
  3113                                     lstCIRNLo cations.Ch ecked[j+1]  := true;
  3114                                     TRemoteSi te(RemoteS ites.SiteL ist[j]).Re portClear;
  3115                                     TRemoteSi te(RemoteS ites.SiteL ist[j]).La bClear;
  3116                                     TRemoteSi te(Items[j ]).Selecte d := true;
  3117                                  e nd
  3118                                els e
  3119                                  b egin
  3120                                     InfoBox(a Msg, TC_DG SR_ERR, MB _OK);
  3121                                     lstCIRNLo cations.Ch ecked[j+1]  := false;
  3122                                     lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1,  3) + '^' +  TC_DGSR_E RR;
  3123                                     TRemoteSi te(Items[j ]).Selecte d := false ;
  3124                                     Continue;
  3125                                  e nd;
  3126                              end;
  3127                  DGSR_N ONE: begin
  3128                                lst CIRNLocati ons.Checke d[j+1] :=  true;
  3129                                TRe moteSite(R emoteSites .SiteList[ j]).Report Clear;
  3130                                TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar;
  3131                                TRe moteSite(I tems[j]).S elected :=  true;
  3132                              end;
  3133                  DGSR_S HOW: begin
  3134                                Inf oBox(AMsg,  TC_DGSR_S HOW, MB_OK );
  3135                                lst CIRNLocati ons.Checke d[j+1] :=  true;
  3136                                TRe moteSite(R emoteSites .SiteList[ j]).Report Clear;
  3137                                TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar;
  3138                                TRe moteSite(I tems[j]).S elected :=  true;
  3139                              end;
  3140                  DGSR_A SK:  if In foBox(AMsg  + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO  or MB_ICO NWARNING o r
  3141                                MB_ DEFBUTTON2 ) = IDYES  then
  3142                                beg in
  3143                                  l stCIRNLoca tions.Chec ked[j+1] : = true;
  3144                                  T RemoteSite (RemoteSit es.SiteLis t[j]).Repo rtClear;
  3145                                  T RemoteSite (RemoteSit es.SiteLis t[j]).LabC lear;
  3146                                  T RemoteSite (Items[j]) .Selected  := true;
  3147                                end
  3148                                els e
  3149                                  b egin
  3150                                     lstCIRNLo cations.Ch ecked[j+1]  := false;
  3151                                     lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1,  3) + '^' +  TC_DGSR_S HOW;
  3152                                     TRemoteSi te(Items[j ]).Selecte d := false ;
  3153                                     Continue;
  3154                                  e nd;
  3155                  else        begin
  3156                                Inf oBox(AMsg,  TC_DGSR_D ENY, MB_OK );
  3157                                lst CIRNLocati ons.Checke d[j+1] :=  false;
  3158                                lst CIRNLocati ons.Items[ j+1] := pi eces(s, '^ ', 1, 3) +  '^' + TC_ DGSR_DENY;
  3159                                TRe moteSite(I tems[j]).S elected :=  false;
  3160                                Con tinue;
  3161                              end;
  3162                  end;
  3163                end;
  3164         end
  3165     else
  3166       begin
  3167         if i Index > 0  then
  3168           be gin
  3169              iCur := iI ndex - iAl l;
  3170              TRemoteSit e(RemoteSi tes.SiteLi st[iCur]). Selected : =
  3171                lstCIRNL ocations.C hecked[iIn dex];
  3172              if lstCIRN Locations. Checked[iI ndex] = tr ue then
  3173                with Rem oteSites.S iteList do
  3174                begin
  3175                  Screen .Cursor :=  crHourGla ss;
  3176                  Screen .Cursor :=  crDefault ;
  3177                  aMsg : = aMsg + '  at site:  ' + TRemot eSite(Item s[iCur]).S iteName;
  3178                  s := l stCIRNLoca tions.Item s[iIndex];
  3179                  lstCIR NLocations .Items[iIn dex] := pi eces(s, '^ ', 1, 3);
  3180                  case A ccessStatu s of
  3181                  DGSR_F AIL: begin
  3182                                if  piece(aMsg ,':',1) =  'RPC name  not found  at site' t hen //Allo w for back ward compa tibility
  3183                                  b egin
  3184                                     lstCIRNLo cations.Ch ecked[iInd ex] := tru e;
  3185                                     TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .ReportCle ar;
  3186                                     TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .LabClear;
  3187                                     TRemoteSi te(Items[i Cur]).Sele cted := tr ue;
  3188                                  e nd
  3189                                els e
  3190                                  b egin
  3191                                     InfoBox(a Msg, TC_DG SR_ERR, MB _OK);
  3192                                     lstCIRNLo cations.Ch ecked[iInd ex] := fal se;
  3193                                     lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^',  1, 3) + '^ ' + TC_DGS R_ERR;
  3194                                     TRemoteSi te(Items[i Cur]).Sele cted := fa lse;
  3195                                  e nd;
  3196                              end;
  3197                  DGSR_N ONE: begin
  3198                                lst CIRNLocati ons.Checke d[iIndex]  := true;
  3199                                TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear;
  3200                                TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear;
  3201                                TRe moteSite(I tems[iCur] ).Selected  := true;
  3202                              end;
  3203                  DGSR_S HOW: begin
  3204                                Inf oBox(AMsg,  TC_DGSR_S HOW, MB_OK );
  3205                                lst CIRNLocati ons.Checke d[iIndex]  := true;
  3206                                TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear;
  3207                                TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear;
  3208                                TRe moteSite(I tems[iCur] ).Selected  := true;
  3209                              end;
  3210                  DGSR_A SK:  if In foBox(AMsg  + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO  or MB_ICO NWARNING o r
  3211                                MB_ DEFBUTTON2 ) = IDYES  then
  3212                                beg in
  3213                                  l stCIRNLoca tions.Chec ked[iIndex ] := true;
  3214                                  T RemoteSite (RemoteSit es.SiteLis t[iCur]).R eportClear ;
  3215                                  T RemoteSite (RemoteSit es.SiteLis t[iCur]).L abClear;
  3216                                  T RemoteSite (Items[iCu r]).Select ed := true ;
  3217                                end
  3218                                els e
  3219                                  b egin
  3220                                     lstCIRNLo cations.Ch ecked[iInd ex] := fal se;
  3221                                     lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^',  1, 3) + '^ ' + TC_DGS R_SHOW;
  3222                                  e nd;
  3223                  else        begin
  3224                                Inf oBox(AMsg,  TC_DGSR_D ENY, MB_OK );
  3225                                lst CIRNLocati ons.Checke d[iIndex]  := false;
  3226                                lst CIRNLocati ons.Items[ iIndex] :=  pieces(s,  '^', 1, 3 ) + '^' +  TC_DGSR_DE NY;
  3227                                TRe moteSite(I tems[iCur] ).Selected  := false;
  3228                              end;
  3229                  end;
  3230                  with f rmReports  do
  3231                    if p iece(uRemo teType,'^' ,1) = '1'  then
  3232                      if  not(piece (uRemoteTy pe,'^',2)  = 'V') the n
  3233                         begin
  3234                           TabContr ol1.Visibl e := true;
  3235                           pnlRight Top.Height  := lblTit le.Height  + TabContr ol1.Height ;
  3236                         end;
  3237                  with f rmLabs do
  3238                    if p iece(uRemo teType,'^' ,1) = '1'  then
  3239                      if  not(piece (uRemoteTy pe,'^',2)  = 'V') the n
  3240                         begin
  3241                           TabContr ol1.Visibl e := true;
  3242                           pnlRight Top.Height  := lblTit le.Height  + TabContr ol1.Height ;
  3243                         end;
  3244                end;
  3245           en d;
  3246       end;
  3247     with Rem oteSites.S iteList do
  3248       for j  := 0 to Co unt - 1 do
  3249         if T RemoteSite (Items[j]) .Selected
  3250           an d (not(Lef tStr(TRemo teSite(Ite ms[j]).Sit eID ,4) =  '200N'))   then
  3251           be gin
  3252              frmReports .TabContro l1.Tabs.Ad dObject(TR emoteSite( Items[j]). SiteName,
  3253                TRemoteS ite(Items[ j]));
  3254              frmLabs.Ta bControl1. Tabs.AddOb ject(TRemo teSite(Ite ms[j]).Sit eName,
  3255                TRemoteS ite(Items[ j]));
  3256           en d;
  3257     if not(P iece(uRepo rtID,':',1 ) = 'OR_VW AL')
  3258       and no t(Piece(uR eportID,': ',1) = 'OR _VWRX')
  3259       and no t(Piece(uR eportID,': ',1) = 'OR _VWVS')
  3260       and (f rmReports. tvReports. SelectionC ount > 0)  then frmRe ports.tvRe portsClick (self);
  3261     if not(u LabRepID =  '6:GRAPH' ) and not( uLabRepID  = '5:WORKS HEET')
  3262       and no t(uLabRepI D = '4:SEL ECTED TEST S BY DATE' )
  3263       and (f rmLabs.tvR eports.Sel ectionCoun t > 0) the n frmLabs. tvReportsC lick(self) ;
  3264     StatusTe xt('');
  3265   end;
  3266  
  3267   procedure  TfrmFrame. popCIRNClo seClick(Se nder: TObj ect);
  3268   begin
  3269     lstCIRNL ocations.V isible :=  False;
  3270     lstCirnL ocations.S endToBack;
  3271     pnlCIRN. BevelOuter  := bvRais ed;
  3272   end;
  3273  
  3274   procedure  TfrmFrame. popCIRNSel ectAllClic k(Sender:  TObject);
  3275  
  3276   begin
  3277     lstCIRNL ocations.I temIndex : = 0;
  3278     lstCIRNL ocations.C hecked[0]  := true;
  3279     lstCIRNL ocations.O nClick(Sel f);
  3280   end;
  3281  
  3282   procedure  TfrmFrame. popCIRNSel ectNoneCli ck(Sender:  TObject);
  3283  
  3284   begin
  3285     lstCIRNL ocations.I temIndex : = 0;
  3286     lstCIRNL ocations.C hecked[0]  := false;
  3287     lstCIRNL ocations.O nClick(Sel f);
  3288   end;
  3289  
  3290   procedure  TfrmFrame. mnuFilePri ntSetupCli ck(Sender:  TObject);
  3291   var
  3292     CurrPrt:  string;
  3293   begin
  3294     CurrPrt  := SelectD evice(Self , Encounte r.Location , True, 'P rint Devic e Selectio n');
  3295     User.Cur rentPrinte r := Piece (CurrPrt,  U, 1);
  3296   end;
  3297  
  3298   procedure  TfrmFrame. LabInfo1Cl ick(Sender : TObject) ;
  3299   begin
  3300     ExecuteL abInfo;
  3301   end;
  3302  
  3303   procedure  TfrmFrame. mnuFileNot ifRemoveCl ick(Sender : TObject) ;
  3304   const
  3305     TC_REMOV E_ALERT  =  'Remove C urrent Ale rt';
  3306     TX_REMOV E_ALERT1 =  'This act ion will d elete the  alert you  are curren tly proces sing; the  alert will  ' + CRLF  +
  3307           'd isappear a utomatical ly when al l orders h ave been a cted on, b ut this ac tion may'  + CRLF +
  3308           'b e used to  remove the  alert if  some order s are to b e left unc hanged.' +  CRLF + CR LF +
  3309           'Y our ';
  3310     TX_REMOV E_ALERT2 =  ' alert f or ';
  3311     TX_REMOV E_ALERT3 =  ' will be  deleted!'  + CRLF +  CRLF + 'Ar e you sure ?';
  3312   var
  3313     AlertMsg , AlertTyp e: string;
  3314  
  3315     procedur e StopProc essingNoti fs;
  3316       begin
  3317         Noti fications. Clear;
  3318         FNex tButtonAct ive := Fal se;
  3319         stsA rea.Panels [2].Bevel  := pbLower ed;
  3320         mnuF ileNext.En abled := F alse;
  3321         mnuF ileNotifRe move.Enabl ed := Fals e;
  3322       end;
  3323  
  3324   begin
  3325     if not N otificatio ns.Active  then Exit;
  3326     case Not ifications .Followup  of
  3327       NF_MED ICATIONS_E XPIRING_IN PT    : Al ertType :=  'Expiring  Medicatio ns';
  3328       NF_MED ICATIONS_E XPIRING_OU TPT   : Al ertType :=  'Expiring  Medicatio ns';
  3329       NF_ORD ER_REQUIRE S_ELEC_SIG NATURE: Al ertType :=  'Unsigned  Orders';
  3330       NF_FLA GGED_ORDER S                : Al ertType :=  'Flagged  Orders (fo r clarific ation)';
  3331       NF_UNV ERIFIED_ME DICATION_O RDER  : Al ertType :=  'Unverifi ed Medicat ion Order' ;
  3332       NF_UNV ERIFIED_OR DER              : Al ertType :=  'Unverifi ed Order';
  3333       NF_FLA GGED_OI_EX P_INPT           : Al ertType :=  'Flagged  Orderable  Item (INPT )';
  3334       NF_FLA GGED_OI_EX P_OUTPT          : Al ertType :=  'Flagged  Orderable  Item (OUTP T)';
  3335     else
  3336       Exit;
  3337     end;
  3338     AlertMsg  := TX_REM OVE_ALERT1  + AlertTy pe + TX_RE MOVE_ALERT 2 + Patien t.Name + T X_REMOVE_A LERT3;
  3339     if InfoB ox(AlertMs g, TC_REMO VE_ALERT,  MB_YESNO)  = ID_YES t hen
  3340       begin
  3341         Noti fications. DeleteForC urrentUser ;
  3342         Noti fications. Next;   //  avoid pro mpt if no  more alert s selected  to proces s  {v14a R V}
  3343         if N otificatio ns.Active  then
  3344           be gin
  3345              if (InfoBo x(TX_NOTIF _STOP, TC_ NOTIF_STOP , MB_YESNO ) = ID_NO)  then
  3346                begin
  3347                  Notifi cations.Pr ior;
  3348                  mnuFil eNextClick (Self);
  3349                end
  3350              else
  3351                StopProc essingNoti fs;
  3352           en d
  3353         else
  3354           St opProcessi ngNotifs;
  3355       end;
  3356   end;
  3357  
  3358   procedure  TfrmFrame. mnuToolsOp tionsClick (Sender: T Object);
  3359   // persona l preferen ces - chan ges may ne ed to be a pplied to  chart
  3360   var
  3361     i: integ er;
  3362   begin
  3363     i := 0;
  3364     DialogOp tions(i);
  3365   end;
  3366  
  3367   procedure  TfrmFrame. LoadUserPr eferences;
  3368   begin
  3369     LoadSize sForUser;
  3370     GetUserT emplateDef aults(TRUE );
  3371   end;
  3372  
  3373   procedure  TfrmFrame. SaveUserPr eferences;
  3374   begin
  3375     SaveSize sForUser;          //  position  & size set tings
  3376     SaveUser TemplateDe faults;
  3377   end;
  3378  
  3379   procedure  TfrmFrame. mnuFileRef reshClick( Sender: TO bject);
  3380   begin
  3381     FRefresh ing := TRU E;
  3382     try
  3383       mnuFil eOpenClick (Self);
  3384     finally
  3385       FRefre shing := F ALSE;
  3386       OrderP rintForm : = FALSE;
  3387     end;
  3388   end;
  3389  
  3390   procedure  TfrmFrame. AppActivat ed(Sender:  TObject);
  3391   begin
  3392     if assig ned(FOldAc tivate) th en
  3393       FOldAc tivate(Sen der);
  3394     SetActiv eWindow(Ap plication. Handle);
  3395     if Scree nReaderSys temActive  and assign ed(Patient ) and (Pat ient.Name  <> '') and  (Patient. Status <>  '') then
  3396         Spea kTabAndPat ient;
  3397   end;
  3398  
  3399   // close T reatment F actor hint  window if  alt-tab p ressed.
  3400   procedure  TfrmFrame. AppDeActiv ated(Sende r: TObject );
  3401   begin
  3402     if FRVTF hintWindow Active the n
  3403     begin
  3404        FRVTF HintWindow .ReleaseHa ndle;
  3405        FRVTF HintWindow Active :=  False;
  3406     end
  3407     else
  3408     if FOSTF HintWndAct ive then
  3409     begin
  3410        FOSTF hintWindow .ReleaseHa ndle;
  3411        FOSTF HintWndAct ive := Fal se ;
  3412     end;
  3413     if FHint WinActive  then   //  graphing -  hints on  values
  3414     begin
  3415       FHintW in.Release Handle;
  3416       FHintW inActive : = false;
  3417     end;
  3418   end;
  3419  
  3420  
  3421   procedure  TfrmFrame. CreateTab( ATabID: in teger; ALa bel: strin g);
  3422   begin
  3423     //  old  comment -  try making  owner sel f (instead  of applic ation) to  see if sol ves TMenuI tem.Insert  bug
  3424     case ATa bID of
  3425       CT_PRO BLEMS : be gin
  3426                         frmProblem s := TfrmP roblems.Cr eate(Self) ;
  3427                         frmProblem s.Parent : = pnlPage;
  3428                      en d;
  3429       CT_MED S     : be gin
  3430                         frmMeds :=  TfrmMeds. Create(Sel f);
  3431                         frmMeds.Pa rent := pn lPage;
  3432                         frmMeds.In itfMedsSiz e;
  3433                      en d;
  3434       CT_ORD ERS   : be gin
  3435                         frmOrders  := TfrmOrd ers.Create (Self);
  3436                         frmOrders. Parent :=  pnlPage;
  3437                      en d;
  3438       CT_HP        : be gin
  3439                         // not yet
  3440                      en d;
  3441       CT_NOT ES    : be gin
  3442                         frmNotes : = TfrmNote s.Create(S elf);
  3443                         frmNotes.P arent := p nlPage;
  3444                      en d;
  3445       CT_CON SULTS : be gin
  3446                         frmConsult s := TfrmC onsults.Cr eate(Self) ;
  3447                         frmConsult s.Parent : = pnlPage;
  3448                      en d;
  3449       CT_DCS UMM   : be gin
  3450                         frmDCSumm  := TfrmDCS umm.Create (Self);
  3451                         frmDCSumm. Parent :=  pnlPage;
  3452                      en d;
  3453       CT_LAB S     : be gin
  3454                         frmLabs :=  TfrmLabs. Create(Sel f);
  3455                         frmLabs.Pa rent := pn lPage;
  3456                      en d;
  3457       CT_REP ORTS  : be gin
  3458                         frmReports  := TfrmRe ports.Crea te(Self);
  3459                         frmReports .Parent :=  pnlPage;
  3460                      en d;
  3461       CT_SUR GERY  : be gin
  3462                         frmSurgery  := TfrmSu rgery.Crea te(Self);
  3463                         frmSurgery .Parent :=  pnlPage;
  3464                      en d;
  3465       CT_COV ER    : be gin
  3466                         frmCover : = TfrmCove r.Create(S elf);
  3467                         frmCover.P arent := p nlPage;
  3468                      en d;
  3469     else
  3470       Exit;
  3471     end;
  3472     if ATabI D = CT_COV ER then
  3473       begin
  3474         uTab List.Inser t(0, IntTo Str(ATabID ));
  3475         tabP age.Tabs.I nsert(0, A Label);
  3476         tabP age.TabInd ex := 0;
  3477       end
  3478     else
  3479       begin
  3480         uTab List.Add(I ntToStr(AT abID));
  3481         tabP age.Tabs.A dd(ALabel) ;
  3482       end;
  3483   end;
  3484  
  3485   procedure  TfrmFrame. ShowHideCh artTabMenu s(AMenuIte m: TMenuIt em);
  3486   var
  3487     i: integ er;
  3488   begin
  3489     for i :=  0 to AMen uItem.Coun t - 1 do
  3490       AMenuI tem.Items[ i].Visible  := TabExi sts(AMenuI tem.Items[ i].Tag);
  3491   end;
  3492  
  3493   function T frmFrame.T abExists(A TabID: int eger): boo lean;
  3494   begin
  3495     Result : = (uTabLis t.IndexOf( IntToStr(A TabID)) >  -1)
  3496   end;
  3497  
  3498   procedure  TfrmFrame. ReportsOnl yDisplay;
  3499   begin
  3500     // Confi gure "Edit " menu:
  3501     menuHide AllBut(mnu Edit, mnuE ditPref);      // Hid e everythi ng under E dit menu e xcept Pref erences.
  3502     menuHide AllBut(mnu EditPref,  Prefs1); / / Hide eve rything un der Prefer ences menu  except Fo nts.
  3503  
  3504     // Remai ning pull- down menus :
  3505     mnuView. visible :=  false;
  3506     mnuFileR efresh.vis ible := fa lse;
  3507     mnuFileE ncounter.v isible :=  false;
  3508     mnuFileR eview.visi ble := fal se;
  3509     mnuFileN ext.visibl e := false ;
  3510     mnuFileN otifRemove .visible : = false;
  3511     mnuHelpB roker.visi ble := fal se;
  3512     mnuHelpL ists.visib le := fals e;
  3513     mnuHelpS ymbols.vis ible := fa lse;
  3514  
  3515     // Top p anel compo nents:
  3516     pnlVisit .hint := ' Provider/L ocation';
  3517     pnlVisit .onMouseDo wn := nil;
  3518     pnlVisit .onMouseUp  := nil;
  3519  
  3520     // Forms  for other  tabs:
  3521     frmCover .visible : = false;
  3522     frmProbl ems.visibl e := false ;
  3523     frmMeds. visible :=  false;
  3524     frmOrder s.visible  := false;
  3525     frmNotes .visible : = false;
  3526     frmConsu lts.visibl e := false ;
  3527     frmDCSum m.visible  := false;
  3528     if Assig ned(frmSur gery) then
  3529       frmSur gery.visib le := fals e;
  3530     frmLabs. visible :=  false;
  3531  
  3532     // Other  tabs (so  to speak):
  3533     tabPage. tabs.clear ;
  3534     tabPage. tabs.add(' Reports');
  3535   end;
  3536  
  3537   procedure  TfrmFrame. UpdatePtIn foOnRefres h;
  3538   var
  3539     tmpDFN:  string;
  3540   begin
  3541     tmpDFN : = Patient. DFN;
  3542     Patient. Clear;
  3543     Patient. DFN := tmp DFN;
  3544     uCore.Te mpEncounte rLoc := 0;   //hds759 1  Clinic/ Ward movem ent.
  3545     uCore.Te mpEncounte rLocName : = ''; //hd s7591  Cli nic/Ward m ovement.
  3546     uCore.Te mpEncounte rText := ' ';
  3547     uCore.Te mpEncounte rDateTime  := 0;
  3548     uCore.Te mpEncounte rVistCat : = #0;
  3549     if (not  FRefreshin g) and (FR eviewClick  = false)  then DoNot ChangeEncW indow := f alse;
  3550     if (FPre vInPatient  and Patie nt.Inpatie nt) then                  //tran sfering in side hospi tal
  3551       begin
  3552              if FReview Click = Tr ue then
  3553                begin
  3554                  ucore. TempEncoun terLoc :=  Encounter. Location;
  3555                  uCore. TempEncoun terLocName  := Encoun ter.Locati onName;
  3556                  uCore. TempEncoun terText :=  Encounter .LocationT ext;
  3557                  uCore. TempEncoun terDateTim e := Encou nter.DateT ime;
  3558                  uCore. TempEncoun terVistCat  := Encoun ter.VisitC ategory;
  3559                end
  3560              else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm =  false) th en
  3561                    begi n
  3562                      fr mPrintLoca tion.Switc hEncounter Loction(En counter.Lo cation, En counter.lo cationName , Encounte r.Location Text,
  3563                                                                  En counter.Da teTime, En counter.Vi sitCategor y);
  3564                      Di splayEncou nterText;
  3565                      ex it;
  3566                    end
  3567              else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm =  True) the n
  3568                begin
  3569                  OrderP rintForm : = false;
  3570                  Exit;
  3571                end;
  3572              if orderpr intform =  false then  Encounter .Location  := Patient .Location;
  3573       end
  3574     else if  (FPrevInPa tient and  (not Patie nt.Inpatie nt)) then      //pati ent was di scharged
  3575     begin
  3576       Encoun ter.Inpati ent := Fal se;
  3577       Encoun ter.Locati on := 0;
  3578       FPrevI nPatient : = False;
  3579       lblPtN ame.Captio n := '';
  3580       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.
  3581     end
  3582     else if  ((not FPre vInPatient ) and Pati ent.Inpati ent) then      //pati ent was ad mitted
  3583     begin
  3584       Encoun ter.Inpati ent := Tru e;
  3585       uCore. TempEncoun terLoc :=  Encounter. Location;   //hds7591   Clinic/W ard moveme nt.
  3586       uCore. TempEncoun terLocName  := Encoun ter.Locati onName; // hds7591  C linic/Ward  movement.
  3587       uCore. TempEncoun terText :=  Encounter .LocationT ext;
  3588       uCore. TempEncoun terDateTim e := Encou nter.DateT ime;
  3589       uCore. TempEncoun terVistCat  := Encoun ter.VisitC ategory;
  3590       lblPtN ame.Captio n := '';
  3591       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.
  3592       if (FR eviewClick  = False)  and (encou nter.Locat ion <> pat ient.Locat ion) and ( OrderPrint Form = fal se) then
  3593           be gin
  3594              frmPrintLo cation.Swi tchEncount erLoction( Encounter. Location,  Encounter. locationNa me, Encoun ter.Locati onText,
  3595                                                       En counter.Da teTime, En counter.Vi sitCategor y);
  3596              //agp valu es are res et dependi ng on the  user proce ss
  3597              uCore.Temp EncounterL oc := 0;   //hds7591   Clinic/Wa rd movemen t.
  3598              uCore.Temp EncounterL ocName :=  ''; //hds7 591  Clini c/Ward mov ement.
  3599              uCore.Temp EncounterT ext := '';
  3600              uCore.Temp EncounterD ateTime :=  0;
  3601              uCore.Temp EncounterV istCat :=  #0;
  3602           en d
  3603       else
  3604       if Ord erPrintFor m = false  then
  3605         begi n
  3606           En counter.Lo cation :=  Patient.Lo cation;
  3607           En counter.Da teTime :=  Patient.Ad mitTime;
  3608           En counter.Vi sitCategor y := 'H';
  3609         end;
  3610       FPrevI nPatient : = True;
  3611     end;
  3612     DisplayE ncounterTe xt;
  3613   end;
  3614  
  3615   procedure  TfrmFrame. FormKeyDow n(Sender:  TObject; v ar Key: Wo rd; Shift:  TShiftSta te);
  3616   var
  3617     NewTabIn dex: integ er;
  3618   begin
  3619     inherite d;
  3620     FCtrlTab Used := FA LSE;
  3621     //CQ2844 : Toggle R emote Data  button us ing Alt+R
  3622      case Ke y of
  3623        82,11 4:  if (ss Alt in Shi ft) then
  3624                     frm Frame.pnlC IRNClick(S ender);
  3625        end;
  3626  
  3627     if (Key  = VK_TAB)  then
  3628     begin
  3629       if (ss Ctrl in Sh ift) then
  3630       begin
  3631         FCtr lTabUsed : = TRUE;
  3632         if n ot (Active Control is  TCustomMe mo) or not  TMemo(Act iveControl ).WantTabs  then begi n
  3633           Ne wTabIndex  := tabPage .TabIndex;
  3634           if  ssShift i n Shift th en
  3635              dec(NewTab Index)
  3636           el se
  3637              inc(NewTab Index);
  3638           if  NewTabInd ex >= tabP age.Tabs.C ount then
  3639              dec(NewTab Index,tabP age.Tabs.C ount)
  3640           el se if NewT abIndex <  0 then
  3641              inc(NewTab Index,tabP age.Tabs.C ount);
  3642           ta bPage.TabI ndex := Ne wTabIndex;
  3643           ta bPageChang e(tabPage) ;
  3644           Ke y := 0;
  3645         end;
  3646       end;
  3647     end;
  3648   end;
  3649  
  3650   procedure  TfrmFrame. FormActiva te(Sender:  TObject);
  3651   begin
  3652     if Assig ned(FLastP age) then
  3653       FLastP age.FocusF irstContro l;
  3654   end;
  3655  
  3656   procedure  TfrmFrame. pnlPrimary CareEnter( Sender: TO bject);
  3657   begin
  3658     with Sen der as TPa nel do
  3659       if (Co ntrolCount  > 0) and  (Controls[ 0] is TSpe edButton)  and (TSpee dButton(Co ntrols[0]) .Down)
  3660       then
  3661         Beve lInner :=  bvLowered
  3662       else
  3663         Beve lInner :=  bvRaised;
  3664   end;
  3665  
  3666   procedure  TfrmFrame. pnlPrimary CareExit(S ender: TOb ject);
  3667   var
  3668     ShiftIsD own,TabIsD own : bool ean;
  3669   begin
  3670     with Sen der as TPa nel do beg in
  3671       BevelI nner := bv None;
  3672       //Make  the lstCI RNLocation s act as i f between  pnlCIRN &  pnlReminde rs
  3673       //in t he Tab Ord er
  3674       if (ls tCIRNLocat ions.CanFo cus) then
  3675       begin
  3676         Shif tIsDown :=  Boolean(H i(GetKeySt ate(VK_SHI FT)));
  3677         TabI sDown := B oolean(Hi( GetKeyStat e(VK_TAB)) );
  3678         if T abIsDown t hen
  3679           if  (ShiftIsD own) and ( Name = 'pn lReminders ') then
  3680              lstCIRNLoc ations.Set Focus
  3681           el se if Not  (ShiftIsDo wn) and (N ame = 'pnl CIRN') the n
  3682              lstCIRNLoc ations.Set Focus;
  3683       end;
  3684     end;
  3685   end;
  3686  
  3687   procedure  TfrmFrame. pnlPatient Click(Send er: TObjec t);
  3688   begin
  3689     Screen.C ursor := c rHourglass ; //wat cq  18425 add ed hourgla ss and dis abled mnuF ileOpen
  3690     mnuFileO pen.Enable d := False ;
  3691     try
  3692     pnlPatie nt.Enabled  := false;
  3693     ViewInfo (mnuViewDe mo);
  3694     pnlPatie nt.Enabled  := true;
  3695     finally
  3696       Screen .Cursor :=  crDefault ;
  3697       mnuFil eOpen.Enab led := Tru e;
  3698     end;
  3699   end;
  3700  
  3701   procedure  TfrmFrame. pnlVisitCl ick(Sender : TObject) ;
  3702   begin
  3703     ViewInfo (mnuViewVi sits);
  3704   end;
  3705  
  3706   procedure  TfrmFrame. pnlPrimary CareClick( Sender: TO bject);
  3707   begin
  3708     ViewInfo (mnuViewPr imaryCare) ;
  3709   end;
  3710  
  3711   procedure  TfrmFrame. pnlReminde rsClick(Se nder: TObj ect);
  3712   begin
  3713     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  3714         View Info(mnuVi ewReminder s);
  3715  
  3716   end;
  3717  
  3718   procedure  TfrmFrame. pnlPosting sClick(Sen der: TObje ct);
  3719   begin
  3720     ViewInfo (mnuViewPo stings);
  3721   end;
  3722  
  3723   //======== ========== =========  CCOW main  changes == ========== ========== ==
  3724  
  3725   procedure  TfrmFrame. HandleCCOW Error(AMes sage: stri ng);
  3726   begin
  3727     {$ifdef  debugCPRS}
  3728      // Show 508Message (AMessage) ;
  3729     {$endif}
  3730     InfoBox( TX_CCOW_ER ROR, TC_CC OW_ERROR,  MB_ICONERR OR or MB_O K);
  3731     FCCOWIns talled :=  False;
  3732     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, 'BM P_CCOW_BRO KEN');
  3733     pnlCCOW. Hint := TX _CCOW_BROK EN;
  3734     mnuFileR esumeConte xt.Visible  := True;
  3735     mnuFileR esumeConte xt.Enabled  := False;
  3736     mnuFileB reakContex t.Visible  := True;
  3737     mnuFileB reakContex t.Enabled  := False;
  3738     FCCOWErr or := True ;
  3739   end;
  3740  
  3741   function T frmFrame.A llowCCOWCo ntextChang e(var CCOW Response:  UserRespon se; NewDFN : string):  boolean;
  3742   var
  3743     PtData :  IContextI temCollect ion;
  3744     PtDataIt em2, PtDat aItem3, Pt DataItem4  : IContext Item;
  3745     response  : UserRes ponse;
  3746     StationN umber: str ing;
  3747     IsProdAc ct: boolea n;
  3748   begin
  3749     Result : = False;
  3750     response  := 0;
  3751     try
  3752       // Sta rt a conte xt change  transactio n
  3753       if FCC OWInstalle d then
  3754          beg in
  3755              FCCOWError  := False;
  3756              imgCCOW.Pi cture.BitM ap.LoadFro mResourceN ame(hInsta nce, 'BMP_ CCOW_CHANG ING');
  3757              pnlCCOW.Hi nt := TX_C COW_CHANGI NG;
  3758              try
  3759                ctxConte xtor.Start ContextCha nge();
  3760              except
  3761                on E: Ex ception do  HandleCCO WError(E.M essage);
  3762              end;
  3763              if FCCOWEr ror then
  3764              begin
  3765                Result : = False;
  3766                Exit;
  3767              end;
  3768              // Set the  new propo sed contex t data.
  3769              PtData :=  CoContextI temCollect ion.Create ();
  3770              StationNum ber := Use r.StationN umber;
  3771              IsProdAcct  := User.I sProductio nAccount;
  3772  
  3773              {$IFDEF CC OWBROKER}
  3774              //IsProdAc ct := RPCB rokerV.Log in.IsProdu ction;  // not yet
  3775              {$ENDIF}
  3776  
  3777              PtDataItem 2 := CoCon textItem.C reate();
  3778              PtDataItem 2.Set_Name ('Patient. co.Patient Name');                  // Pati ent.Name
  3779              PtDataItem 2.Set_Valu e(Piece(Pa tient.Name , ',', 1)  + U + Piec e(Patient. Name, ',',  2) + '^^^ ^');
  3780              PtData.Add (PtDataIte m2);
  3781  
  3782              PtDataItem 3 := CoCon textItem.C reate();
  3783              if not IsP rodAcct th en
  3784                PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber  + '_TEST' )    // Pa tient.DFN
  3785              else
  3786                PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber );              // Pa tient.DFN
  3787              PtDataItem 3.Set_Valu e(Patient. DFN);
  3788              PtData.Add (PtDataIte m3);
  3789  
  3790              if Patient .ICN <> ''  then
  3791                begin
  3792                  PtData Item4 := C oContextIt em.Create( );
  3793                  if not  IsProdAcc t then
  3794                    PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber_ TEST')   / / Patient. ICN
  3795                  else
  3796                    PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber' );       / / Patient. ICN
  3797                  PtData Item4.Set_ Value(Pati ent.ICN);
  3798                  PtData .Add(PtDat aItem4);
  3799                end;
  3800  
  3801              // End the  context c hange tran saction.
  3802              FCCOWError  := False;
  3803              try
  3804                response  := ctxCon textor.End ContextCha nge(true,  PtData);
  3805              except
  3806                on E: Ex ception do  HandleCCO WError(E.M essage);
  3807              end;
  3808              if FCCOWEr ror then
  3809              begin
  3810                HideEver ything;
  3811                Result : = False;
  3812                Exit;
  3813              end;
  3814          end
  3815       else
  3816         begi n
  3817           Re sult := Tr ue;
  3818           Ex it;
  3819         end;
  3820  
  3821       CCOWRe sponse :=  response;
  3822       if (re sponse = U rCommit) t hen
  3823       begin
  3824         // N ew context  is commit ted.
  3825         mnuF ileResumeC ontext.Ena bled := Fa lse;
  3826         mnuF ileBreakCo ntext.Enab led := Tru e;
  3827         FCCO WIconName  := 'BMP_CC OW_LINKED' ;
  3828         pnlC COW.Hint : = TX_CCOW_ LINKED;
  3829         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  3830         Resu lt := True ;
  3831       end
  3832       else i f (respons e = UrCanc el) then
  3833       begin
  3834         // P roposed co ntext chan ge is canc eled. Retu rn to the  current co ntext.
  3835         PtDa ta.RemoveA ll;
  3836         mnuF ileResumeC ontext.Ena bled := Fa lse;
  3837         mnuF ileBreakCo ntext.Enab led := Tru e;
  3838         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  3839         Resu lt := Fals e;
  3840       end
  3841       else i f (respons e = UrBrea k) then
  3842       begin
  3843         // T he context or has bro ken the li nk by susp ending.  T his app sh ould
  3844         // u pdate the  Clinical L ink icon,  enable the  Resume me nu item, a nd
  3845         // d isable the  Suspend m enu item.
  3846         PtDa ta.RemoveA ll;
  3847         mnuF ileResumeC ontext.Ena bled := Tr ue;
  3848         mnuF ileBreakCo ntext.Enab led := Fal se;
  3849         FCCO WIconName  := 'BMP_CC OW_BROKEN' ;
  3850         pnlC COW.Hint : = TX_CCOW_ BROKEN;
  3851         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  3852         if P atient.Inp atient the n
  3853         begi n
  3854           En counter.In patient :=  True;
  3855           En counter.Lo cation :=  Patient.Lo cation;
  3856           En counter.Da teTime :=  Patient.Ad mitTime;
  3857           En counter.Vi sitCategor y := 'H';
  3858         end;
  3859         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  3860         Setu pPatient;
  3861         tabP age.TabInd ex := Page IDToTab(Us er.Initial Tab);
  3862         tabP ageChange( tabPage);
  3863         Resu lt := Fals e;
  3864       end;
  3865     except
  3866       on exc  : EOleExc eption do
  3867         Show Msg('EOleE xception:  ' + exc.Me ssage);
  3868     end;
  3869   end;
  3870  
  3871   procedure  TfrmFrame. ctxContext orCanceled (Sender: T Object);
  3872   begin
  3873     // Appli cation sho uld mainta in its sta te as the  current (e xisting) c ontext.
  3874     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  3875   end;
  3876  
  3877   procedure  TfrmFrame. ctxContext orPending( Sender: TO bject;
  3878     const aC ontextItem Collection : IDispatc h);
  3879   var
  3880     Reason,  HyperLinkR eason: str ing;
  3881     PtChange d: boolean ;
  3882   {$IFDEF CC OWBROKER}
  3883     UserChan ged: boole an;
  3884   {$ENDIF}
  3885   begin
  3886     // If th e app woul d lose dat a, or have  other pro blems chan ging conte xt at
  3887     // this  time, it s hould retu rn a messa ge using S etSurveyRe ponse. Not e that the
  3888     // user  may decide  to commit  the conte xt change  anyway.
  3889     //
  3890     // if (c annot-chan ge-context -without-a -problem)  then
  3891     //   con textor.Set SurveyResp onse('Cond itional ac cept reaso n...');
  3892     if FCCOW Busy then
  3893     begin
  3894       Sleep( 10000);
  3895     end;
  3896  
  3897     FCCOWErr or := Fals e;
  3898     try
  3899       CheckF orDifferen tPatient(a ContextIte mCollectio n, PtChang ed);
  3900   {$IFDEF CC OWBROKER}
  3901       CheckF orDifferen tUser(aCon textItemCo llection,  UserChange d);
  3902   {$ENDIF}
  3903     except
  3904       on E:  Exception  do HandleC COWError(E .Message);
  3905     end;
  3906     if FCCOW Error then
  3907     begin
  3908       HideEv erything;
  3909       Exit;
  3910     end;
  3911  
  3912   {$IFDEF CC OWBROKER}
  3913     if PtCha nged or Us erChanged  then
  3914   {$ELSE}
  3915     if PtCha nged then
  3916   {$ENDIF}
  3917       begin
  3918         FCCO WContextCh anging :=  True;
  3919         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  'BMP_CCOW _CHANGING' );
  3920         pnlC COW.Hint : = TX_CCOW_ CHANGING;
  3921         Allo wContextCh angeAll(Re ason);
  3922       end;
  3923     CheckHyp erlinkResp onse(aCont extItemCol lection, H yperlinkRe ason);
  3924     Reason : = Hyperlin kReason +  Reason;
  3925     if Pos(' COM_OBJECT _ACTIVE',  Reason) >  0 then
  3926       Sleep( 12000)
  3927     else if  Length(Rea son) > 0 t hen
  3928       ctxCon textor.Set SurveyResp onse(Reaso n)
  3929     else
  3930       begin
  3931         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  'BMP_CCOW _LINKED');
  3932         pnlC COW.Hint : = TX_CCOW_ LINKED;
  3933       end;
  3934     FCCOWCon textChangi ng := Fals e;
  3935   end;
  3936  
  3937   procedure  TfrmFrame. ctxContext orCommitte d(Sender:  TObject);
  3938   var
  3939     Reason:  string;
  3940     PtChange d: boolean ;
  3941     i: integ er;
  3942   begin
  3943     // Appli cation sho uld now ac cess the n ew context  and updat e its stat e.
  3944     FCCOWErr or := Fals e;
  3945     try
  3946     {$IFDEF  CCOWBROKER }
  3947       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
  3948       begin
  3949         Reas on := 'COM MIT';
  3950         if A llowContex tChangeAll (Reason) t hen
  3951         begi n
  3952           Cl ose;
  3953           Ex it;
  3954         end;
  3955       end;
  3956     {$ENDIF}
  3957       CheckF orDifferen tPatient(c txContexto r.CurrentC ontext, Pt Changed);
  3958     except
  3959       on E:  Exception  do HandleC COWError(E .Message);
  3960     end;
  3961     if FCCOW Error then
  3962     begin
  3963       HideEv erything;
  3964       Exit;
  3965     end;
  3966     if not P tChanged t hen exit;
  3967     FCCOWDri vedChange  := True;
  3968     i := 0;
  3969     while Le ngth(Scree n.Forms[i] .Name) > 0  do
  3970     begin
  3971       if fsM odal in Sc reen.Forms [i].FormSt ate then
  3972       begin
  3973         Scre en.Forms[i ].ModalRes ult := mrC ancel;
  3974         i :=  i + 1;
  3975       end el se  // the  fsModal f orms alway s sequence d prior to  the none- fsModal fo rms
  3976         Brea k;
  3977     end;
  3978     Reason : = 'COMMIT' ;
  3979     if Allow ContextCha ngeAll(Rea son) then  UpdateCCOW Context;
  3980     FCCOWIco nName := ' BMP_CCOW_L INKED';
  3981     pnlCCOW. Hint := TX _CCOW_LINK ED;
  3982     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  3983   end;
  3984  
  3985   function T frmFrame.F indBestCCO WDFN: stri ng;
  3986   var
  3987     data: IC ontextItem Collection ;
  3988     anItem:  IContextIt em;
  3989     StationN umber, tem pDFN: stri ng;
  3990     IsProdAc ct:  Boole an;
  3991  
  3992     procedur e FindNext BestDFN;
  3993     begin
  3994       Statio nNumber :=  User.Stat ionNumber;
  3995       if IsP rodAcct th en
  3996         anIt em := data .Present(' Patient.id .MRN.DFN_'  + Station Number)
  3997       else
  3998         anIt em := data .Present(' Patient.id .MRN.DFN_'  + Station Number + ' _TEST');
  3999       if anI tem <>  ni l then tem pDFN := an Item.Get_V alue();
  4000     end;
  4001  
  4002   begin
  4003     if uCore .User = ni l then
  4004     begin
  4005       Result  := '';
  4006       exit;
  4007     end;
  4008     IsProdAc ct := User .IsProduct ionAccount ;
  4009     // Get a n item col lection of  the curre nt context
  4010     FCCOWErr or := Fals e;
  4011     try
  4012       data : = ctxConte xtor.Curre ntContext;
  4013     except
  4014       on E:  Exception  do HandleC COWError(E .Message);
  4015     end;
  4016     if FCCOW Error then
  4017     begin
  4018       HideEv erything;
  4019       Exit;
  4020     end;
  4021     // Retri eve the Co ntextItem  name and v alue as st rings
  4022     if IsPro dAcct then
  4023       anItem  := data.P resent('Pa tient.id.M RN.Nationa lIDNumber' )
  4024     else
  4025       anItem  := data.P resent('Pa tient.id.M RN.Nationa lIDNumber_ TEST');
  4026     if anIte m <> nil t hen
  4027       begin
  4028         temp DFN := Get DFNFromICN (anItem.Ge t_Value()) ;                        // "Pub lic" RPC c all
  4029         if t empDFN = ' -1' then F indNextBes tDFN;
  4030       end
  4031     else
  4032       FindNe xtBestDFN;
  4033     Result : = tempDFN;
  4034     data :=  nil;
  4035     anItem : = nil;
  4036   end;
  4037  
  4038   procedure  TfrmFrame. UpdateCCOW Context;
  4039   var
  4040     PtDFN(*,  PtName*):  string;
  4041   begin
  4042     if not F CCOWInstal led then e xit;
  4043     DoNotCha ngeEncWind ow := fals e;
  4044     PtDFN :=  FindBestC COWDFN;
  4045     if StrTo Int64Def(P tDFN, 0) >  0 then
  4046       begin
  4047         // S elect new  patient ba sed on con text value
  4048         if P atient.DFN  = PtDFN t hen exit;
  4049         Pati ent.DFN :=  PtDFN;
  4050         if ( Patient.Na me = '-1')  then
  4051           be gin
  4052              HideEveryt hing;
  4053              exit;
  4054           en d
  4055         else
  4056           Sh owEverythi ng;
  4057         Enco unter.Clea r;
  4058         if P atient.Inp atient the n
  4059         begi n
  4060           En counter.In patient :=  True;
  4061           En counter.Lo cation :=  Patient.Lo cation;
  4062           En counter.Da teTime :=  Patient.Ad mitTime;
  4063           En counter.Vi sitCategor y := 'H';
  4064         end;
  4065         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  4066         if n ot FFirstL oad then S etupPatien t;
  4067         frmC over.Updat eVAAButton ; //VAA
  4068         Dete rmineNextT ab;
  4069         tabP age.TabInd ex := Page IDToTab(Ne xtTab);
  4070         tabP ageChange( tabPage);
  4071       end
  4072     else
  4073       HideEv erything;
  4074   end;
  4075  
  4076   procedure  TfrmFrame. mnuFileBre akContextC lick(Sende r: TObject );
  4077   begin
  4078     FCCOWErr or := Fals e;
  4079     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4080     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4081     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4082     try
  4083       ctxCon textor.Sus pend;
  4084     except
  4085       on E:  Exception  do HandleC COWError(E .Message);
  4086     end;
  4087     if FCCOW Error then  exit;
  4088     FCCOWIco nName := ' BMP_CCOW_B ROKEN';
  4089     pnlCCOW. Hint := TX _CCOW_BROK EN;
  4090     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4091     mnuFileR esumeConte xt.Enabled  := True;
  4092     mnuFileB reakContex t.Enabled  := False;
  4093   end;
  4094  
  4095   procedure  TfrmFrame. mnuFileRes umeContext GetClick(S ender: TOb ject);
  4096   var
  4097     Reason:  string;
  4098   begin
  4099     Reason : = '';
  4100     if not A llowContex tChangeAll (Reason) t hen exit;
  4101     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4102     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4103     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4104     FCCOWErr or := Fals e;
  4105     try
  4106       ctxCon textor.Res ume;
  4107     except
  4108       on E:  Exception  do HandleC COWError(E .Message);
  4109     end;
  4110     if FCCOW Error then  exit;
  4111     UpdateCC OWContext;
  4112     if not F NoPatientS elected th en
  4113     begin
  4114       FCCOWI conName :=  'BMP_CCOW _LINKED';
  4115       pnlCCO W.Hint :=  TX_CCOW_LI NKED;
  4116       imgCCO W.Picture. BitMap.Loa dFromResou rceName(hI nstance, F CCOWIconNa me);
  4117       mnuFil eResumeCon text.Enabl ed := Fals e;
  4118       mnuFil eBreakCont ext.Visibl e := True;
  4119       mnuFil eBreakCont ext.Enable d := True;
  4120     end;
  4121   end;
  4122  
  4123   procedure  TfrmFrame. mnuFileRes umeContext SetClick(S ender: TOb ject);
  4124   var
  4125     CCOWResp onse: User Response;
  4126     Reason:  string;
  4127   begin
  4128     Reason : = '';
  4129     if not A llowContex tChangeAll (Reason) t hen exit;
  4130     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4131     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4132     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4133     FCCOWErr or := Fals e;
  4134     try
  4135       ctxCon textor.Res ume;
  4136     except
  4137       on E:  Exception  do HandleC COWError(E .Message);
  4138     end;
  4139     if FCCOW Error then  exit;
  4140     if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n
  4141       begin
  4142         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4143         mnuF ileBreakCo ntext.Visi ble := Tru e;
  4144         mnuF ileBreakCo ntext.Enab led := Tru e;
  4145         FCCO WIconName  := 'BMP_CC OW_LINKED' ;
  4146         pnlC COW.Hint : = TX_CCOW_ LINKED;
  4147         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4148       end
  4149     else
  4150       begin
  4151         mnuF ileResumeC ontext.Ena bled := Tr ue;
  4152         mnuF ileBreakCo ntext.Enab led := Fal se;
  4153         FCCO WIconName  := 'BMP_CC OW_BROKEN' ;
  4154         pnlC COW.Hint : = TX_CCOW_ BROKEN;
  4155         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4156         try
  4157           if  ctxContex tor.State  in [csPart icipating]  then ctxC ontextor.S uspend;
  4158         exce pt
  4159           on  E: Except ion do Han dleCCOWErr or(E.Messa ge);
  4160         end;
  4161      end;
  4162     SetupPat ient;
  4163     tabPage. TabIndex : = PageIDTo Tab(User.I nitialTab) ;
  4164     tabPageC hange(tabP age);
  4165   end;
  4166  
  4167   procedure  TfrmFrame. CheckForDi fferentPat ient(aCont extItemCol lection: I Dispatch;  var PtChan ged: boole an);
  4168   var
  4169     data : I ContextIte mCollectio n;
  4170     anItem:  IContextIt em;
  4171     PtDFN, P tName: str ing;
  4172   begin
  4173     if uCore .Patient =  nil then
  4174     begin
  4175       PtChan ged := Fal se;
  4176       Exit;
  4177     end;
  4178     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4179     PtDFN :=  FindBestC COWDFN;
  4180     // Retri eve the Co ntextItem  name and v alue as st rings
  4181     anItem : = data.Pre sent('Pati ent.co.Pat ientName') ;
  4182     if anIte m <> nil t hen PtName  := anItem .Get_Value ();
  4183     PtChange d := not ( (PtDFN = P atient.DFN ) and (PtN ame = Piec e(Patient. Name, ',',  1) + U +  Piece(Pati ent.Name,  ',', 2) +  '^^^^'));
  4184   end;
  4185  
  4186   {$IFDEF CC OWBROKER}
  4187   procedure  TfrmFrame. CheckForDi fferentUse r(aContext ItemCollec tion: IDis patch; var  UserChang ed: boolea n);
  4188   var
  4189     data : I ContextIte mCollectio n;
  4190   begin
  4191     if uCore .User = ni l then
  4192     begin
  4193       UserCh anged := F alse;
  4194       Exit;
  4195     end;
  4196     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4197     UserChan ged := RPC BrokerV.Is UserContex tPending(d ata);
  4198   end;
  4199   {$ENDIF}
  4200  
  4201   procedure  TfrmFrame. CheckHyper linkRespon se(aContex tItemColle ction: IDi spatch; va r Hyperlin kReason: s tring);
  4202   var
  4203     data : I ContextIte mCollectio n;
  4204     anItem :  IContextI tem;
  4205     itemvalu e: string;
  4206     PtSubjec t: string;
  4207   begin
  4208     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4209       anItem :=  data.Prese nt('[hds_m ed_ DOMAIN ]request.i d.name');
  4210     // Retri eve the Co ntextItem  name and v alue as st rings
  4211     if anIte m <> nil t hen
  4212       begin
  4213         item Value := a nItem.Get_ Value();
  4214         if i temValue =  'GetWindo wHandle' t hen
  4215           be gin
  4216              PtSubject  := 'patien t.id.mrn.d fn_' + Use r.StationN umber;
  4217              if not Use r.IsProduc tionAccoun t then PtS ubject :=  PtSubject  + '_test';
  4218              if data.Pr esent(PtSu bject) <>  nil then
  4219                Hyperlin kReason :=  '!@#$' +  IntToStr(S elf.Handle ) + ':0:'
  4220              else
  4221                Hyperlin kReason :=  '';
  4222           en d;
  4223       end;
  4224   end;
  4225  
  4226   procedure  TfrmFrame. HideEveryt hing(AMess age: strin g = 'No pa tient is c urrently s elected.') ;
  4227   begin
  4228     FNoPatie ntSelected  := TRUE;
  4229     pnlNoPat ientSelect ed.Caption  := AMessa ge;
  4230     pnlNoPat ientSelect ed.Visible  := True;
  4231     pnlNoPat ientSelect ed.BringTo Front;
  4232     mnuFileR eview.Enab led := Fal se;
  4233     mnuFileP rint.Enabl ed := Fals e;
  4234     mnuFileP rintSelect edItems.En abled := F alse;
  4235     mnuFileE ncounter.E nabled :=  False;
  4236     mnuFileN ext.Enable d := False ;
  4237     mnuFileR efresh.Ena bled := Fa lse;
  4238     mnuFileP rintSetup. Enabled :=  False;
  4239     mnuFileP rintSelect edItems.En abled := F alse;
  4240     mnuFileN otifRemove .Enabled : = False;
  4241     mnuFileR esumeConte xt.Enabled  := False;
  4242     mnuFileB reakContex t.Enabled  := False;
  4243     mnuEdit. Enabled :=  False;
  4244     mnuView. Enabled :=  False;
  4245     mnuTools .Enabled : = False;
  4246     if FNext ButtonActi ve then FN extButton. Visible :=  False;
  4247   end;
  4248  
  4249   procedure  TfrmFrame. ShowEveryt hing;
  4250   begin
  4251     FNoPatie ntSelected  := FALSE;
  4252     pnlNoPat ientSelect ed.Caption  := '';
  4253     pnlNoPat ientSelect ed.Visible  := False;
  4254     pnlNoPat ientSelect ed.SendToB ack;
  4255     mnuFileR eview.Enab led := Tru e;
  4256     mnuFileP rint.Enabl ed := True ;
  4257     mnuFileE ncounter.E nabled :=  True;
  4258     mnuFileN ext.Enable d := True;
  4259     mnuFileR efresh.Ena bled := Tr ue;
  4260     mnuFileP rintSetup. Enabled :=  True;
  4261     mnuFileP rintSelect edItems.En abled := T rue;
  4262     mnuFileN otifRemove .Enabled : = True;
  4263     if not F CCOWError  then
  4264     begin
  4265       if FCC OWIconName = 'BMP_CCO W_BROKEN'  then
  4266       begin
  4267         mnuF ileResumeC ontext.Ena bled := Tr ue;
  4268         mnuF ileBreakCo ntext.Enab led := Fal se;
  4269       end el se
  4270       begin
  4271         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4272         mnuF ileBreakCo ntext.Enab led := Tru e;
  4273       end;
  4274     end;
  4275     mnuEdit. Enabled :=  True;
  4276     mnuView. Enabled :=  True;
  4277     mnuTools .Enabled : = True;
  4278     if FNext ButtonActi ve then FN extButton. Visible :=  True;
  4279   end;
  4280  
  4281  
  4282   procedure  TfrmFrame. pnlFlagMou seDown(Sen der: TObje ct; Button : TMouseBu tton;
  4283     Shift: T ShiftState ; X, Y: In teger);
  4284   begin
  4285     pnlFlag. BevelOuter  := bvLowe red;
  4286   end;
  4287  
  4288   procedure  TfrmFrame. pnlFlagMou seUp(Sende r: TObject ; Button:  TMouseButt on;
  4289     Shift: T ShiftState ; X, Y: In teger);
  4290   begin
  4291     pnlFlag. BevelOuter  := bvRais ed;
  4292   end;
  4293  
  4294   procedure  TfrmFrame. pnlFlagCli ck(Sender:  TObject);
  4295   begin
  4296     ViewInfo (mnuViewFl ags);
  4297   end;
  4298  
  4299   procedure  TfrmFrame. mnuFilePri ntSelected ItemsClick (Sender: T Object);
  4300   begin
  4301       case T abToPageID (tabPage.T abIndex) o f
  4302         CT_N OTES:    f rmNotes.Ls tNotesToPr int;
  4303         CT_C ONSULTS: f rmConsults .LstConsul tsToPrint;
  4304         CT_D CSUMM:   f rmDCSumm.L stSummsToP rint;
  4305    end; {cas e}
  4306   end;
  4307  
  4308   procedure  TfrmFrame. mnuAlertRe newClick(S ender: TOb ject);
  4309   var XQAID:  string;
  4310   begin
  4311     XQAID :=  Piece(Not ifications .RecordID,  '^', 2);
  4312     RenewAle rt(XQAID);
  4313   end;
  4314  
  4315   procedure  TfrmFrame. mnuAlertFo rwardClick (Sender: T Object);
  4316   var
  4317     XQAID, A lertMsg: s tring;
  4318   begin
  4319     XQAID :=  Piece(Not ifications .RecordID, '^', 2);
  4320     AlertMsg  := Piece( Notificati ons.Record ID, '^', 1 );
  4321     RenewAle rt(XQAID);   // must  renew/rest ore an ale rt before  it can be  forwarded
  4322     ForwardA lertTo(XQA ID + '^' +  AlertMsg) ;
  4323   end;
  4324  
  4325   procedure  TfrmFrame. mnuGECStat usClick(Se nder: TObj ect);
  4326   var
  4327   ans, Resul t,str,str1 ,title: st ring;
  4328   cnt,i: int eger;
  4329   fin: boole an;
  4330  
  4331   begin
  4332     Result : = sCallV(' ORQQPXRM G EC STATUS  PROMPT', [ Patient.DF N]);
  4333     if Piece (Result,U, 1) <> '0'  then
  4334       begin
  4335         titl e := Piece (Result,U, 2);
  4336           if  pos('~',P iece(Resul t,U,1))>0  then
  4337                   begin
  4338                   str:= '';
  4339                   str1  := Piece(R esult,U,1) ;
  4340                   cnt : = DelimCou nt(str1, ' ~');
  4341                   for i :=1 to cnt +1 do
  4342                       b egin
  4343                       i f i = 1 th en str :=  Piece(str1 ,'~',i);
  4344                       i f i > 1 th en str :=s tr+CRLF+Pi ece(str1,' ~',i);
  4345                       e nd;
  4346                 end
  4347                 else st r := Piece (Result,U, 1);
  4348           if  Piece(Res ult,U,3)=' 1' then
  4349              begin
  4350                 fin :=  (InfoBox(s tr,title,  MB_YESNO o r MB_DEFBU TTON2)=IDY ES);
  4351                 if fin  = true the n ans := ' 1';
  4352                 if fin  = false th en ans :=  '0';
  4353                 CallV(' ORQQPXRM G EC FINISHE D?',[Patie nt.DFN,ans ]);
  4354              end
  4355           el se
  4356           In foBox(str, title, MB_ OK);
  4357       end;
  4358   end;
  4359  
  4360   procedure  TfrmFrame. pnlFlagEnt er(Sender:  TObject);
  4361   begin
  4362     pnlFlag. BevelInner  := bvRais ed;
  4363     pnlFlag. BevelOuter  := bvNone ;
  4364     pnlFlag. BevelWidth  := 3;
  4365   end;
  4366  
  4367   procedure  TfrmFrame. pnlFlagExi t(Sender:  TObject);
  4368   begin
  4369     pnlFlag. BevelWidth  := 2;
  4370     pnlFlag. BevelInner  := bvNone ;
  4371     pnlFlag. BevelOuter  := bvRais ed;
  4372   end;
  4373  
  4374   procedure  TfrmFrame. tabPageMou seDown(Sen der: TObje ct; Button : TMouseBu tton;
  4375     Shift: T ShiftState ; X, Y: In teger);
  4376   begin
  4377     inherite d;
  4378     TabCtrlC licked :=  True;
  4379   end;
  4380  
  4381   procedure  TfrmFrame. tabPageMou seUp(Sende r: TObject ; Button:  TMouseButt on;
  4382     Shift: T ShiftState ; X, Y: In teger);
  4383   begin
  4384     LastTab  := TabToPa geID((send er as TTab Control).T abIndex);
  4385   end;
  4386  
  4387   procedure  TfrmFrame. lstCIRNLoc ationsExit (Sender: T Object);
  4388   begin
  4389       //Make  the lstCI RNLocation s act as i f between  pnlCIRN &  pnlReminde rs
  4390       //in t he Tab Ord er
  4391     if Boole an(Hi(GetK eyState(VK _TAB))) th en
  4392       if Boo lean(Hi(Ge tKeyState( VK_SHIFT)) ) then
  4393         pnlC IRN.SetFoc us
  4394       else
  4395         pnlR eminders.S etFocus;
  4396   end;
  4397  
  4398   procedure  TfrmFrame. AppEventsA ctivate(Se nder: TObj ect);
  4399   begin
  4400     FJustEnt eredApp :=  True;
  4401   end;
  4402  
  4403   procedure  TfrmFrame. AppEventsM essage(var  Msg: tagM SG; var Ha ndled: Boo lean);
  4404   var
  4405     Control:  TComponen t;
  4406   begin
  4407     Handled  := false;
  4408     if (Msg. message =  WM_MOUSEWH EEL) and ( GetKeyStat e(VK_LBUTT ON) < 0) t hen begin
  4409       Contro l := FindC ontrol(Msg .hwnd);
  4410       if not  Assigned( Control) t hen
  4411         Hand led := Tru e
  4412       else i f (Control  is TRichE dit) then  begin
  4413         Hand led := Tru e;
  4414         Send Message(se lf.Handle,  EM_SETZOO M, 0, 0);
  4415       end;
  4416      end;
  4417   end;
  4418  
  4419   procedure  TfrmFrame. ScreenActi veFormChan ge(Sender:  TObject);
  4420   begin
  4421     if(assig ned(FOldAc tiveFormCh ange)) the n
  4422       FOldAc tiveFormCh ange(Sende r);
  4423     //Focus  the Form t hat Stays  on Top aft er the App lication R egains foc us.
  4424     if FJust EnteredApp  then
  4425       FocusA pplication TopForm;
  4426     FJustEnt eredApp :=  false;
  4427   end;
  4428  
  4429   procedure  TfrmFrame. FocusAppli cationTopF orm;
  4430   var
  4431     I : inte ger;
  4432   begin
  4433     for I :=  (Screen.F ormCount-1 ) downto 0  do //Set  the last o ne opened  last
  4434     begin
  4435       with S creen.Form s[I] do
  4436         if ( FormStyle  = fsStayOn Top) and ( Enabled) a nd (Visibl e) then
  4437           Se tFocus;
  4438     end;
  4439   end;
  4440  
  4441   procedure  TfrmFrame. AppEventsS hortCut(va r Msg: TWM Key;
  4442     var Hand led: Boole an);
  4443   begin
  4444     if ((Boo lean(Hi(Ge tKeyState( VK_MENU{AL T})))) and  (Msg.Char Code = VK_ F1)) then
  4445     begin
  4446       FocusA pplication TopForm;
  4447       Handle d := True;
  4448     end;
  4449   end;
  4450  
  4451   procedure  TfrmFrame. mnuToolsGr aphingClic k(Sender:  TObject);
  4452   var
  4453     contexth int: strin g;
  4454   begin
  4455     Screen.C ursor := c rHourGlass ;
  4456     contexth int := mnu ToolsGraph ing.Hint;
  4457     if Graph Float = ni l then                // new gra ph
  4458     begin
  4459       GraphF loat := Tf rmGraphs.C reate(self );
  4460       try
  4461         with  GraphFloa t do
  4462         begi n
  4463           if  btnClose. Tag = 1 th en
  4464           be gin
  4465              Screen.Cur sor := crD efault;
  4466              exit;
  4467           en d;
  4468           In itialize;
  4469           Ca ption := ' CPRS Graph ing - Pati ent: ' + M ixedCase(P atient.Nam e);
  4470           Bo rderIcons  := [biSyst emMenu, bi Maximize,  biMinimize ];
  4471           Bo rderStyle  := bsSizea ble;
  4472           Bo rderWidth  := 1;
  4473           //  context s ensitive        type  (tabPage.T abIndex)   & [item]
  4474           Re sizeAnchor edFormToFo nt(GraphFl oat);
  4475           Gr aphFloat.p nlFooter.H int := con texthint;    // conte xt from la b most rec ent
  4476           Sh ow;
  4477         end;
  4478       finall y
  4479         if G raphFloat. btnClose.T ag = 1 the n
  4480         begi n
  4481           Gr aphFloatAc tive := fa lse;
  4482           Gr aphFloat.F ree;
  4483           Gr aphFloat : = nil;
  4484         end
  4485         else
  4486           Gr aphFloatAc tive := tr ue;
  4487       end;
  4488     end
  4489     else
  4490     begin
  4491       GraphF loat.Capti on := 'CPR S Graphing  - Patient : ' + Mixe dCase(Pati ent.Name);
  4492       GraphF loat.pnlFo oter.Hint  := context hint;   //  context f rom lab mo st recent
  4493       if Gra phFloat.bt nClose.Tag  = 1 then
  4494       begin
  4495         Scre en.Cursor  := crDefau lt;
  4496         exit ;
  4497       end
  4498       else i f GraphFlo atActive a nd (frmGra phData.pnl Data.Hint  = Patient. DFN) then
  4499       begin
  4500         if l ength(Grap hFloat.pnl Footer.Hin t) > 1 the n
  4501         begi n
  4502           Gr aphFloat.C lose;
  4503           Gr aphFloatAc tive := tr ue;
  4504           Gr aphFloat.S how;
  4505         end;
  4506         Grap hFloat.Bri ngToFront;               // grap h is activ e, same pa tient
  4507       end
  4508       else i f frmGraph Data.pnlDa ta.Hint =  Patient.DF N then
  4509       begin                                     // graph  is not ac tive, same  patient
  4510         // c ontext sen sitive
  4511         Grap hFloat.Sho w;
  4512         Grap hFloatActi ve := true ;
  4513       end
  4514       else
  4515       //with  GraphFloa t do                      // new  patient
  4516       begin
  4517         Grap hFloat.Ini tialRetain ;
  4518         Grap hFloatActi ve := fals e;
  4519         Grap hFloat.Fre e;
  4520         Grap hFloat :=  nil;
  4521         mnuT oolsGraphi ngClick(se lf);           // del ete and re curse
  4522       end;
  4523     end;
  4524     mnuTools Graphing.H int := '';
  4525     Screen.C ursor := c rDefault;
  4526   end;
  4527  
  4528   procedure  TfrmFrame. pnlCIRNMou seDown(Sen der: TObje ct; Button : TMouseBu tton; Shif t: TShiftS tate; X, Y : Integer) ;
  4529   begin
  4530     pnlCIRN. BevelOuter  := bvLowe red;
  4531   end;
  4532  
  4533   procedure  TfrmFrame. pnlCIRNMou seUp(Sende r: TObject ; Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  4534   begin
  4535     pnlCIRN. BevelOuter  := bvRais ed;
  4536   end;
  4537  
  4538   procedure  TfrmFrame. laMHVClick (Sender: T Object);
  4539   begin
  4540     ViewInfo (mnuViewMy HealtheVet );
  4541   end;
  4542  
  4543   procedure  TfrmFrame. laVAA2Clic k(Sender:  TObject);
  4544   begin
  4545     ViewInfo (mnuInsura nce);
  4546   end;
  4547  
  4548   procedure  TfrmFrame. ViewInfo(S ender: TOb ject);
  4549   var
  4550     SelectNe w: Boolean ;
  4551     Insuranc eSubscribe rName: str ing;
  4552     ReportSt ring: TStr ingList;
  4553     aAddress : string;
  4554     ID: inte ger;
  4555   begin
  4556     if Sende r is TMenu Item then  begin
  4557       ID :=  TMenuItem( Sender).Ta g;
  4558     end else  if Sender  is TActio n then beg in
  4559       ID :=  TAction(Se nder).Tag;
  4560     end else  begin
  4561       ID :=  -1;
  4562     end;
  4563     case ID  of
  4564       1:begi n { displa ys patient  inquiry r eport (whi ch optiona lly allows  new patie nt to be s elected) }
  4565           St atusText(T X_PTINQ);
  4566           Pa tientInqui ry(SelectN ew);
  4567           if  Assigned( FLastPage)  then
  4568              FLastPage. FocusFirst Control;
  4569           St atusText(' ');
  4570           if  SelectNew  then mnuF ileOpenCli ck(mnuView Demo);
  4571         end;
  4572       2:begi n
  4573           if  (not User .IsReports Only) then  // Report s Only tab .
  4574              mnuFileEnc ounterClic k(Self);
  4575         end;
  4576       3:begi n
  4577           Re portBox(De tailPrimar yCare(Pati ent.DFN),  'Primary C are', True );
  4578         end;
  4579       4:begi n
  4580           if  laMHV.Cap tion = 'MH V' then
  4581              ShellExecu te(laMHV.H andle, 'op en', PChar ('http://w ww.myhealt h.va.gov/' ), '', '',  SW_NORMAL );
  4582         end;
  4583       5:begi n
  4584           if  fCover.VA AFlag[0] < > '0' then  //'0' mea ns subscri ber not fo und
  4585           be gin
  4586            / /  CQ:1553 4-GE  Remo ve leading  spaces fr om Patient  Name
  4587              InsuranceS ubscriberN ame := ( ( Piece(fCov er.VAAFlag [12],':',1 )) + ':  '  +
  4588                                           (TR IM(Piece(f Cover.VAAF lag[12],': ',2)) ));/ /fCover.VA AFlag[12];
  4589              ReportStri ng := VAAF lag;
  4590              ReportStri ng[0] := ' ';
  4591              ReportBox( ReportStri ng, Insura nceSubscri berName, T rue);
  4592           en d;
  4593         end;
  4594       6:begi n
  4595           Sh owFlags;
  4596         end;
  4597       7:begi n
  4598           if  uUseVista Web = true  then
  4599              begin
  4600                lblCIRN. Alignment  := taCente r;
  4601                lstCIRNL ocations.V isible :=  false;
  4602                lstCIRNL ocations.S endToBack;
  4603                aAddress  := GetVis taWebAddre ss(Patient .DFN);
  4604                ShellExe cute(pnlCi rn.Handle,  'open', P Char(aAddr ess), PCha r(''), '',  SW_NORMAL );
  4605                pnlCIRN. BevelOuter  := bvRais ed;
  4606                Exit;
  4607              end;
  4608           if  not Remot eSites.Rem oteDataExi sts then E xit;
  4609           if  (not lstC IRNLocatio ns.Visible ) then
  4610              begin
  4611                pnlCIRN. BevelOuter  := bvLowe red;
  4612                lstCIRNL ocations.V isible :=  True;
  4613                lstCIRNL ocations.B ringToFron t;
  4614                lstCIRNL ocations.S etFocus;
  4615                pnlCIRN. Hint := 'C lick to cl ose list.' ;
  4616              end
  4617           el se
  4618              begin
  4619                pnlCIRN. BevelOuter  := bvRais ed;
  4620                lstCIRNL ocations.V isible :=  False;
  4621                lstCIRNL ocations.S endToBack;
  4622                pnlCIRN. Hint := 'C lick to di splay othe r faciliti es having  data for t his patien t.';
  4623              end;
  4624         end;
  4625       8:begi n
  4626           Vi ewReminder Tree;
  4627         end;
  4628       9:begi n { displa ys the win dow that s hows crisi s notes, w arnings, a llergies,  & advance  directives  }
  4629           Sh owCWAD;
  4630         end;
  4631     end;
  4632   end;
  4633  
  4634   procedure  TfrmFrame. mnuViewInf ormationCl ick(Sender : TObject) ;
  4635   begin
  4636     mnuViewD emo.Enable d := frmFr ame.pnlPat ient.Enabl ed;
  4637     mnuViewV isits.Enab led := frm Frame.pnlV isit.Enabl ed;
  4638     mnuViewP rimaryCare .Enabled : = frmFrame .pnlPrimar yCare.Enab led;
  4639     mnuViewM yHealtheVe t.Enabled  := not (Co py(frmFram e.laMHV.Hi nt, 1, 2)  = 'No');
  4640     mnuInsur ance.Enabl ed := not  (Copy(frmF rame.laVAA 2.Hint, 1,  2) = 'No' );
  4641     mnuViewF lags.Enabl ed := frmF rame.lblFl ag.Enabled ;
  4642     mnuViewR emoteData. Enabled :=  frmFrame. lblCirn.En abled;
  4643     mnuViewR eminders.E nabled :=  frmFrame.p nlReminder s.Enabled;
  4644     mnuViewP ostings.En abled := f rmFrame.pn lPostings. Enabled;
  4645   end;
  4646  
  4647   procedure  TfrmFrame. SetActiveT ab(PageID:  Integer);
  4648   begin
  4649     tabPage. TabIndex : = frmFrame .PageIDToT ab(PageID) ;
  4650     tabPageC hange(tabP age);
  4651   end;
  4652  
  4653   procedure  TfrmFrame. NextButton Click(Send er: TObjec t);
  4654   begin
  4655     if FProc cessingNex tClick the n Exit;
  4656     FProcces singNextCl ick := tru e;
  4657     popAlert s.AutoPopu p := TRUE;
  4658     mnuFileN ext.Enable d := True;
  4659     mnuFileN extClick(S elf);
  4660     FProcces singNextCl ick := fal se;
  4661   end;
  4662  
  4663   procedure  TfrmFrame. NextButton MouseDown( Sender: TO bject; But ton: TMous eButton;
  4664         Shif t: TShiftS tate; X, Y : Integer) ;
  4665   begin
  4666      popAler ts.AutoPop up := TRUE ;
  4667   end;
  4668  
  4669   procedure  TfrmFrame. SetUpNextB utton;
  4670    begin
  4671      if FNex tButton <>  nil then
  4672      begin
  4673         FNex tButton.fr ee;
  4674         FNex tButton :=  nil;
  4675      end;
  4676      FNextBu tton := TB itBtn.Crea te(self);
  4677      FNextBu tton.Paren t:= frmFra me;
  4678      FNextBu tton.Glyph  := FNextB uttonBitma p;
  4679      FNextBu tton.OnMou seDown :=  NextButton MouseDown;
  4680      FNextBu tton.OnCli ck := Next ButtonClic k;
  4681      FNextBu tton.Capti on := '&Ne xt';
  4682      FNextBu tton.Popup Menu := po pAlerts;
  4683      FNextBu tton.Top : = stsArea. Top;
  4684      FNextBu tton.Left  := FNextBu ttonL;
  4685      FNextBu tton.Heigh t := stsAr ea.Height;
  4686      FNextBu tton.Width  := stsAre a.Panels[2 ].Width;
  4687      FNextBu tton.TabSt op := True ;
  4688      FNextBu tton.TabOr der := 1;
  4689      FNextBu tton.show;
  4690   end;
  4691  
  4692   initializa tion
  4693     SpecifyF ormIsNotAD ialog(Tfrm Frame);
  4694  
  4695   finalizati on
  4696  
  4697  
  4698   end.
  4699  
  4700