65. EPMO Open Source Coordination Office Redaction File Detail Report

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

65.1 Files compared

# Location File Last Modified
1 CPRS_V32_COMBINED_BUILD_V45.zip\OR_30_405V45_src fFrame.pas Thu Mar 29 21:15:50 2018 UTC
2 CPRS_V32_COMBINED_BUILD_V45.zip\OR_30_405V45_src fFrame.pas Thu May 10 20:21:44 2018 UTC

65.2 Comparison summary

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

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

65.4 Active regular expressions

No regular expressions were active.

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