67. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 5/10/2019 1:00:06 PM Eastern 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.

67.1 Files compared

# Location File Last Modified
1 CPRS_v32_64_P2.zip\OR_30_405V64_SRC.zip fFrame.pas Wed Apr 3 19:32:14 2019 UTC
2 CPRS_v32_64_P2.zip\OR_30_405V64_SRC.zip fFrame.pas Thu May 9 14:02:57 2019 UTC

67.2 Comparison summary

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

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

67.4 Active regular expressions

No regular expressions were active.

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