64. EPMO Open Source Coordination Office Redaction File Detail Report

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

64.1 Files compared

# Location File Last Modified
1 C:\AraxisMergeCompare\Pri_un\CPRS_32_P2_PCE\OR_30_405V60_SRC fFrame.pas Wed Dec 12 14:04:36 2018 UTC
2 C:\AraxisMergeCompare\Pri_re\CPRS v32 P2 PCE Standardization-redacted\CPRS_32_P2_PCE\OR_30_405V60_SRC fFrame.pas Tue Apr 16 15:14:56 2019 UTC

64.2 Comparison summary

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

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

64.4 Active regular expressions

No regular expressions were active.

64.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       FCCOWJ ustJoined:  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     FCCOWJus tJoined :=  False;
  1009     if not ( ParamSearc h('CCOW')= 'DISABLE')  then
  1010       try
  1011         Star tCCOWConte xtor;
  1012         FCCO WJustJoine d := True;
  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     end;
  1690     lstCIRNL ocations.V isible :=  False;
  1691     pnlCIRN. BevelOuter  := bvRais ed;
  1692     lstCIRNL ocations.S endToBack;
  1693     mnuFileP rint.Enabl ed := Fals e;            // let  individual  page enab le this
  1694     mnuFileP rintSetup. Enabled :=  False;       // let  individual  page enab le this
  1695     mnuFileP rintSelect edItems.En abled := F alse;
  1696     FLastPag e := NewFo rm;
  1697     if NewFo rm <> nil  then
  1698     begin
  1699       if New Form.Name  = frmNotes .Name then  frmNotes. Align := a lClient
  1700         else  frmNotes. Align := a lNone;
  1701       if New Form.Name  = frmConsu lts.Name t hen frmCon sults.Alig n := alCli ent
  1702         else  frmConsul ts.Align : = alNone;
  1703       if New Form.Name  = frmRepor ts.Name th en frmRepo rts.Align  := alClien t
  1704         else  frmReport s.Align :=  alNone;
  1705       if New Form.Name  = frmDCSum m.Name the n frmDCSum m.Align :=  alClient
  1706         else  frmDCSumm .Align :=  alNone;
  1707       if Ass igned(frmS urgery) th en
  1708         if N ewForm.Nam e = frmSur gery.Name  then frmSu rgery.Alig n := alcli ent
  1709           el se frmSurg ery.Align  := alNone;
  1710       NewFor m.BringToF ront;                      // to  cause tab  switch to  happen im mediately
  1711       Applic ation.Proc essMessage s;
  1712       PostMe ssage(Hand le, UM_SHO WPAGE, 0,  0);  // th is calls D isplayPage  for the f orm
  1713     end;
  1714   end;
  1715  
  1716   procedure  TfrmFrame. mnuDebugRe portClick( Sender: TO bject);
  1717   begin
  1718     inherite d;
  1719     if not A ssigned(fr mDebugRepo rt) then f rmDebugRep ort := Tfr mDebugRepo rt.Create( self);
  1720      frmDebu gReport.Sh ow;
  1721   end;
  1722  
  1723   procedure  TfrmFrame. mnuChartTa bClick(Sen der: TObje ct);
  1724   { use the  Tag proper ty of the  menu item  to switch  to proper  page }
  1725   begin
  1726     with Sen der as TMe nuItem do  tabPage.Ta bIndex :=  PageIDToTa b(Tag);
  1727     LastTab  := TabToPa geID(tabPa ge.TabInde x) ;
  1728     tabPageC hange(tabP age);
  1729   end;
  1730  
  1731   procedure  TfrmFrame. tabPageCha nge(Sender : TObject) ;
  1732   { switches  to form l inked to N ewTab }
  1733   var
  1734     PageID :  integer;
  1735   begin
  1736     PageID : = TabToPag eID((sende r as TTabC ontrol).Ta bIndex);
  1737     if (Page ID <> CT_N OPAGE) and  (TabPage. CanFocus)  and Assign ed(FLastPa ge) and
  1738        (not  TabPage.Fo cused) the n
  1739       TabPag e.SetFocus ;  //CQ: 1 4854
  1740     if (not  User.IsRep ortsOnly)  then
  1741     begin
  1742       case P ageID of
  1743         CT_N OPAGE:   S witchToPag e(nil);
  1744         CT_C OVER:    S witchToPag e(frmCover Sheet);
  1745         CT_P ROBLEMS: S witchToPag e(frmProbl ems);
  1746         CT_M EDS:     S witchToPag e(frmMeds) ;
  1747         CT_O RDERS:   S witchToPag e(frmOrder s);
  1748         CT_N OTES:    S witchToPag e(frmNotes );
  1749         CT_C ONSULTS: S witchToPag e(frmConsu lts);
  1750         CT_D CSUMM:   S witchToPag e(frmDCSum m);
  1751         CT_S URGERY:  S witchToPag e(frmSurge ry);
  1752         CT_L ABS:     S witchToPag e(frmLabs) ;
  1753         CT_R EPORTS:  S witchToPag e(frmRepor ts);
  1754       end; { case}
  1755     end
  1756     else //  Reports On ly tab.
  1757       Switch ToPage(frm Reports);
  1758     if Scree nReaderSys temActive  and FCtrlT abUsed the n
  1759       SpeakP atient;
  1760     Changing Tab := Pag eID;
  1761   end;
  1762  
  1763   function T frmFrame.P ageIDToTab (PageID: I nteger): I nteger;
  1764   { returns  the tab in dex that c orresponds  to a give n PageID }
  1765   VAR
  1766     i: integ er;
  1767   begin
  1768     i :=  uT abList.Ind exOf(IntTo Str(PageID ));
  1769     Result : = i;
  1770   end;
  1771  
  1772   function T frmFrame.T abToPageID (Tab: Inte ger): Inte ger;
  1773   { returns  the consta nt that id entifies t he page gi ven a TabI ndex }
  1774   begin
  1775     if (Tab  > -1) and  (Tab < uTa bList.Coun t) then
  1776       Result  := StrToI ntDef(uTab List[Tab],  CT_UNKNOW N)
  1777     else
  1778       Result  := CT_NOP AGE;
  1779   end;
  1780  
  1781   { File Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  1782  
  1783   procedure  TfrmFrame. SetupPatie nt(AFlagge dList : TS tringList) ;
  1784   var
  1785     AMsg, Se lectMsg: s tring;
  1786     ShortStr ,
  1787     LongStr1 , LongStr2 ,
  1788     LocalMsg : String;   // rpk 2/ 28/2018
  1789   begin
  1790     with Pat ient do
  1791     begin
  1792       ClearP atient;  / / must be  called to  avoid leav ing previo us patient 's informa tion visib le!
  1793       btnCom batVet.Cap tion := 'C V '+ Comba tVet.Expir ationDate;
  1794       btnCom batVet.Vis ible := Pa tient.Comb atVet.IsEl igible;
  1795       Visibl e := True;
  1796       Applic ation.Proc essMessage s;
  1797       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 .
  1798       lblPtS SN.Caption  := SSN;
  1799       lblPtA ge.Caption  := Format FMDateTime ('mmm dd,y yyy', DOB)  + ' (' +  IntToStr(A ge) + ')';
  1800       pnlPat ient.Capti on := lblP tName.Capt ion + ' '  + lblPtSSN .Caption +  ' ' + lbl PtAge.Capt ion;
  1801  
  1802       if get OTHD(Patie nt.DFN, Pa tient.Name , ShortStr , Longstr1 , LongStr2 , LocalMsg ) then beg in  // rpk  1/2/2018
  1803         pnlO THD.Show;  // rpk 12/ 6/2017
  1804         pnlO THD.Enable d := True;  // rpk 12 /6/2017
  1805         pnlO THD.TabSto p := True;  // rpk 1/ 18/2018
  1806         lblO THD.Enable d := True;  // rpk 1/ 2/2018
  1807         lblO THDTitle.E nabled :=  True;  //  rpk 12/6/2 017
  1808         pnlO THD.Hint : = 'Other t han Honora ble: ' + L ongStr1 +  CRLF + Lon gStr2;
  1809         if L ocalMsg >  '' then
  1810           pn lOTHD.Hint  := pnlOTH D.Hint + C RLF + Loca lMsg;  //  rpk 2/28/2 018
  1811         OTHD ShortStr : = ShortStr ;
  1812         OTHD LongStr1 : = LongStr1 ;
  1813         OTHD LongStr2 : = LongStr2 ;
  1814         OTHD LocalMsg : = LocalMsg ;  // rpk  2/28/2018
  1815         if S creenReade rActive th en begin   // rpk 1/2 /2018
  1816           lb lOTHD.Capt ion := Lon gStr1 + '  ' + LongSt r2;
  1817         end
  1818         else  begin
  1819           lb lOTHD.TabS top := Fal se;
  1820           lb lOTHD.Capt ion := Sho rtstr; //  rpk 12/6/2 017
  1821           lb lOTHD.Hint  := LongSt r1 + CRLF  + LongStr2 ;
  1822         end;
  1823       end; / / rpk 1/2/ 2018
  1824  
  1825       if Len gth(CWAD)  > 0
  1826         then  lblPtPost ings.Capti on := 'Pos tings'
  1827         else  lblPtPost ings.Capti on := 'No  Postings';
  1828       lblPtC WAD.Captio n := CWAD;
  1829       pnlPos tings.Capt ion := lbl PtPostings .Caption +  ' ' + lbl PtCWAD.Cap tion;
  1830       if (Le ngth(Prima ryTeam) >  0) or (Len gth(Primar yProvider)  > 0) then
  1831       begin
  1832         lblP tCare.Capt ion := Pri maryTeam;
  1833         if P rimaryProv ider <> ''  then lblP tCare.Capt ion := lbl PtCare.Cap tion + ' /  ' + Mixed Case(Prima ryProvider );
  1834         if L ength(Asso ciate)>0 t hen lblPtC are.Captio n :=  lblP tCare.Capt ion + ' /  ' + MixedC ase(Associ ate);
  1835       end;
  1836       if Len gth(Attend ing) > 0 t hen lblPtA ttending.C aption :=  '(Inpatien t) Attendi ng:  ' + M ixedCase(A ttending);
  1837       pnlPri maryCare.C aption :=  lblPtCare. Caption +  ' ' + lblP tAttending .Caption;
  1838       if Len gth(InProv ider) > 0   then lblP tAttending .Caption : = lblPtAtt ending.Cap tion + ' -  (Inpatien t) Provide r: ' + Mix edCase(InP rovider);
  1839       if Len gth(MHTC)  > 0 then l blPtMHTC.C aption :=  'MH Treatm ent Coordi nator: ' +  MixedCase (MHTC);
  1840       if (Le ngth(MHTC)  = 0) and  (Inpatient  = True) a nd (Specia ltySvc = ' P') then
  1841         lblP tMHTC.Capt ion := 'MH  Treatment  Coordinat or Unassig ned';
  1842       pnlPri maryCare.C aption :=  lblPtCare. Caption +  ' ' + lblP tAttending .Caption +  ' ' + lbl PtMHTC.Cap tion;
  1843       SetUpC IRN;
  1844       Displa yEncounter Text;
  1845       SetSha reNode(DFN , Handle);
  1846       with P atient do
  1847         Noti fyOtherApp s(NAE_NEWP T, SSN + U  + FloatTo Str(DOB) +  U + Name) ;
  1848       Select Msg := '';
  1849       if Mea nsTestRequ ired(Patie nt.DFN, AM sg) then S electMsg : = AMsg;
  1850       if Has LegacyData (Patient.D FN, AMsg)      then S electMsg : = SelectMs g + CRLF +  AMsg;
  1851  
  1852       HasAct iveFlg(Fla gList, Has Flag, Pati ent.DFN);
  1853       if Has Flag then  begin
  1854         txtC mdFlags.Vi sible := f alse;
  1855         pnlF lag.Enable d := True;
  1856         lblF lag.Font.C olor := Ge t508Compli antColor(c lMaroon);
  1857         lblF lag.Enable d := True;
  1858         if ( not FReFre shing) and  (TriggerP RFPopUp(Pa tient.DFN) ) then
  1859           Sh owFlags;
  1860       end el se begin
  1861         txtC mdFlags.Vi sible := S creenReade rSystemAct ive;
  1862         pnlF lag.Enable d := False ;
  1863         lblF lag.Font.C olor := cl BtnFace;
  1864         lblF lag.Enable d := False ;
  1865       end;
  1866       FPrevP tID := pat ient.DFN;
  1867       { frmC over.Updat eVAAButton ; //VAA CQ 7525  (mov ed here in  v26.30 (R V))}
  1868       Update VAAMHVButt ons(nil);
  1869       pnlOTH D.Left :=  paVAA.Left  - pnlOTHD .Width;  / / reset OT H button t o left of  VAA, rpk 8 /3/2018
  1870       Proces sPatientCh angeEventH ook;
  1871       if Len gth(Select Msg) > 0 t hen ShowPa tientSelec tMessages( SelectMsg) ;
  1872     end;
  1873   end;  // S etupPatien t
  1874  
  1875   procedure  TfrmFrame. mnuFileNex tClick(Sen der: TObje ct);
  1876   var
  1877     SaveDFN,  NewDFN: s tring; //  *DFN*
  1878     NextInde x: Integer ;
  1879     Reason:  string;
  1880     CCOWResp onse: User Response;
  1881     AccessSt atus: inte ger;
  1882  
  1883       proced ure Update PatientInf oForAlert;
  1884       begin
  1885         if P atient.Inp atient the n begin
  1886           En counter.In patient :=  True;
  1887           En counter.Lo cation :=  Patient.Lo cation;
  1888           En counter.Da teTime :=  Patient.Ad mitTime;
  1889           En counter.Vi sitCategor y := 'H';
  1890         end;
  1891         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  1892         Setu pPatient(F laggedPTLi st);
  1893         if ( FlaggedPTL ist.IndexO f(Patient. DFN) < 0)  then
  1894           Fl aggedPTLis t.Add(Pati ent.DFN);
  1895       end;
  1896  
  1897       proced ure report Notificati onFollowUp Text;
  1898       var
  1899         sl:  TStrings;
  1900       begin
  1901         sl : = TStringL ist.Create ;
  1902         try
  1903           se tNotificat ionFollowU pText(sl,  Patient.DF N, Notific ations.Fol lowUp,
  1904              Notificati ons.AlertD ata);
  1905           Re portBox(sl , Pieces(P iece(Notif ications.R ecordID, U , 1), ':',  2,
  1906              3), True);
  1907         fina lly
  1908           sl .Free;
  1909         end;
  1910       end;
  1911  
  1912   begin
  1913     DoNotCha ngeEncWind ow := Fals e;
  1914     OrderPri ntForm :=  False;
  1915     mnuFile. Tag := 0;
  1916     SaveDFN  := Patient .DFN;
  1917     Notifica tions.Next ;
  1918     if Notif ications.A ctive then
  1919     begin
  1920       NewDFN  := Notifi cations.DF N;
  1921       if Sav eDFN <> Ne wDFN then
  1922       begin
  1923         // n ewdfn does  not have  new patien t.co infor mation for  CCOW call
  1924         if ( (Sender =  mnuFileOpe n) or (All owContextC hangeAll(R eason)))
  1925              and AllowA ccessToSen sitivePati ent(NewDFN , AccessSt atus) then
  1926         begi n
  1927           Re mindersSta rted := FA LSE;
  1928           Pa tient.DFN  := NewDFN;
  1929           En counter.Cl ear;
  1930           Ch anges.Clea r;
  1931           if  Assigned( FlagList)  then
  1932           be gin
  1933            F lagList.Cl ear;
  1934            H asFlag :=  False;
  1935            H asActiveFl g(FlagList , HasFlag,  NewDFN);
  1936           en d;
  1937           if  FCCOWInst alled and  (ctxContex tor.State  = csPartic ipating) t hen
  1938              begin
  1939                if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n
  1940                  Update PatientInf oForAlert
  1941                else
  1942                  begin
  1943                    case  CCOWRespo nse of
  1944                      ur Cancel:
  1945                         begin
  1946                           Patient. DFN := Sav eDFN;
  1947                           Notifica tions.Prio r;
  1948                           Exit;
  1949                         end;
  1950                      ur Break:
  1951                         begin
  1952                           // do no t revert t o old DFN  if context  was manua lly broken  by user -  v26 (RV)
  1953                           if (ctxC ontextor.S tate = csP articipati ng) then P atient.DFN  := SaveDF N;
  1954                           UpdatePa tientInfoF orAlert;
  1955                         end;
  1956                      el se
  1957                         UpdatePati entInfoFor Alert;
  1958                    end;
  1959                  end;
  1960              end
  1961           el se
  1962              UpdatePati entInfoFor Alert
  1963         end  else
  1964         begi n
  1965           if  AccessSta tus in [DG SR_ASK, DG SR_DENY] t hen
  1966           be gin
  1967              Notificati ons.Clear;
  1968              // hide th e 'next no tification ' button
  1969              FNextButto nActive :=  False;
  1970              FNextButto n.Free;
  1971              FNextButto n := nil;
  1972              mnuFileNex t.Enabled  := False;
  1973              mnuFileNot ifRemove.E nabled :=  False;
  1974              Patient.DF N := '';
  1975              mnuFileOpe nClick(mnu FileNext);
  1976              exit;
  1977           en d
  1978           el se
  1979           if  SaveDFN < > '' then
  1980           be gin
  1981              Patient.DF N := SaveD FN;
  1982              Notificati ons.Prior;
  1983              Exit;
  1984           en d
  1985           el se
  1986           be gin
  1987              Notificati ons.Clear;
  1988              Patient.DF N := '';
  1989              mnuFileOpe nClick(mnu FileNext);
  1990              exit;
  1991           en d;
  1992         end;
  1993       end;
  1994       stsAre a.Panels.I tems[1].Te xt := Noti fications. Text;
  1995       FChang eSource :=  CC_NOTIFI CATION;
  1996       NextIn dex := Pag eIDToTab(C T_COVER);
  1997       tabPag e.TabIndex  := CT_NOP AGE;
  1998       tabPag eChange(ta bPage);
  1999       mnuFil eNotifRemo ve.Enabled  := Notifi cations.Fo llowup in  [NF_FLAGGE D_ORDERS,
  2000                                                                      NF_ORDER_ REQUIRES_E LEC_SIGNAT URE,
  2001                                                                      NF_MEDICA TIONS_EXPI RING_INPT,
  2002                                                                      NF_MEDICA TIONS_EXPI RING_OUTPT ,
  2003                                                                      NF_UNVERI FIED_MEDIC ATION_ORDE R,
  2004                                                                      NF_UNVERI FIED_ORDER ,
  2005                                                                      NF_FLAGGE D_OI_EXP_I NPT,
  2006                                                                      NF_FLAGGE D_OI_EXP_O UTPT];
  2007       case N otificatio ns.FollowU p of
  2008         NF_L AB_RESULTS                     :  NextIndex  := PageID ToTab(CT_L ABS);
  2009         NF_F LAGGED_ORD ERS                 :  NextIndex  := PageID ToTab(CT_O RDERS);
  2010         NF_O RDER_REQUI RES_ELEC_S IGNATURE :  NextIndex  := PageID ToTab(CT_O RDERS);
  2011         NF_A BNORMAL_LA B_RESULTS           :  NextIndex  := PageID ToTab(CT_L ABS);
  2012         NF_I MAGING_RES ULTS                :  NextIndex  := PageID ToTab(CT_R EPORTS);
  2013         NF_C ONSULT_REQ UEST_RESOL UTION    :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  2014         NF_A BNORMAL_IM AGING_RESU LTS      :  NextIndex  := PageID ToTab(CT_R EPORTS);
  2015         NF_I MAGING_REQ UEST_CANCE L_HELD   :  NextIndex  := PageID ToTab(CT_O RDERS);
  2016         NF_N EW_SERVICE _CONSULT_R EQUEST   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  2017         NF_C ONSULT_REQ UEST_CANCE L_HOLD   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  2018         NF_P ROSTHETICS _REQUEST_U PDATED   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  2019         NF_S ITE_FLAGGE D_RESULTS           :  NextIndex  := PageID ToTab(CT_O RDERS);
  2020         NF_O RDERER_FLA GGED_RESUL TS       :  NextIndex  := PageID ToTab(CT_O RDERS);
  2021         NF_O RDER_REQUI RES_COSIGN ATURE    :  NextIndex  := PageID ToTab(CT_O RDERS);
  2022         NF_L AB_ORDER_C ANCELED             :  NextIndex  := PageID ToTab(CT_O RDERS);
  2023         NF_S TAT_RESULT S                   :
  2024           if  Piece(Pie ce(Notific ations.Ale rtData, '| ', 2), '@' , 2) = 'LR CH' then
  2025              NextIndex  := PageIDT oTab(CT_LA BS)
  2026           el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2)  = 'GMRC' t hen
  2027              NextIndex  := PageIDT oTab(CT_CO NSULTS)
  2028           el se if Piec e(Piece(No tification s.AlertDat a, '|', 2) , '@', 2)  = 'RA' the n
  2029              NextIndex  := PageIDT oTab(CT_RE PORTS);
  2030         NF_D NR_EXPIRIN G                   :  NextIndex  := PageID ToTab(CT_O RDERS);
  2031         NF_M EDICATIONS _EXPIRING_ INPT     :  NextIndex  := PageID ToTab(CT_O RDERS);
  2032         NF_M EDICATIONS _EXPIRING_ OUTPT    :  NextIndex  := PageID ToTab(CT_O RDERS);
  2033         NF_U NVERIFIED_ MEDICATION _ORDER   :  NextIndex  := PageID ToTab(CT_O RDERS);
  2034         NF_R X_RENEWAL_ REQUEST             :
  2035           be gin
  2036              if (Notifi cations.Al ertData =  '') then
  2037              begin
  2038                Notifica tions.Dele te;
  2039              end;
  2040              NextIndex  := PageIDT oTab(CT_OR DERS);
  2041           en d;
  2042         NF_L APSED_ORDE R                   :  NextIndex  := PageID ToTab(CT_O RDERS);
  2043         NF_N EW_ALLERGY _CONFLICT_ ORDER    :  NextIndex  := PageID ToTab(CT_O RDERS); //  NJC
  2044         NF_H IRISK_ORDE R                   :  NextIndex  := PageID ToTab(CT_O RDERS);
  2045         NF_N EW_ORDER                       :  NextIndex  := PageID ToTab(CT_O RDERS);
  2046         NF_I MAGING_RES ULTS_AMEND ED       :  NextIndex  := PageID ToTab(CT_R EPORTS);
  2047         NF_C RITICAL_LA B_RESULTS           :  NextIndex  := PageID ToTab(CT_L ABS);
  2048         NF_U NVERIFIED_ ORDER               :  NextIndex  := PageID ToTab(CT_O RDERS);
  2049         NF_F LAGGED_OI_ RESULTS             :  NextIndex  := PageID ToTab(CT_O RDERS);
  2050         NF_F LAGGED_OI_ ORDER               :  NextIndex  := PageID ToTab(CT_O RDERS);
  2051         NF_F LAGGED_ORD ERS_COMMEN TS       :  NextIndex  := PageID ToTab(CT_O RDERS); //  NSR#20110 719
  2052         NF_D C_ORDER                        :  NextIndex  := PageID ToTab(CT_O RDERS);
  2053         NF_D EA_AUTO_DC _CS_MED_OR DER      :  NextIndex  := PageID ToTab(CT_O RDERS);
  2054         NF_D EA_CERT_RE VOKED               :  NextIndex  := PageID ToTab(CT_O RDERS);
  2055         NF_C ONSULT_UNS IGNED_NOTE          :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  2056         NF_D CSUMM_UNSI GNED_NOTE           :  NextIndex  := PageID ToTab(CT_D CSUMM);
  2057         NF_N OTES_UNSIG NED_NOTE            :  NextIndex  := PageID ToTab(CT_N OTES);
  2058         NF_C ONSULT_REQ UEST_UPDAT ED       :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  2059         NF_F LAGGED_OI_ EXP_INPT            :  NextIndex  := PageID ToTab(CT_O RDERS);
  2060         NF_F LAGGED_OI_ EXP_OUTPT           :  NextIndex  := PageID ToTab(CT_O RDERS);
  2061         NF_C ONSULT_PRO C_INTERPRE TATION   :  NextIndex  := PageID ToTab(CT_C ONSULTS);
  2062         NF_I MAGING_REQ UEST_CHANG ED       :
  2063           be gin
  2064              ReportNoti ficationFo llowUpText ;
  2065              Notificati ons.Delete ;
  2066           en d;
  2067         NF_L AB_THRESHO LD_EXCEEDE D        :  NextIndex  := PageID ToTab(CT_L ABS);
  2068         NF_M AMMOGRAM_R ESULTS              :  NextIndex  := PageID ToTab(CT_R EPORTS);
  2069         NF_P AP_SMEAR_R ESULTS              :  NextIndex  := PageID ToTab(CT_R EPORTS);
  2070         NF_A NATOMIC_PA THOLOGY_RE SULTS    :  NextIndex  := PageID ToTab(CT_R EPORTS);
  2071         NF_S URGERY_UNS IGNED_NOTE          :  if TabExi sts(CT_SUR GERY) then
  2072                                                  NextInd ex := Page IDToTab(CT _SURGERY)
  2073                                                else
  2074                                                  InfoBox (TX_NO_SUR G_NOTIF, T C_NO_SURG_ NOTIF, MB_ OK);
  2075  
  2076       else
  2077       begin
  2078         if I sSmartAler t(Notifica tions.Foll owUp) then  NextIndex  := PageID ToTab(CT_N OTES)
  2079         else  InfoBox(T X_UNK_NOTI F, TC_UNK_ NOTIF, MB_ OK);
  2080       end;
  2081       end; / /case
  2082  
  2083       tabPag e.TabIndex  := NextIn dex;
  2084       tabPag eChange(ta bPage);
  2085  
  2086     end
  2087     else mnu FileOpenCl ick(mnuFil eNext); // case else
  2088   end;
  2089  
  2090   procedure  TfrmFrame. SetBADxLis t;
  2091   var
  2092     i: small int;
  2093   begin
  2094     if not A ssigned(UB AGlobals.t empDxList)  then
  2095        begin
  2096        UBAGl obals.temp DxList :=  TList.Crea te;
  2097        UBAGl obals.temp DxList.Cou nt := 0;
  2098        Appli cation.Pro cessMessag es;
  2099        end
  2100     else
  2101        begin
  2102        //Kil l the old  Dx list
  2103        for i  := 0 to p red(UBAGlo bals.tempD xList.Coun t) do
  2104           TO bject(UBAG lobals.tem pDxList[i] ).Free;
  2105  
  2106        UBAGl obals.temp DxList.Cle ar;
  2107        Appli cation.Pro cessMessag es;
  2108  
  2109        //Cre ate new Dx  list for  newly sele cted patie nt
  2110         if n ot Assigne d(UBAGloba ls.tempDxL ist) then
  2111            b egin
  2112            U BAGlobals. tempDxList  := TList. Create;
  2113            U BAGlobals. tempDxList .Count :=  0;
  2114            A pplication .ProcessMe ssages;
  2115            e nd;
  2116        end;
  2117   end;
  2118  
  2119   procedure  TfrmFrame. mnuFileOpe nClick(Sen der: TObje ct);
  2120   { select a  new patie nt & updat e the head er display s (patient  id, encou nter, post ings) }
  2121   var
  2122     SaveDFN,  Reason: s tring;
  2123     ok, OldR emindersSt arted, PtS elCancelle d: Boolean ;
  2124     CCOWResp onse: User Response;
  2125     ThisSess ionChanges : TChanges ;
  2126     i: Integ er;
  2127   begin
  2128     pnlPatie nt.Enabled  := FALSE;
  2129     if (Send er = mnuFi leOpen) or  (FRefresh ing) then
  2130       PTSwit chRefresh  := True
  2131     else
  2132       PTSwit chRefresh  := FALSE;  // part of  a change  to CQ #115 29
  2133     PtSelCan celled :=  FALSE;
  2134     if not F Refreshing  then
  2135       mnuFil e.Tag := 0
  2136     else
  2137       mnuFil e.Tag := 1 ;
  2138     Determin eNextTab;
  2139     // if Se nder <> mn uFileNext  then         //CQ 162 73 & 16419  - Missing  Review/Si gn Changes  dialog wh en clickin g 'Next' b utton.
  2140     ThisSess ionChanges  := TChang es.Create;
  2141     try
  2142       // Loo p through  and add in  the docum ents
  2143       for i  := 0 to Ch anges.Docu ments.Coun t - 1 do
  2144         begi n
  2145           Th isSessionC hanges.Add (CH_DOC,
  2146              TChangeIte m(Changes. Documents. Items[i]). ID,
  2147              TChangeIte m(Changes. Documents. Items[i]). Text,
  2148              TChangeIte m(Changes. Documents. Items[i]). GroupName,
  2149              TChangeIte m(Changes. Documents. Items[i]). SignState,
  2150              TChangeIte m(Changes. Documents. Items[i]). ParentID,
  2151              TChangeIte m(Changes. Documents. Items[i]). User,
  2152              TChangeIte m(Changes. Documents. Items[i]). OrderDG,
  2153              TChangeIte m(Changes. Documents. Items[i]). DCOrder,
  2154              TChangeIte m(Changes. Documents. Items[i]). Delay);
  2155         end;
  2156       // Loo p through  and add in  the order s
  2157       for i  := 0 to Ch anges.Orde rs.Count -  1 do
  2158         begi n
  2159           Th isSessionC hanges.Add (CH_ORD,
  2160              TChangeIte m(Changes. Orders.Ite ms[i]).ID,
  2161              TChangeIte m(Changes. Orders.Ite ms[i]).Tex t,
  2162              TChangeIte m(Changes. Orders.Ite ms[i]).Gro upName,
  2163              TChangeIte m(Changes. Orders.Ite ms[i]).Sig nState,
  2164              TChangeIte m(Changes. Orders.Ite ms[i]).Par entID,
  2165              TChangeIte m(Changes. Orders.Ite ms[i]).Use r,
  2166              TChangeIte m(Changes. Orders.Ite ms[i]).Ord erDG,
  2167              TChangeIte m(Changes. Orders.Ite ms[i]).DCO rder,
  2168              TChangeIte m(Changes. Orders.Ite ms[i]).Del ay);
  2169         end;
  2170       // Loo p through  and add in  PCE
  2171       for i  := 0 to Ch anges.PCE. Count - 1  do
  2172         begi n
  2173           Th isSessionC hanges.Add (CH_PCE,
  2174              TChangeIte m(Changes. PCE.Items[ i]).ID,
  2175              TChangeIte m(Changes. PCE.Items[ i]).Text,
  2176              TChangeIte m(Changes. PCE.Items[ i]).GroupN ame,
  2177              TChangeIte m(Changes. PCE.Items[ i]).SignSt ate,
  2178              TChangeIte m(Changes. PCE.Items[ i]).Parent ID,
  2179              TChangeIte m(Changes. PCE.Items[ i]).User,
  2180              TChangeIte m(Changes. PCE.Items[ i]).OrderD G,
  2181              TChangeIte m(Changes. PCE.Items[ i]).DCOrde r,
  2182              TChangeIte m(Changes. PCE.Items[ i]).Delay) ;
  2183         end;
  2184       if not  AllowCont extChangeA ll(Reason)  then
  2185         begi n
  2186           pn lPatient.E nabled :=  True;
  2187           //  If this i s cancelle d then rel oad this s essions ch anges.
  2188           Ch anges.Clea r;
  2189           //  Loop thro ugh and ad d in the d ocuments
  2190           fo r i := 0 t o ThisSess ionChanges .Documents .Count - 1  do
  2191              begin
  2192                Changes. Add(CH_DOC ,
  2193                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).ID,
  2194                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).Text,
  2195                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).Group Name,
  2196                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).SignS tate,
  2197                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).Paren tID,
  2198                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).User,
  2199                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).Order DG,
  2200                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).DCOrd er,
  2201                  TChang eItem(This SessionCha nges.Docum ents.Items [i]).Delay );
  2202              end;
  2203           //  Loop thro ugh and ad d in the o rders
  2204           fo r i := 0 t o ThisSess ionChanges .Orders.Co unt - 1 do
  2205              begin
  2206                Changes. Add(CH_ORD , TChangeI tem(ThisSe ssionChang es.Orders. Items[i]). ID,
  2207                  TChang eItem(This SessionCha nges.Order s.Items[i] ).Text,
  2208                  TChang eItem(This SessionCha nges.Order s.Items[i] ).GroupNam e,
  2209                  TChang eItem(This SessionCha nges.Order s.Items[i] ).SignStat e,
  2210                  TChang eItem(This SessionCha nges.Order s.Items[i] ).ParentID ,
  2211                  TChang eItem(This SessionCha nges.Order s.Items[i] ).User,
  2212                  TChang eItem(This SessionCha nges.Order s.Items[i] ).OrderDG,
  2213                  TChang eItem(This SessionCha nges.Order s.Items[i] ).DCOrder,
  2214                  TChang eItem(This SessionCha nges.Order s.Items[i] ).Delay);
  2215              end;
  2216           //  Loop thro ugh and ad d in PCE
  2217           fo r i := 0 t o ThisSess ionChanges .PCE.Count  - 1 do
  2218              begin
  2219                Changes. Add(CH_PCE , TChangeI tem(ThisSe ssionChang es.PCE.Ite ms[i]).ID,
  2220                  TChang eItem(This SessionCha nges.PCE.I tems[i]).T ext,
  2221                  TChang eItem(This SessionCha nges.PCE.I tems[i]).G roupName,
  2222                  TChang eItem(This SessionCha nges.PCE.I tems[i]).S ignState,
  2223                  TChang eItem(This SessionCha nges.PCE.I tems[i]).P arentID,
  2224                  TChang eItem(This SessionCha nges.PCE.I tems[i]).U ser,
  2225                  TChang eItem(This SessionCha nges.PCE.I tems[i]).O rderDG,
  2226                  TChang eItem(This SessionCha nges.PCE.I tems[i]).D COrder,
  2227                  TChang eItem(This SessionCha nges.PCE.I tems[i]).D elay);
  2228              end;
  2229           ex it;
  2230         end;
  2231     finally
  2232       ThisSe ssionChang es.Clear;
  2233       ThisSe ssionChang es.Free;
  2234     end;
  2235     // updat e status t ext here
  2236     stsArea. Panels.Ite ms[1].Text  := '';
  2237     if (not  User.IsRep ortsOnly)  then
  2238       begin
  2239         if n ot FRefres hing then
  2240           be gin
  2241              Notificati ons.Next;  // avoid p rompt if n o more ale rts select ed to proc ess  {v14a  RV}
  2242              if Notific ations.Act ive then
  2243                begin
  2244                  if (in foBox(TX_N OTIF_STOP,  TC_NOTIF_ STOP, MB_Y ESNO) = ID _NO) then
  2245                    begi n
  2246                      No tification s.Prior;
  2247                      pn lPatient.E nabled :=  True;
  2248                      ex it;
  2249                    end;
  2250                end;
  2251              if Notific ations.Act ive then
  2252                Notifica tions.Prio r;
  2253           en d;
  2254       end;
  2255  
  2256     if FNoPa tientSelec ted then
  2257       SaveDF N := ''
  2258     else
  2259       SaveDF N := Patie nt.DFN;
  2260  
  2261     OldRemin dersStarte d := Remin dersStarte d;
  2262     Reminder sStarted : = FALSE;
  2263     try
  2264       if FRe freshing t hen
  2265         begi n
  2266           Up datePtInfo OnRefresh;
  2267           ok  := True;
  2268         end
  2269       else
  2270         begi n
  2271           ok  := FALSE;
  2272           if  (not User .IsReports Only) then
  2273              begin
  2274                if FCCOW Installed  and (ctxCo ntextor.St ate = csPa rticipatin g) then
  2275                  begin
  2276                    Upda teCCOWCont ext;
  2277                    if n ot FCCOWEr ror then
  2278                      be gin
  2279                         FCCOWIconN ame := 'BM P_CCOW_LIN KED';
  2280                         pnlCCOW.Hi nt := TX_C COW_LINKED ;
  2281                         imgCCOW.Pi cture.Bitm ap.LoadFro mResourceN ame(hInsta nce, FCCOW IconName);
  2282                      en d;
  2283                  end
  2284                else
  2285                  begin
  2286                    FCCO WIconName  := 'BMP_CC OW_BROKEN' ;
  2287                    pnlC COW.Hint : = TX_CCOW_ BROKEN;
  2288                    imgC COW.Pictur e.Bitmap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  2289                  end;
  2290                if (Pati ent.DFN =  '') or (Se nder = mnu FileOpen)  or (Sender  = mnuFile Next) or ( Sender = m nuViewDemo ) then
  2291                  Select Patient(SH OW_NOTIFIC ATIONS, Fo nt.Size, P tSelCancel led);
  2292                if PtSel Cancelled  then
  2293                  begin
  2294                    pnlP atient.Ena bled := Tr ue;
  2295                    exit ;
  2296                  end;
  2297                ShowEver ything;
  2298                // HideE verything( 'Retrievin g informat ion - plea se wait... .');  //v2 7 (pending ) RV
  2299                DisplayE ncounterTe xt;
  2300                FPrevInP atient :=  Patient.In patient;
  2301                if Notif ications.A ctive then
  2302                  begin
  2303                    // d isplay 'ne xt notific ation' but ton
  2304                    SetU pNextButto n;
  2305                    FNex tButtonAct ive := Tru e;
  2306                    mnuF ileNext.En abled := T rue;
  2307                    mnuF ileNextCli ck(mnuFile Open);
  2308                  end
  2309                else
  2310                  begin
  2311                    // h ide the 'n ext notifi cation' bu tton
  2312                    FNex tButtonAct ive := FAL SE;
  2313                    FNex tButton.Fr ee;
  2314                    FNex tButton :=  nil;
  2315                    mnuF ileNext.En abled := F ALSE;
  2316                    mnuF ileNotifRe move.Enabl ed := FALS E;
  2317                    //if  Patient.D FN <> Save DFN then
  2318                    // r emoved, to o many thi ngs happen ing, just  refresh th e patient.
  2319                    ok : = True;
  2320                  end
  2321              end
  2322           el se
  2323              begin
  2324                Notifica tions.Clea r;
  2325                SelectPa tient(FALS E, Font.Si ze, PtSelC ancelled);  // Call P t. Sel. w/ o notifica tions.
  2326                if PtSel Cancelled  then
  2327                  exit;
  2328                ShowEver ything;
  2329                DisplayE ncounterTe xt;
  2330                FPrevInP atient :=  Patient.In patient;
  2331                ok := Tr ue;
  2332              end;
  2333         end;
  2334       if ok  then
  2335         begi n
  2336           if  FCCOWInst alled and  (ctxContex tor.State  = csPartic ipating) a nd (not FR efreshing)  and (not  FCCOWJustJ oined) the n
  2337              begin
  2338                if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n
  2339                  begin
  2340                    Setu pPatient;
  2341                    tabP age.TabInd ex := Page IDToTab(Ne xtTab);
  2342                    tabP ageChange( tabPage);
  2343                  end
  2344                else
  2345                  begin
  2346                    case  CCOWRespo nse of
  2347                      ur Cancel:
  2348                         UpdateCCOW Context;
  2349                      ur Break:
  2350                         begin
  2351                           // do no t revert t o old DFN  if context  was manua lly broken  by user -  v26 (RV)
  2352                           if (ctxC ontextor.S tate = csP articipati ng) then
  2353                             Patien t.DFN := S aveDFN;
  2354                           SetupPat ient;
  2355                           tabPage. TabIndex : = PageIDTo Tab(NextTa b);
  2356                           tabPageC hange(tabP age);
  2357                         end;
  2358                    else
  2359                      be gin
  2360                         SetupPatie nt;
  2361                         tabPage.Ta bIndex :=  PageIDToTa b(NextTab) ;
  2362                         tabPageCha nge(tabPag e);
  2363                      en d;
  2364                    end;
  2365                  end;
  2366              end
  2367           el se
  2368              begin
  2369                SetupPat ient;
  2370                tabPage. TabIndex : = PageIDTo Tab(NextTa b);
  2371                tabPageC hange(tabP age);
  2372                FCCOWJus tJoined :=  FALSE;
  2373              end;
  2374         end;
  2375     finally
  2376       if (no t FRefresh ing) and ( Patient.DF N = SaveDF N) then
  2377         Remi ndersStart ed := OldR emindersSt arted;
  2378       FFirst Load := FA LSE;
  2379     end;
  2380     { Begin  BillingAwa re }
  2381     if BILLI NG_AWARE t hen
  2382       frmFra me.SetBADx List; // e nd IsBilli ngAware
  2383     { End Bi llingAware  }
  2384     if not F Refreshing  then
  2385       begin
  2386         DoNo tChangeEnc Window :=  FALSE;
  2387         Orde rPrintForm  := FALSE;
  2388         uCor e.TempEnco unterLoc : = 0;
  2389         uCor e.TempEnco unterLocNa me := '';
  2390       end;
  2391     pnlPatie nt.Enabled  := True;
  2392     // PaPI  ---------- ---------- ---------- ---------- ---------- ---------- ---------- --
  2393     frmMeds. PaPI_GUIse tup(papiPa rkingAvail able(Encou nter));
  2394   end;
  2395  
  2396   procedure  TfrmFrame. DetermineN extTab;
  2397   begin
  2398     if (FRef reshing or  User.UseL astTab) an d (not FFi rstLoad) t hen
  2399       begin
  2400         if ( tabPage.Ta bIndex < 0 ) then
  2401           Ne xtTab := L astTab
  2402         else
  2403           Ne xtTab := T abToPageID (tabPage.T abIndex);
  2404       end
  2405     else
  2406       NextTa b := User. InitialTab ;
  2407     if NextT ab = CT_NO PAGE then
  2408       NextTa b := User. InitialTab ;
  2409     if User. IsReportsO nly then / / Reports  Only tab.
  2410       NextTa b := CT_RE PORTS; //  Only one t ab should  exist by t his point  in "REPORT S ONLY" mo de.
  2411     if not T abExists(N extTab) th en
  2412       NextTa b := CT_CO VER;
  2413     if NextT ab = CT_NO PAGE then
  2414       NextTa b := User. InitialTab ;
  2415     if NextT ab = CT_OR DERS then
  2416       if frm Orders <>  nil then
  2417         with  frmOrders  do
  2418           be gin
  2419              if (lstShe ets.ItemIn dex > -1)  and (TheCu rrentView  <> nil) an d (TheCurr entView.Ev entDelay.P tEventIFN  > 0) then
  2420                PtEvtCom pleted(The CurrentVie w.EventDel ay.PtEvent IFN, TheCu rrentView. EventDelay .EventName );
  2421           en d;
  2422   end;
  2423  
  2424   procedure  TfrmFrame. mnuFileEnc ounterClic k(Sender:  TObject);
  2425   { displays  encounter  window an d updates  encounter  display in  case enco unter was  updated }
  2426   begin
  2427     UpdateEn counter(NP F_ALL); {* KCM*}
  2428     DisplayE ncounterTe xt;
  2429   end;
  2430  
  2431   procedure  TfrmFrame. mnuFileRev iewClick(S ender: TOb ject);
  2432   { displays  the Revie w Changes  window (wh ich resets  the Encou nter objec t) }
  2433   var
  2434     EventCha nges: bool ean;
  2435     NameNeed Look: stri ng;
  2436   begin
  2437     FReviewC lick := Tr ue;
  2438     mnuFile. Tag := 1;
  2439     EventCha nges := Fa lse;
  2440     NameNeed Look := '' ;
  2441     //Update PtInfoOnRe fresh;
  2442     if Chang es.Count >  0 then
  2443     begin
  2444      if (frm Orders <>  nil) and ( frmOrders. TheCurrent View <> ni l) and ( f rmOrders.T heCurrentV iew.EventD elay.Event IFN>0) the n
  2445      begin
  2446        Event Changes :=  True;
  2447        NameN eedLook :=  frmOrders .TheCurren tView.View Name;
  2448        frmOr ders.PtEvt Completed( frmOrders. TheCurrent View.Event Delay.PtEv entIFN, fr mOrders.Th eCurrentVi ew.EventDe lay.EventN ame);
  2449      end;
  2450      ReviewC hanges(Tim edOut, Eve ntChanges) ;
  2451      if TabT oPageID(ta bPage.TabI ndex)= CT_ MEDS then
  2452      begin
  2453        frmOr ders.InitO rderSheets 2(NameNeed Look);
  2454      end;
  2455     end
  2456     else Inf oBox('No n ew changes  to review /sign.', ' Review Cha nges', MB_ OK);
  2457     //CQ #17 491: Moved  UpdatePtI nfoOnRefre sh here to  allow for  the updat ing of the  patient s tatus indi cator
  2458     //in the  header ba r (after t he Review  Changes di alog close s) if the  patient be comes admi tted/disch arged.
  2459     UpdatePt InfoOnRefr esh;
  2460     FOrderPr intForm :=  false;
  2461     FReviewC lick := fa lse;
  2462   end;
  2463  
  2464   procedure  TfrmFrame. mnuFileExi tClick(Sen der: TObje ct);
  2465   { see the  CloseQuery  event }
  2466   var
  2467     i: small int;
  2468   begin
  2469     try
  2470        if  B ILLING_AWA RE then
  2471            b egin
  2472            i f Assigned (tempDxLis t) then
  2473                for i :=  0 to pred (UBAGlobal s.tempDxLi st.Count)  do
  2474                   TObje ct(UBAGlob als.tempDx List[i]).F ree;
  2475  
  2476            U BAGlobals. tempDxList .Clear;
  2477            A pplication .ProcessMe ssages;
  2478            e nd; //end  IsBillingA ware
  2479     except
  2480        on EA ccessViola tion do
  2481           be gin
  2482           {$ ifdef debu g}Show508M essage('Ac cess Viola tion in pr ocedure Tf rmFrame.mn uFileExitC lick()');{ $endif}
  2483           ra ise;
  2484           en d;
  2485        on E:  Exception  do
  2486           be gin
  2487           {$ ifdef debu g}Show508M essage('Un handled ex ception in  procedure  TfrmFrame .mnuFileEx itClick()' );{$endif}
  2488           ra ise;
  2489           en d;
  2490     end;
  2491  
  2492     Close;
  2493   end;
  2494  
  2495   { View Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2496  
  2497   procedure  TfrmFrame. mnuViewPos tingsClick (Sender: T Object);
  2498   begin
  2499   end;
  2500  
  2501   { Tool Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2502  
  2503   function T frmFrame.E xpandComma nd(x: stri ng): strin g;
  2504   { look for  'macros'  on the com mand line  and expand  them usin g current  context }
  2505  
  2506     procedur e Substitu te(const K ey, Data:  string);
  2507     var
  2508       Stop,  Start: Int eger;
  2509     begin
  2510       Stop   := Pos(Key , x) - 1;
  2511       Start  := Stop +  Length(Key ) + 1;
  2512       x := C opy(x, 1,  Stop) + Da ta + Copy( x, Start,  Length(x)) ;
  2513     end;
  2514  
  2515   begin
  2516     if Pos(' %MREF', x)  > 0 then  Substitute ('%MREF',
  2517       '^TMP( ''ORWCHART '',' + Use r.JobNumbe r + ','''  + DottedIP Str + ''', ' + IntToH ex(Handle,  8) + ')') ;
  2518     if Pos(' %SRV',  x)  > 0 then  Substitute ('%SRV',   String(RPC BrokerV.Se rver));
  2519     if Pos(' %PORT', x)  > 0 then  Substitute ('%PORT',  IntToStr(R PCBrokerV. ListenerPo rt));
  2520     if Pos(' %DFN',  x)  > 0 then  Substitute ('%DFN',   Patient.DF N);  //*DF N*
  2521     if Pos(' %DUZ',  x)  > 0 then  Substitute ('%DUZ',   IntToStr(U ser.DUZ));
  2522     if Pos(' %H', x) >  0  then Su bstitute(' %H', Strin g(RPCBroke rV.LogIn.L ogInHandle ));
  2523     Result : = x;
  2524   end;
  2525  
  2526   procedure  TfrmFrame. ToolClick( Sender: TO bject);
  2527   { executes  the progr am associa ted with a n item on  the Tools  menu, the  command li ne is stor ed
  2528     in the i tem's hint  property  }
  2529   const
  2530     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?';
  2531     TC_ECS_N OTFOUND =  'Applicati on Not Fou nd';
  2532   var
  2533     x, AFile , Param, M enuCommand , ECSAppen d, CapNm,  curPath :  string;
  2534     IsECSInt erface: bo olean;
  2535  
  2536     function  TakeOutAm ps(AString : string):  string;
  2537     var
  2538       S1,S2:  string;
  2539     begin
  2540       if Pos ('&',AStri ng)=0 then
  2541       begin
  2542         Resu lt := AStr ing;
  2543         Exit ;
  2544       end;
  2545       S1 :=  Piece(AStr ing,'&',1) ;
  2546       S2 :=  Piece(AStr ing,'&',2) ;
  2547       Result  := S1 + S 2;
  2548     end;
  2549  
  2550     function  ExcuteEC( AFile,APar a: string) : boolean;
  2551     begin
  2552       if (Sh ellExecute (Handle, ' open', PCh ar(AFile),  PChar(Par am), '', S W_NORMAL)  > 32 ) the n Result : = True
  2553       else
  2554       begin
  2555         if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO  or MB_ICO NERROR) =  IDYES then
  2556         begi n
  2557           if  OROpenDlg .Execute t hen
  2558           be gin
  2559               AFile :=  OROpenDlg. FileName;
  2560               if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then
  2561               begin
  2562                 ShowMsg ('This is  not a vali d ECS appl ication.') ;
  2563                 Result  := True;
  2564               end else
  2565               begin
  2566                 if (She llExecute( Handle, 'o pen', PCha r(AFile),  PChar(Para m), '', SW _NORMAL)<3 2) then Re sult := Fa lse
  2567                 else Re sult := Tr ue;
  2568               end;
  2569           en d
  2570           el se Result  := True;
  2571         end  else Resul t := True;
  2572       end;
  2573     end;
  2574  
  2575     function  ExcuteECS (AFile, AP ara: strin g; var cur rPath: str ing): bool ean;
  2576     var
  2577       comman dline,RPCH andle: str ing;
  2578       Startu pInfo: TSt artupInfo;
  2579       Proces sInfo: TPr ocessInfor mation;
  2580     begin
  2581       FillCh ar(Startup Info, Size Of(TStartu pInfo), 0) ;
  2582       with S tartupInfo  do
  2583       begin
  2584         cb : = SizeOf(T StartupInf o);
  2585         dwFl ags := STA RTF_USESHO WWINDOW;
  2586         wSho wWindow :=  SW_SHOWNO RMAL;
  2587       end;
  2588       comman dline := A File + Par am;
  2589       RPCHan dle := Get AppHandle( RPCBrokerV );
  2590       comman dline := c ommandline  + ' H=' +  RPCHandle ;
  2591       if Cre ateProcess (nil, PCha r(commandl ine), nil,  nil, Fals e,
  2592         NORM AL_PRIORIT Y_CLASS, n il, nil, S tartupInfo , ProcessI nfo) then  Result :=  True
  2593       else
  2594       begin
  2595         if I nfoBox(TXT _ECS_NOTFO UND, TC_EC S_NOTFOUND , MB_YESNO  or MB_ICO NERROR) =  IDYES then
  2596         begi n
  2597           if  OROpenDlg .Execute t hen
  2598           be gin
  2599               AFile :=  OROpenDlg. FileName;
  2600               if Pos('e cs gui.exe ',lowerCas e(AFile))< 1 then
  2601               begin
  2602                 ShowMsg ('This is  not a vali d ECS appl ication.') ;
  2603                 Result  := True;
  2604               end else
  2605               begin
  2606                 SaveUse rPath('Eve nt Capture  Interface ='+AFile,  currPath);
  2607                 FillCha r(StartupI nfo, SizeO f(TStartup Info), 0);
  2608                 with St artupInfo  do
  2609                 begin
  2610                   cb :=  SizeOf(TS tartupInfo );
  2611                   dwFla gs := STAR TF_USESHOW WINDOW;
  2612                   wShow Window :=  SW_SHOWNOR MAL;
  2613                 end;
  2614                 command line := AF ile + Para m;
  2615                 RPCHand le := GetA ppHandle(R PCBrokerV) ;
  2616                 command line := co mmandline  + ' H=' +  RPCHandle;
  2617                 if not  CreateProc ess(nil, P Char(comma ndline), n il, nil, F alse,
  2618                    NORM AL_PRIORIT Y_CLASS, n il, nil,St artupInfo, ProcessInf o) then Re sult := Fa lse
  2619                 else Re sult := Tr ue;
  2620               end;
  2621           en d
  2622           el se Result  := True;
  2623         end  else Resul t := True;
  2624       end;
  2625     end;
  2626  
  2627   begin
  2628     MenuComm and := '';
  2629     ECSAppen d   := '';
  2630     IsECSInt erface :=  False;
  2631     curPath  := '';
  2632     CapNm :=  LowerCase (TMenuItem (Sender).C aption);
  2633     CapNm :=  TakeOutAm ps(CapNm);
  2634     if AnsiC ompareText ('event ca pture inte rface',Cap Nm)=0 then
  2635     begin
  2636       IsECSI nterface : = True;
  2637       if FEC SAuthUser  then Updat eECSParame ter(ECSApp end)
  2638       else b egin
  2639         Show Msg('You d on''t have  permissio n to use E CS.');
  2640         exit ;
  2641       end;
  2642     end;
  2643     MenuComm and := TMe nuItem(Sen der).Hint  + ECSAppen d;
  2644     x := Exp andCommand (MenuComma nd);
  2645     if CharA t(x, 1) =  '"' then
  2646     begin
  2647       x      := Copy(x,  2, Length (x));
  2648       AFile  := Copy(x,  1, Pos('" ',x)-1);
  2649       Param  := Copy(x,  Pos('"',x )+1, Lengt h(x));
  2650     end else
  2651     begin
  2652       AFile  := Piece(x , ' ', 1);
  2653       Param  := Copy(x,  Length(AF ile)+1, Le ngth(x));
  2654     end;
  2655     if IsECS Interface  then
  2656     begin
  2657       if not  ExcuteECS (AFile,Par am,curPath ) then
  2658         Excu teECS(AFil e,Param,cu rPath);
  2659       if Len gth(curPat h)>0 then
  2660         TMen uItem(Send er).Hint : = curPath;
  2661     end
  2662     else if  (Pos('ecs' ,LowerCase (AFile))>0 ) and (not  IsECSInte rface) the n
  2663     begin
  2664       if not  ExcuteEC( AFile,Para m) then
  2665         Excu teEC(AFile ,Param);
  2666     end else
  2667     begin
  2668       ShellE xecute(Han dle, 'open ', PChar(A File), PCh ar(Param),  '', SW_NO RMAL);
  2669     end;
  2670   end;
  2671  
  2672   { Help Men u Events - ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  2673  
  2674   procedure  TfrmFrame. mnuHelpBro kerClick(S ender: TOb ject);
  2675   { used for  debugging  - shows l ast n brok er calls }
  2676   begin
  2677     ShowBrok er;
  2678   end;
  2679  
  2680   procedure  TfrmFrame. mnuHelpLis tsClick(Se nder: TObj ect);
  2681   { used for  debugging  - shows i nternal co ntents of  TORListBox  }
  2682   begin
  2683     if Scree n.ActiveCo ntrol is T ListBox
  2684       then D ebugListIt ems(TListB ox(Screen. ActiveCont rol))
  2685       else I nfoBox('Fo cus contro l is not a  listbox',  'ListBox  Data', MB_ OK);
  2686   end;
  2687  
  2688   procedure  TfrmFrame. mnuHelpSym bolsClick( Sender: TO bject);
  2689   { used for  debugging  - shows c urrent sym bol table  }
  2690   begin
  2691     DebugSho wServer;
  2692   end;
  2693  
  2694   procedure  TfrmFrame. mnuHelpAbo utClick(Se nder: TObj ect);
  2695   { displays  the about  screen }
  2696   begin
  2697     ShowAbou t;
  2698   end;
  2699  
  2700   { Status B ar Methods  }
  2701  
  2702   procedure  TfrmFrame. UMStatusTe xt(var Mes sage: TMes sage);
  2703   { displays  status ba r text (us ing the po inter to a  text buff er passed  in LParam)  }
  2704   begin
  2705     stsArea. Panels.Ite ms[0].Text  := StrPas (PChar(Mes sage.LPara m));
  2706     stsArea. Refresh;
  2707   end;
  2708  
  2709   { Toolbar  Methods (m ake panels  act like  buttons) - ---------- ---------- ---------- ---------- -- }
  2710  
  2711   procedure  TfrmFrame. pnlPatient MouseDown( Sender: TO bject; But ton: TMous eButton;
  2712     Shift: T ShiftState ; X, Y: In teger);
  2713   { emulate  a button p ress in th e patient  identifica tion panel  }
  2714   begin
  2715     if pnlPa tient.Beve lOuter = b vLowered t hen exit;
  2716     pnlPatie nt.BevelOu ter := bvL owered;
  2717     with lbl PtName do  SetBounds( Left+2, To p+2, Width , Height);
  2718     with lbl PtSSN  do  SetBounds( Left+2, To p+2, Width , Height);
  2719     with lbl PtAge  do  SetBounds( Left+2, To p+2, Width , Height);
  2720   end;
  2721  
  2722   procedure  TfrmFrame. pnlPatient MouseUp(Se nder: TObj ect; Butto n: TMouseB utton;
  2723     Shift: T ShiftState ; X, Y: In teger);
  2724   { emulate  the button  raising i n the pati ent identi fication p anel & cal l Patient  Inquiry }
  2725   begin
  2726     if pnlPa tient.Beve lOuter = b vRaised th en exit;
  2727     pnlPatie nt.BevelOu ter := bvR aised;
  2728     with lbl PtName do  SetBounds( Left-2, To p-2, Width , Height);
  2729     with lbl PtSSN  do  SetBounds( Left-2, To p-2, Width , Height);
  2730     with lbl PtAge  do  SetBounds( Left-2, To p-2, Width , Height);
  2731   end;
  2732  
  2733   procedure  TfrmFrame. pnlVisitMo useDown(Se nder: TObj ect; Butto n: TMouseB utton;
  2734     Shift: T ShiftState ; X, Y: In teger);
  2735   { emulate  a button p ress in th e encounte r panel }
  2736   begin
  2737     if User. IsReportsO nly then
  2738       exit;
  2739     if pnlVi sit.BevelO uter = bvL owered the n exit;
  2740     pnlVisit .BevelOute r := bvLow ered;
  2741     with lbl PtLocation  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2742     with lbl PtProvider  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2743   end;
  2744  
  2745   procedure  TfrmFrame. pnlVisitMo useUp(Send er: TObjec t; Button:  TMouseBut ton;
  2746     Shift: T ShiftState ; X, Y: In teger);
  2747   { emulate  a button r aising in  the encoun ter panel  and call U pdate Prov ider/Locat ion }
  2748   begin
  2749     if User. IsReportsO nly then
  2750       exit;
  2751     if pnlVi sit.BevelO uter = bvR aised then  exit;
  2752     pnlVisit .BevelOute r := bvRai sed;
  2753     with lbl PtLocation  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2754     with lbl PtProvider  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2755   end;
  2756  
  2757   procedure  TfrmFrame. pnlVistaWe bClick(Sen der: TObje ct);
  2758   begin
  2759     inherite d;
  2760     uUseVist aWeb := tr ue;
  2761     pnlVista Web.BevelO uter := bv Lowered;
  2762     pnlCIRNC lick(self) ;
  2763     uUseVist aWeb := fa lse;
  2764   end;
  2765  
  2766   procedure  TfrmFrame. pnlVistaWe bMouseDown (Sender: T Object; Bu tton: TMou seButton;
  2767     Shift: T ShiftState ; X, Y: In teger);
  2768   begin
  2769     inherite d;
  2770     pnlVista Web.BevelO uter := bv Lowered;
  2771   end;
  2772  
  2773   procedure  TfrmFrame. pnlVistaWe bMouseUp(S ender: TOb ject; Butt on: TMouse Button;
  2774     Shift: T ShiftState ; X, Y: In teger);
  2775   begin
  2776     inherite d;
  2777     pnlVista Web.BevelO uter := bv Raised;
  2778   end;
  2779  
  2780   procedure  TfrmFrame. pnlPrimary CareMouseD own(Sender : TObject;
  2781     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2782   begin
  2783     if pnlPr imaryCare. BevelOuter  = bvLower ed then ex it;
  2784     pnlPrima ryCare.Bev elOuter :=  bvLowered ;
  2785     with lbl PtCare       do SetBo unds(Left+ 2, Top+2,  Width, Hei ght);
  2786     with lbl PtAttendin g do SetBo unds(Left+ 2, Top+2,  Width, Hei ght);
  2787     with lbl PtMHTC do  SetBounds( Left+2, To p+2, Width , Height);
  2788   end;
  2789  
  2790   procedure  TfrmFrame. pnlPrimary CareMouseU p(Sender:  TObject;
  2791     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2792   begin
  2793     if pnlPr imaryCare. BevelOuter  = bvRaise d then exi t;
  2794     pnlPrima ryCare.Bev elOuter :=  bvRaised;
  2795     with lbl PtCare       do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2796     with lbl PtAttendin g do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2797     with lbl PtMHTC       do SetBo unds(Left- 2, Top-2,  Width, Hei ght);
  2798   end;
  2799  
  2800   procedure  TfrmFrame. pnlPosting sMouseDown (Sender: T Object;
  2801     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2802   { emulate  a button p ress in th e postings  panel }
  2803   begin
  2804     if pnlPo stings.Bev elOuter =  bvLowered  then exit;
  2805     pnlPosti ngs.BevelO uter := bv Lowered;
  2806     with lbl PtPostings  do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2807     with lbl PtCWAD      do SetBou nds(Left+2 , Top+2, W idth, Heig ht);
  2808   end;
  2809  
  2810   procedure  TfrmFrame. pnlPosting sMouseUp(S ender: TOb ject;
  2811     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  2812   { emulate  a button r aising in  the postin g panel an d call Pos tings }
  2813   begin
  2814     if pnlPo stings.Bev elOuter =  bvRaised t hen exit;
  2815     pnlPosti ngs.BevelO uter := bv Raised;
  2816     with lbl PtPostings  do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2817     with lbl PtCWAD      do SetBou nds(Left-2 , Top-2, W idth, Heig ht);
  2818   end;
  2819  
  2820   { Resize a nd Font-Ch ange proce dures ---- ---------- ---------- ---------- ---------- ---------- -- }
  2821  
  2822   procedure  TfrmFrame. LoadSizesF orUser;
  2823   var
  2824     s1, s2,  s3, s4, Du mmy: integ er;
  2825     panelBot tom, panel MedIn, Res toreWidth,  MinCnst :  integer;
  2826  
  2827     procedur e GetMinCo ntraint(aC ontrol: TW inControl;  var LastM inWidth: I nteger);
  2828     var
  2829      I: inte ger;
  2830     begin
  2831      if aCon trol.Const raints.Min Width > La stMinWidth  then
  2832        LastM inWidth :=  aControl. Constraint s.MinWidth ;
  2833  
  2834      for I : = 0 to aCo ntrol.Cont rolCount -  1 do
  2835      begin
  2836        if aC ontrol.Con trols[i] i s TWinCont rol then
  2837         GetM inContrain t(TWinCont rol(aContr ol.Control s[i]), Las tMinWidth) ;
  2838      end;
  2839  
  2840     end;
  2841  
  2842   begin
  2843     ChangeFo nt(UserFon tSize);
  2844     CoverShe et.OnSetFo ntSize(Sel f, UserFon tSize);
  2845     CoverShe et.OnSetSc reenReader Status(Sel f, ScreenR eaderSyste mActive);
  2846     SetUserB ounds(TCon trol(frmFr ame));
  2847     SetUserW idths(TCon trol(frmPr oblems.pnl Left));
  2848     SetUserW idths(TCon trol(frmOr ders.pnlLe ft));
  2849     RestoreW idth := fr mNotes.pnl Left.Width ;
  2850     SetUserW idths(TCon trol(frmNo tes.pnlLef t));
  2851     MinCnst  := 0;
  2852     GetMinCo ntraint(fr mNotes.pnl Left, MinC nst);
  2853     if frmNo tes.pnlLef t.Width <  MinCnst th en
  2854      frmNote s.pnlLeft. Width := R estoreWidt h;
  2855  
  2856     frmNotes .splHorz.L eft := frm Notes.pnlL eft.left +  1;
  2857     SetUserW idths(TCon trol(frmCo nsults.pnl Left));
  2858     SetUserW idths(TCon trol(frmDC Summ.pnlLe ft));
  2859     if Assig ned(frmSur gery) then  SetUserWi dths(TCont rol(frmSur gery.pnlLe ft));
  2860     SetUserW idths(TCon trol(frmLa bs.pnlLeft ));
  2861     SetUserW idths(TCon trol(frmRe ports.pnlL eft));
  2862     SetUserC olumns(TCo ntrol(frmO rders.hdrO rders));
  2863     SetUserC olumns(TCo ntrol(frmM eds.hdrMed sIn));  //  still nee d conversi on
  2864     SetUserC olumns(TCo ntrol(frmM eds.hdrMed sOut));
  2865     SetUserS tring('frm PtSel.lstv Alerts',En duringPtSe lColumns);
  2866     SetUserS tring(Spel lCheckerSe ttingName,  SpellChec kerSetting s);
  2867     SetUserB ounds2(Tem plateEdito rSplitters , tmplEdit orSplitter Middle,
  2868                     tmp lEditorSpl itterPrope rties, tmp lEditorSpl itterMain,  tmplEdito rSplitterB oil);
  2869     SetUserB ounds2(Tem plateEdito rSplitters 2, tmplEdi torSplitte rNotes, Du mmy, Dummy , Dummy);
  2870     SetUserB ounds2(Rem inderTreeN ame, RemTr eeDlgLeft,  RemTreeDl gTop, RemT reeDlgWidt h, RemTree DlgHeight) ;
  2871     SetUserB ounds2(Rem DlgName, R emDlgLeft,  RemDlgTop , RemDlgWi dth, RemDl gHeight);
  2872     SetUserB ounds2(Rem DlgSplitte rs, RemDlg Spltr1, Re mDlgSpltr2 , Dummy ,D ummy);
  2873     SetUserB ounds2(Dra werSplitte rs,s1, s2,  s3, S4);
  2874     frmNotes .Drawers.L astOpenSiz e := s1;
  2875     frmConsu lts.Drawer s.LastOpen Size := s2 ;
  2876     frmDCSum m.Drawers. LastOpenSi ze := s3;
  2877     if Assig ned(frmSur gery) then  frmSurger y.Drawers. LastOpenSi ze := S4;  //CQ7315
  2878  
  2879     SetUserB ounds2(Not eSplitters ,s1, s2, s 3, s4);
  2880     frmNotes .LoadUserS plitterSet tings(s1,  s2, s3, s4 );
  2881  
  2882     SetUserB ounds2(Lab Splitters, s1, s2, s3 , s4);
  2883     frmLabs. LoadUserSe ttings(s1,  s2, s3, s 4);
  2884  
  2885     with frm Meds do
  2886        begin
  2887        SetUs erBounds2( frmMeds.Na me+'Split' , panelBot tom, panel MedIn, Dum my, Dummy) ;
  2888        if (p anelBottom  > frmMeds .Height-50 ) then pan elBottom : = frmMeds. Height-50;
  2889        if (p anelMedIn  > panelBot tom-50) th en panelMe dIn := pan elBottom-5 0;
  2890        frmMe ds.gdpOut. Height :=  panelBotto m;
  2891        frmMe ds.gdpIn.H eight := p anelMedIn;
  2892        //Med s Tab Non- VA meds co lumns
  2893        SetUs erColumns( TControl(h drMedsNonV A)); //CQ7 314
  2894        end;
  2895  
  2896     if Param Search('re z') = '640 ' then Set Bounds(Lef t, Top, 64 8, 488);   // for tes ting
  2897  
  2898   end;
  2899  
  2900   procedure  TfrmFrame. SaveSizesF orUser;
  2901   var
  2902     SizeList : TStringL ist;
  2903     SurgTemp Ht: intege r;
  2904     s1, s2,  s3, s4: in teger;
  2905   begin
  2906     SaveUser FontSize(M ainFontSiz e);
  2907     SizeList  := TStrin gList.Crea te;
  2908     try
  2909       with S izeList do
  2910       begin
  2911         Add( StrUserBou nds(frmFra me));
  2912         Add( StrUserWid th(frmProb lems.pnlLe ft));
  2913         Add( StrUserWid th(frmOrde rs.pnlLeft ));
  2914         Add( StrUserWid th(frmNote s.pnlLeft) );
  2915         Add( StrUserWid th(frmCons ults.pnlLe ft));
  2916         Add( StrUserWid th(frmDCSu mm.pnlLeft ));
  2917         if A ssigned(fr mSurgery)  then Add(S trUserWidt h(frmSurge ry.pnlLeft ));
  2918         Add( StrUserWid th(frmLabs .pnlLeft)) ;
  2919         Add( StrUserWid th(frmRepo rts.pnlLef t));
  2920         Add( StrUserCol umns(frmOr ders.hdrOr ders));
  2921         Add( StrUserCol umns(frmMe ds.hdrMeds In));
  2922         Add( StrUserCol umns(frmMe ds.hdrMeds Out));
  2923         Add( StrUserStr ing(SpellC heckerSett ingName, S pellChecke rSettings) );
  2924         Add( StrUserBou nds2(Templ ateEditorS plitters,  tmplEditor SplitterMi ddle,
  2925                  tmplEd itorSplitt erProperti es, tmplEd itorSplitt erMain, tm plEditorSp litterBoil ));
  2926         Add( StrUserBou nds2(Templ ateEditorS plitters2,  tmplEdito rSplitterN otes, 0, 0 , 0));
  2927         Add( StrUserBou nds2(Remin derTreeNam e, RemTree DlgLeft, R emTreeDlgT op, RemTre eDlgWidth,  RemTreeDl gHeight));
  2928         Add( StrUserBou nds2(RemDl gName, Rem DlgLeft, R emDlgTop,  RemDlgWidt h, RemDlgH eight));
  2929         Add( StrUserBou nds2(RemDl gSplitters , RemDlgSp ltr1, RemD lgSpltr2,  0 ,0));
  2930  
  2931         //v2 6.47 - RV  - access v iolation i f Surgery  Tab not en abled.  Se t to desig ner height  as defaul t.
  2932         if A ssigned(fr mSurgery)  then SurgT empHt := f rmSurgery. Drawers.pn lTemplates .Height el se SurgTem pHt := 85;
  2933         Add( StrUserBou nds2(Drawe rSplitters , frmNotes .Drawers.L astOpenSiz e,
  2934                                                    frmCo nsults.Dra wers.LastO penSize,
  2935                                                    frmDC Summ.Drawe rs.LastOpe nSize,
  2936                                                    SurgT empHt)); / / last par ameter = C Q7315
  2937         Add( StrUserBou nds2(Drawe rSplitters , frmNotes .Drawers.L astOpenSiz e,
  2938                                                    frmCo nsults.Dra wers.LastO penSize,
  2939                                                    frmDC Summ.Drawe rs.LastOpe nSize,
  2940                                                    SurgT empHt));
  2941  
  2942         frmN otes.SaveU serSplitte rSettings( s1, s2, s3 , s4);
  2943         Add( StrUserBou nds2(NoteS plitters,  s1, s2, s3 , s4));
  2944  
  2945         frmL abs.SaveUs erSettings (s1, s2, s 3, s4);
  2946         Add( StrUserBou nds2(LabSp litters, s 1, s2, s3,  s4));
  2947  
  2948         //Me ds Tab Spl itters
  2949         Add( StrUserBou nds2(frmMe ds.Name+'S plit',frmM eds.gdpOut .Height,fr mMeds.gdpI n.Height,0 ,0));
  2950  
  2951         //Me ds Tab Non -VA meds c olumns
  2952         Add( StrUserCol umns(fMeds .frmMeds.h drMedsNonV A)); //CQ7 314
  2953  
  2954         //Or ders Tab c olumns
  2955         Add( StrUserCol umns(fOrde rs.frmOrde rs.hdrOrde rs)); //CQ 6328
  2956  
  2957         if E nduringPtS elSplitter Pos <> 0 t hen
  2958           Ad d(StrUserB ounds2('fr mPtSel.spt Vert', End uringPtSel SplitterPo s, 0, 0, 0 ));
  2959         if E nduringPtS elColumns  <> '' then
  2960           Ad d('C^frmPt Sel.lstvAl erts^' + E nduringPtS elColumns) ;
  2961  
  2962         //** ** Copy/Pa ste
  2963   //      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.
  2964       end;
  2965       //Add  sizes for  forms that  used Save UserBounds () to save  thier pos itions
  2966       SizeHo lder.AddSi zesToStrLi st(SizeLis t);
  2967       //Send  the SizeL ist to the  Database
  2968       SaveUs erSizes(Si zeList);
  2969     finally
  2970       SizeLi st.Free;
  2971     end;
  2972   end;
  2973  
  2974   procedure  TfrmFrame. FormResize (Sender: T Object);
  2975   { need to  resize tab  forms spe cifically  since they  don't inh erit resiz e event (b ecause the y
  2976     are deri ved from T Form itsel f) }
  2977   begin
  2978     if FTerm inate or F Closing th en Exit;
  2979     if csDes troying in  Component State then  Exit;
  2980     // These  MoveWindo w methods  can be pha sed out. T Form now h as TAlign  property t hat set to
  2981     // alCli ent works  perfectly  well. Tfrm CoverSheet  update no  longer us es it.
  2982     //MoveWi ndow(frmCo ver.Handle ,  0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2983     MoveWind ow(frmProb lems.Handl e, 0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2984     MoveWind ow(frmMeds .Handle,      0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2985     MoveWind ow(frmOrde rs.Handle,    0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2986     MoveWind ow(frmNote s.Handle,     0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2987     MoveWind ow(frmCons ults.Handl e, 0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2988     MoveWind ow(frmDCSu mm.Handle,    0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2989     if Assig ned(frmSur gery) then  MoveWindo w(frmSurge ry.Handle,      0, 0,  pnlPage.C lientWidth , pnlPage. ClientHeig ht, True);
  2990     MoveWind ow(frmLabs .Handle,      0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2991     MoveWind ow(frmRepo rts.Handle ,  0, 0, p nlPage.Cli entWidth,  pnlPage.Cl ientHeight , True);
  2992     with sts Area do
  2993     begin
  2994       Panels [1].Width  := stsArea .Width - F FixedStatu sWidth;
  2995       FNextB uttonL :=  Panels[0]. Width + Pa nels[1].Wi dth;
  2996       FNextB uttonR :=  FNextButto nL + Panel s[2].Width ;
  2997     end;
  2998     if Notif ications.A ctive then  SetUpNext Button;
  2999     lstCIRNL ocations.L eft  := FN extButtonL  - ScrollB arWidth -  100;
  3000     lstCIRNL ocations.W idth := Cl ientWidth  - lstCIRNL ocations.L eft;
  3001     //cq: 15 641
  3002     if frmFr ame.FNextB uttonActiv e then //  keeps butt on aligned  if cancel  is presse d
  3003     begin
  3004       FNextB utton.Left  := FNextB uttonL;
  3005       FNextB utton.Top  := stsArea .Top;
  3006     end;
  3007     Self.Rep aint;
  3008   end;
  3009  
  3010   procedure  TfrmFrame. ChangeFont (NewFontSi ze: Intege r);
  3011   { Makes ch anges in a ll compone nts whenev er the fon t size is  changed.   This is ha rdcoded an d
  3012     based on  MS Sans S erif for n ow, as onl y the font  size may  be selecte d. Courier  New is us ed
  3013     wherever  non-propo rtional fo nts are re quired. }
  3014   const
  3015     TAB_VOFF SET = 7;
  3016   var
  3017     OldFont:  TFont;
  3018   begin
  3019   // Ho ho!   ResizeAnc horedFormT oFont(self ) doesn't  work here  because th e
  3020   // Form si ze is alia sed with M ainFormSiz e.
  3021     OldFont  := TFont.C reate;
  3022     try
  3023       Disabl eAlign;
  3024       try
  3025         OldF ont.Assign (Font);
  3026         with  Self           do Fo nt.Size :=  NewFontSi ze;
  3027         with  lblPtName      do Fo nt.Size :=  NewFontSi ze;   // m ust change  BOLDED la bels by ha nd
  3028         with  lblPtSSN       do Fo nt.Size :=  NewFontSi ze;
  3029         with  lblPtAge       do Fo nt.Size :=  NewFontSi ze;
  3030         with  lblOTHDTi tle  do Fo nt.Size :=  NewFontSi ze;  // rp k 11/28/20 17
  3031         with  lblOTHD        do Fo nt.Size :=  NewFontSi ze;  // rp k 11/28/20 17
  3032         with  lblPtLoca tion do Fo nt.Size :=  NewFontSi ze;
  3033         with  lblPtProv ider do Fo nt.Size :=  NewFontSi ze;
  3034         with  lblPtPost ings do Fo nt.Size :=  NewFontSi ze;
  3035         with  lblPtCare      do Fo nt.Size :=  NewFontSi ze;
  3036         with  lblPtAtte nding do F ont.Size : = NewFontS ize;
  3037         with  lblPtMHTC       do F ont.Size : = NewFontS ize;
  3038         with  lblFlag        do Fo nt.Size :=  NewFontSi ze;
  3039         with  lblPtCWAD      do Fo nt.Size :=  NewFontSi ze;
  3040         with  lblCIRN        do Fo nt.Size :=  NewFontSi ze;
  3041         with  lblVistaW eb   do Fo nt.Size :=  NewFontSi ze;
  3042         with  lstCIRNLo cations do
  3043           be gin
  3044              Font.Size  := NewFont Size;
  3045              ItemHeight  := NewFon tSize + 6;
  3046           en d;
  3047         with  tabPage        do Fo nt.Size :=  NewFontSi ze;
  3048         with  laMHV          do Fo nt.Size :=  NewFontSi ze; //VAA
  3049         with  laVAA2         do Fo nt.Size :=  NewFontSi ze; //VAA
  3050  
  3051         frmF rameHeight  := frmFra me.Height;
  3052         pnlP atientSele ctedHeight  := pnlPat ientSelect ed.Height;
  3053         tabP age.Height  := MainFo ntHeight +  TAB_VOFFS ET;   // r esize tab  selector
  3054         FitT oolbar;                                           // r esize tool bar
  3055         stsA rea.Font.S ize := New FontSize;
  3056         stsA rea.Height  := MainFo ntHeight +  TAB_VOFFS ET;
  3057         stsA rea.Panels [0].Width  := ResizeW idth( OldF ont, Font,  stsArea.P anels[0].W idth);
  3058         stsA rea.Panels [2].Width  := ResizeW idth( OldF ont, Font,  stsArea.P anels[2].W idth);
  3059  
  3060         Refr eshFixedSt atusWidth;
  3061         Form Resize( se lf );
  3062       finall y
  3063         Enab leAlign;
  3064       end;
  3065     finally
  3066       OldFon t.Free;
  3067     end;
  3068  
  3069     case (Ne wFontSize)  of
  3070      8: mnu8 pt.Checked  := true;
  3071     10: mnu1 0pt1.Check ed := true ;
  3072     12: mnu1 2pt1.Check ed := true ;
  3073     14: mnu1 4pt1.Check ed := true ;
  3074     //18: mn u18pt1.Che cked := tr ue;
  3075     end;
  3076  
  3077     //Now th at the for m elements  are resiz ed, the pa ges will k now what s ize to tak e.
  3078  
  3079     //frmCov erSheet.Fo nt.Size :=  NewFontSi ze;
  3080     CoverShe et.OnSetFo ntSize(Sel f, NewFont Size);
  3081     frmProbl ems.SetFon tSize(NewF ontSize);
  3082     frmMeds. SetFontSiz e(NewFontS ize);
  3083     frmOrder s.SetFontS ize(NewFon tSize);
  3084     frmNotes .SetFontSi ze(NewFont Size);
  3085     frmConsu lts.SetFon tSize(NewF ontSize);
  3086     frmDCSum m.SetFontS ize(NewFon tSize);
  3087     if Assig ned(frmSur gery) then  frmSurger y.SetFontS ize(NewFon tSize);
  3088     frmLabs. SetFontSiz e(NewFontS ize);
  3089     frmRepor ts.SetFont Size(NewFo ntSize);
  3090     TfrmIcon Legend.Set FontSize(N ewFontSize );
  3091     uOrders. SetFontSiz e(NewFontS ize);
  3092     if Assig ned(frmRem Dlg) then  frmRemDlg. SetFontSiz e;
  3093     //if (Tf rmRemDlg.G etInstance  <> nil) t hen TfrmRe mDlg.GetIn stance.Set FontSize;
  3094     if Assig ned(frmRem inderTree)  then frmR eminderTre e.SetFontS ize(NewFon tSize);
  3095     if Graph Float <> n il then Re sizeAnchor edFormToFo nt(GraphFl oat);
  3096   end;
  3097  
  3098   procedure  TfrmFrame. FitToolBar ;
  3099   { resizes  and reposi tions the  panels & l abels used  in the to olbar }
  3100   const
  3101     PATIENT_ WIDTH = 29 ;
  3102     VISIT_WI DTH   = 36 ;
  3103     POSTING_ WIDTH = 11 .5;
  3104     FLAG_WID TH    = 5;
  3105     CV_WIDTH       = 15 ; //14; WA T
  3106     CIRN_WID TH    = 11 ;
  3107     MHV_WIDT H     = 6;
  3108     LINES_HI GH2    = 2 ;
  3109     LINES_HI GH3    = 3 ;    //lbl PtMHTC lin e change
  3110     M_HORIZ        = 4;
  3111     M_MIDDLE       = 2;
  3112     M_NVERT        = 4;
  3113     M_WVERT        = 6;
  3114     TINY_MAR GIN   = 2;
  3115   begin
  3116     if lblPt MHTC.capti on = '' th en
  3117     begin
  3118       lblPtM HTC.Visibl e := false ;
  3119       pnlToo lbar.Heigh t  := (LIN ES_HIGH2 *  lblPtName .Height) +  M_HORIZ +  M_MIDDLE  + M_HORIZ  + M_MIDDLE
  3120     end
  3121     else
  3122     begin
  3123       if (lb lPtAttendi ng.Caption  <> '') an d (lblPtAt tending.Ca ption <> l blPtMHTC.C aption) th en
  3124       begin
  3125         lblP tMHTC.Visi ble := tru e;
  3126         pnlT oolbar.Hei ght  := (L INES_HIGH3  * lblPtNa me.Height)  + M_HORIZ  + M_MIDDL E + M_HORI Z + M_HORI Z;
  3127       end;
  3128       if lbl PtAttendin g.Caption  = '' then
  3129       begin
  3130         lblP tAttending .Caption : = lblPtMHT C.Caption;
  3131         lblP tMHTC.Visi ble := fal se;
  3132         pnlT oolbar.Hei ght  := (L INES_HIGH2  * lblPtNa me.Height)  + M_HORIZ  + M_MIDDL E + M_HORI Z + M_MIDD LE;
  3133       end;
  3134     end;
  3135     pnlPatie nt.Width    := Higher Of(PATIENT _WIDTH * M ainFontWid th, lblPtN ame.Width  + (M_WVERT  * 2));
  3136     lblPtSSN .Top        := M_HORI Z + lblPtN ame.Height  + M_MIDDL E;
  3137     lblPtAge .Top        := lblPtS SN.Top;
  3138     lblPtAge .Left       := pnlPat ient.Width  - lblPtAg e.Width -  M_WVERT;
  3139  
  3140     lblOTHD. Top         := lblPtS SN.Top; //  rpk 12/6/ 2017
  3141     pnlOTHD. Width       := Higher Of( (lblOT HDTitle.Wi dth + (M_W VERT * 2)) ,
  3142                               (lbl OTHD.Width  + (M_WVER T * 2)) );   // rpk 1 2/6/2017
  3143     lblOTHD. Left        := M_WVER T;  //  al ign in mid dle of but ton, rpk 7 /31/2018
  3144  
  3145     pnlVisit .Width      := Higher Of(LowerOf (VISIT_WID TH * MainF ontWidth,
  3146                                                HigherOf( lblPtProvi der.Width  + (M_WVERT  * 2),
  3147                                                          lblPtLocat ion.Width  + (M_WVERT  * 2))),
  3148                                       PATIENT _WIDTH * M ainFontWid th);
  3149     lblPtPro vider.Top   := lblPtS SN.Top;
  3150     lblPtAtt ending.Top  := lblPtS SN.Top;
  3151     lblPtMHT C.Top        := M_MID DLE + lblP tSSN.Heigh t + lblPtS SN.Top;
  3152     pnlPosti ngs.Width   := Round( POSTING_WI DTH * Main FontWidth) ;
  3153     if btnCo mbatVet.Vi sible then
  3154      begin
  3155       pnlCVn Flag.Width    := Roun d(CV_WIDTH  * MainFon tWidth);
  3156       pnlFla g.Width       := Roun d(CV_WIDTH  * MainFon tWidth);
  3157       btnCom batVet.Hei ght := Rou nd(pnlCVnF lag.Height  div 2);
  3158      end
  3159     else
  3160      begin
  3161       pnlCVn Flag.Width    := Roun d(FLAG_WID TH * MainF ontWidth);
  3162       pnlFla g.Width       := Roun d(FLAG_WID TH * MainF ontWidth);
  3163      end;
  3164     pnlRemot eData.Widt h := Round (CIRN_WIDT H * MainFo ntWidth) +  M_WVERT;
  3165     pnlVista Web.Height  := pnlRem oteData.He ight div 2 ;
  3166     paVAA.Wi dth         := Round( MHV_WIDTH  * MainFont Width) + M _WVERT + 2 ;
  3167     pnlOTHD. Left        := paVAA. Left - pnl OTHD.Width ;  // posi tion OTHD  panel to l eft of VAA  panel, rp k 3/30/201 8
  3168  
  3169     with lbl PtPostings  do
  3170       SetBou nds(M_WVER T, M_HORIZ , pnlPosti ngs.Width- M_WVERT-M_ WVERT, lbl PtName.Hei ght);
  3171     with lbl PtCWAD      do
  3172       SetBou nds(M_WVER T, lblPtSS N.Top, lbl PtPostings .Width, lb lPtName.He ight);
  3173     //Low re solution h andling: F irst, try  to fit eve rything on  by shrink ing fields
  3174     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
  3175     //if pnl PrimaryCar e.Width <  HigherOf(  lblPtCare. Left + lbl PtCare.Wid th, lblPtA ttending.L eft + lblP tAttending .Width) +  TINY_MARGI N then
  3176     begin
  3177       lblPtA ge.Left :=  lblPtAge. Left - (lb lPtName.Le ft - TINY_ MARGIN);
  3178       lblPtN ame.Left : = TINY_MAR GIN;
  3179       lblPTS SN.Left :=  TINY_MARG IN;
  3180       pnlPat ient.Width  := Higher Of( lblPtN ame.Left +  lblPtName .Width, lb lPtAge.Lef t + lblPtA ge.Width)+  TINY_MARG IN;
  3181       lblPtL ocation.Le ft := TINY _MARGIN;
  3182       lblPtP rovider.Le ft := TINY _MARGIN;
  3183       pnlVis it.Width : = HigherOf ( lblPtLoc ation.Left  + lblPtLo cation.Wid th, lblPtP rovider.Le ft + lblPt Provider.W idth)+ TIN Y_MARGIN;
  3184     end;
  3185     HorzScro llBar.Rang e := 0;
  3186  
  3187   end;
  3188  
  3189   { Temporar y Calls -- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -- }
  3190  
  3191   procedure  TfrmFrame. ToggleMenu ItemChecke d(Sender:  TObject);
  3192   begin
  3193     TMenuIte m(Sender). Checked :=  not TMenu Item(Sende r).Checked ;
  3194   end;
  3195  
  3196   {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------}
  3197   {  mnuFocu sChangesCl ick - togg les the Fo cused Cont rols windo w for form s that sup port it  }
  3198   {--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------}
  3199   procedure  TfrmFrame. mnuFocusCh angesClick (Sender: T Object);
  3200   begin
  3201     inherite d;
  3202     ShowFocu sedControl Dialog :=  mnuFocusCh anges.Chec ked;
  3203   end;
  3204  
  3205   procedure  TfrmFrame. mnuFontSiz eClick(Sen der: TObje ct);
  3206   begin
  3207     if (frmR emDlg <> n il) then
  3208       ShowMs g('Please  close the  reminder d ialog befo re changin g font siz es.')
  3209     else if  (dlgProbs  <> nil) th en
  3210       ShowMs g('Font si ze cannot  be changed  while add ing or edi ting a pro blem.')
  3211     else beg in
  3212       with ( Sender as  TMenuItem)  do begin
  3213         Togg leMenuItem Checked(Se nder);
  3214         fMed s.oldFont  := MainFon tSize; //C Q9182
  3215         Chan geFont(Tag );
  3216       end;
  3217     end;
  3218   end;
  3219  
  3220   procedure  TfrmFrame. mnuEditCli ck(Sender:  TObject);
  3221   var
  3222     IsReadOn ly: Boolea n;
  3223   begin
  3224     FEditCtr l := nil;
  3225     if Scree n.ActiveCo ntrol is T CustomEdit  then FEdi tCtrl := T CustomEdit (Screen.Ac tiveContro l);
  3226     if FEdit Ctrl <> ni l then beg in
  3227       if       FEditCtr l is TMemo      then  IsReadOnly  := TMemo( FEditCtrl) .ReadOnly
  3228       else i f FEditCtr l is TEdit      then  IsReadOnly  := TEdit( FEditCtrl) .ReadOnly
  3229       else i f FEditCtr l is TRich Edit then  IsReadOnly  := TRichE dit(FEditC trl).ReadO nly
  3230       else I sReadOnly  := True;
  3231  
  3232       mnuEdi tRedo.Enab led := FEd itCtrl.Per form(EM_CA NREDO, 0,  0) <> 0;
  3233       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);
  3234  
  3235       mnuEdi tCut.Enabl ed := FEdi tCtrl.SelL ength > 0;
  3236       mnuEdi tCopy.Enab led := mnu EditCut.En abled;
  3237       mnuEdi tPaste.Ena bled := (I sReadOnly  = False) a nd Clipboa rd.HasForm at(CF_TEXT );
  3238     end else  begin
  3239       mnuEdi tUndo.Enab led  := Fa lse;
  3240       mnuEdi tCut.Enabl ed   := Fa lse;
  3241       mnuEdi tCopy.Enab led  := Fa lse;
  3242       mnuEdi tPaste.Ena bled := Fa lse;
  3243     end;
  3244   end;
  3245  
  3246   procedure  TfrmFrame. mnuEditUnd oClick(Sen der: TObje ct);
  3247   begin
  3248     FEditCtr l.Perform( EM_UNDO, 0 , 0);
  3249   end;
  3250  
  3251   procedure  TfrmFrame. mnuEditRed oClick(Sen der: TObje ct);
  3252   begin
  3253     FEditCtr l.Perform( EM_REDO, 0 , 0);
  3254   end;
  3255  
  3256  
  3257   procedure  TfrmFrame. mnuEditCut Click(Send er: TObjec t);
  3258   begin
  3259     FEditCtr l.CutToCli pboard;
  3260   end;
  3261  
  3262   procedure  TfrmFrame. mnuEditCop yClick(Sen der: TObje ct);
  3263   begin
  3264     FEditCtr l.CopyToCl ipboard;
  3265   end;
  3266  
  3267   procedure  TfrmFrame. mnuEditPas teClick(Se nder: TObj ect);
  3268   begin
  3269     FEditCtr l.PasteFro mClipboard ;  // use  AsText to  prevent fo rmatting f rom being  pasted
  3270   end;
  3271  
  3272   procedure  TfrmFrame. mnuFilePri ntClick(Se nder: TObj ect);
  3273   begin
  3274     case mnu FilePrint. Tag of
  3275     CT_NOTES :    frmNo tes.Reques tPrint;
  3276     CT_CONSU LTS: frmCo nsults.Req uestPrint;
  3277     CT_DCSUM M:   frmDC Summ.Reque stPrint;
  3278     CT_REPOR TS:  frmRe ports.Requ estPrint;
  3279     CT_LABS:      frmLa bs.Request Print;
  3280     CT_ORDER S:   frmOr ders.Reque stPrint;
  3281     CT_PROBL EMS: frmPr oblems.Req uestPrint;
  3282     CT_SURGE RY:  if As signed(frm Surgery) t hen frmSur gery.Reque stPrint;
  3283     end;
  3284   end;
  3285  
  3286   procedure  TfrmFrame. WMSysComma nd(var Mes sage: TMes sage);
  3287   begin
  3288     case Tab ToPageID(t abPage.Tab Index) of
  3289       CT_NOT ES:
  3290           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then
  3291              with Messa ge do
  3292                begin
  3293                  SendMe ssage(frmN otes.Handl e, Msg, WP aram, LPar am);
  3294                  Result  := 0;
  3295                end
  3296           el se
  3297              inherited;
  3298       CT_DCS UMM:
  3299           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboAttendi ng') then
  3300              with Messa ge do
  3301                begin
  3302                  SendMe ssage(frmD CSumm.Hand le, Msg, W Param, lPa ram);
  3303                  Result  := 0;
  3304                end
  3305           el se
  3306              inherited;
  3307       CT_CON SULTS:
  3308           if  Assigned( Screen.Act iveControl .Parent) a nd (Screen .ActiveCon trol.Paren t.Name = ' cboCosigne r') then
  3309              with Messa ge do
  3310                begin
  3311                  SendMe ssage(frmC onsults.Ha ndle, Msg,  WParam, l Param);
  3312                  Result  := 0;
  3313                end
  3314           el se
  3315              inherited;
  3316     else
  3317       inheri ted;
  3318     end;
  3319     if Messa ge.WParam  = SC_MAXIM IZE then
  3320     begin
  3321       // for m becomes  maximized;
  3322       frmOrd ers.mnuOpt imizeField sClick(sel f);
  3323       frmPro blems.mnuO ptimizeFie ldsClick(s elf);
  3324       frmMed s.mnuOptim izeFieldsC lick(self) ;
  3325     end
  3326     else if  Message.WP aram = SC_ MINIMIZE t hen
  3327     begin
  3328       // for m becomes  maximized;
  3329     end
  3330     else if  Message.WP aram = SC_ RESTORE th en
  3331     begin
  3332       // for m is resto red (from  maximized) ;
  3333       frmOrd ers.mnuOpt imizeField sClick(sel f);
  3334       frmPro blems.mnuO ptimizeFie ldsClick(s elf);
  3335       frmMed s.mnuOptim izeFieldsC lick(self) ;
  3336     end;
  3337   end;
  3338  
  3339   procedure  TfrmFrame. RemindersC hanged(Sen der: TObje ct);
  3340   var
  3341     ImgName:  string;
  3342   begin
  3343     pnlRemin ders.tag : = HAVE_REM INDERS;
  3344     pnlRemin ders.Hint  := 'Click  to display  reminders ';
  3345     case Get ReminderSt atus of
  3346       rsUnkn own:
  3347         begi n
  3348           Im gName := ' BMP_REMIND ERS_UNKNOW N';
  3349           pn lReminders .Caption : = 'Reminde rs';
  3350         end;
  3351       rsDue:
  3352         begi n
  3353           Im gName := ' BMP_REMIND ERS_DUE';
  3354           pn lReminders .Caption : = 'Due Rem inders';
  3355         end;
  3356       rsAppl icable:
  3357         begi n
  3358           Im gName := ' BMP_REMIND ERS_APPLIC ABLE';
  3359           pn lReminders .Caption : = 'Applica ble Remind ers';
  3360         end;
  3361       rsNotA pplicable:
  3362         begi n
  3363           Im gName := ' BMP_REMIND ERS_OTHER' ;
  3364           pn lReminders .Caption : = 'Other R eminders';
  3365         end;
  3366       else
  3367         begi n
  3368           Im gName := ' BMP_REMIND ERS_NONE';
  3369           pn lReminders .Hint := ' There are  currently  no reminde rs availab le';
  3370           pn lReminders .Caption : = pnlRemin ders.Hint;
  3371           pn lReminders .tag := NO _REMINDERS ;
  3372         end;
  3373     end;
  3374     if(Remin dersEvalua tingInBack ground) th en
  3375     begin
  3376       if(anm tRemSearch .ResName =  '') then
  3377       begin
  3378         TORE xposedAnim ate(anmtRe mSearch).O nMouseDown  := pnlRem indersMous eDown;
  3379         TORE xposedAnim ate(anmtRe mSearch).O nMouseUp    := pnlRem indersMous eUp;
  3380         anmt RemSearch. ResHandle  := 0;
  3381         anmt RemSearch. ResName :=  'REMSEARC HAVI';
  3382       end;
  3383       imgRem inder.Visi ble := FAL SE;
  3384       anmtRe mSearch.Ac tive := TR UE;
  3385       anmtRe mSearch.Vi sible := T RUE;
  3386       if(pnl Reminders. Hint <> '' ) then
  3387         pnlR eminders.H int := CRL F + pnlRem inders.Hin t + '.';
  3388       pnlRem inders.Hin t := 'Eval uating Rem inders...   ' + pnlRe minders.Hi nt;
  3389       pnlRem inders.Cap tion := pn lReminders .Hint;
  3390     end
  3391     else
  3392     begin
  3393       anmtRe mSearch.Vi sible := F ALSE;
  3394       imgRem inder.Visi ble := TRU E;
  3395       imgRem inder.Pict ure.Bitmap .LoadFromR esourceNam e(hInstanc e, ImgName );
  3396       anmtRe mSearch.Ac tive := FA LSE;
  3397     end;
  3398     mnuViewR eminders.E nabled :=  (pnlRemind ers.tag =  HAVE_REMIN DERS);
  3399   end;
  3400  
  3401   procedure  TfrmFrame. pnlReminde rsMouseDow n(Sender:  TObject;
  3402     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  3403   begin
  3404     if(not I nitialRemi ndersLoade d) then
  3405       Startu pReminders ;
  3406     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  3407       pnlRem inders.Bev elOuter :=  bvLowered ;
  3408   end;
  3409  
  3410   procedure  TfrmFrame. pnlReminde rsMouseUp( Sender: TO bject;
  3411     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  3412   begin
  3413     pnlRemin ders.Bevel Outer := b vRaised;
  3414     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  3415       ViewIn fo(mnuView Reminders) ;
  3416   end;
  3417  
  3418   //-------- ---------- --- CIRN-r elated pro cedures -- ---------- ---------- ----------
  3419  
  3420   procedure  TfrmFrame. SetUpCIRN;
  3421   var
  3422     i: integ er;
  3423     iNwHIN,  iRDVOnly:  integer;
  3424     aAutoQue ry,aVistaW ebLabel: s tring;
  3425     ASite: T RemoteSite ;
  3426     item: TV A508Access ibilityIte m;
  3427     id: inte ger;
  3428   begin
  3429     uUseVist aWeb := fa lse;
  3430     with Rem oteSites d o
  3431     begin
  3432       Change Patient(Pa tient.DFN) ;
  3433       lblCIR N.Caption  := ' Remot e Data';
  3434       lblCIR N.Alignmen t := taCen ter;
  3435       aVista WebLabel : = GetVista Web_JLV_La belName;
  3436       if aVi staWebLabe l = '' the n aVistaWe bLabel :=  'VistAWeb' ;
  3437       lblVis taWeb.Capt ion := aVi staWebLabe l;
  3438       pnlVis taWeb.Beve lOuter :=  bvRaised;
  3439       iNwHIN  := 0;
  3440       iRDVOn ly := 0;
  3441       for i  := 0 to Re moteSites. Count - 1  do
  3442         begi n
  3443           if  not(LeftS tr(TRemote Site(Remot eSites.Sit eList.Item s[i]).Site ID, 4) = ' 200N') the n
  3444              begin
  3445                iRDVOnly  := 1;
  3446                continue ;
  3447              end
  3448           el se
  3449              iNwHIN :=  1;
  3450         end;
  3451  
  3452       if Rem oteDataExi sts and (( iRDVOnly =  1) or (iN wHIN = 1))  and (Remo teSites.Co unt > 0) t hen
  3453         begi n
  3454           if  ScreenRea derSystemA ctive then
  3455           be gin
  3456            i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData,  False);
  3457            i d:= item.I NDEX;
  3458            a mgrMain.Ac cessData[i d].AccessT ext := '';
  3459           en d;
  3460           lb lCIRN.Enab led     :=  True;
  3461           pn lCIRN.TabS top     :=  True;
  3462           lb lCIRN.Font .Color  :=  Get508Com pliantColo r(clBlue);
  3463           ls tCIRNLocat ions.Font. Color  :=  Get508Comp liantColor (clBlue);
  3464           lb lCIRN.Capt ion := 'Re mote Data' ;
  3465           pn lCIRN.Hint  := 'Click  to displa y other fa cilities h aving data  for this  patient.';
  3466           lb lVistaWeb. Font.Color  := Get508 CompliantC olor(clBlu e);
  3467           pn lVistaWeb. Hint := 'C lick to go  to ' + aV istaWebLab el + ' to  see data f rom other  facilities  for this  patient.';
  3468           if  RemoteSit es.Count >  0 then
  3469              lstCIRNLoc ations.Ite ms.Add('0'  + U + 'Al l Availabl e Sites');
  3470           fo r i := 0 t o RemoteSi tes.Count  - 1 do
  3471              begin
  3472                ASite :=  TRemoteSi te(SiteLis t[i]);
  3473                lstCIRNL ocations.I tems.Add(A Site.SiteI D + U + AS ite.SiteNa me + U +
  3474                  Format FMDateTime ('mmm dd y yyy hh:nn' , ASite.La stDate));
  3475              end;
  3476         end
  3477       else
  3478         begi n
  3479           if  ScreenRea derSystemA ctive then
  3480           be gin
  3481            i tem := amg rMain.Acce ssData.Fin dItem(pnlR emoteData,  False);
  3482            i d:= item.I NDEX;
  3483            a mgrMain.Ac cessData[i d].AccessT ext := 'No  remote da ta availab le';
  3484           en d;
  3485           lb lCIRN.Font .Color  :=  clWindowT ext;
  3486           lb lVistaWeb. Font.Color  := clWind owText;
  3487           lb lCIRN.Enab led     :=  False;
  3488           pn lCIRN.TabS top     :=  False;
  3489           pn lCIRN.Hint  := NoData Reason;
  3490           if  (iNwHIN =  1) and (i RDVOnly =  0) then
  3491              begin
  3492               lblVistaW eb.Font.Co lor := Get 508Complia ntColor(cl Blue);
  3493               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).';
  3494              end;
  3495         end;
  3496       aAutoQ uery := Au toRDV;         //Chec k to see i f Remote Q ueries sho uld be use d for all  available  sites
  3497       if (aA utoQuery =  '1') and  (lstCIRNLo cations.Co unt > 0) t hen
  3498         begi n
  3499           ls tCIRNLocat ions.ItemI ndex := 0;
  3500           ls tCIRNLocat ions.Check ed[0] := t rue;
  3501           ls tCIRNLocat ionsClick( self);
  3502         end;
  3503     end;
  3504   end;
  3505  
  3506   procedure  TfrmFrame. paVAAResiz e(Sender:  TObject);
  3507   begin
  3508     laMHV.He ight := pa VAA.Client Height div  2;
  3509   end;
  3510  
  3511   procedure  TfrmFrame. pnlCIRNCli ck(Sender:  TObject);
  3512   begin
  3513     ViewInfo (mnuViewRe moteData);
  3514   end;
  3515  
  3516   procedure  TfrmFrame. lstCIRNLoc ationsClic k(Sender:  TObject);
  3517   var
  3518     iIndex,j ,iAll,iCur : integer;
  3519     aMsg,s:  string;
  3520     AccessSt atus: inte ger;
  3521   begin
  3522     iAll :=  1;
  3523     AccessSt atus := 0;
  3524     iIndex : = lstCIRNL ocations.I temIndex;
  3525     if not C heckHL7TCP Link then
  3526       begin
  3527         Info Box('Local  HL7 TCP L ink is dow n.' + CRLF  + 'Unable  to retrie ve remote  data.', TC _DGSR_ERR,  MB_OK);
  3528         lstC IRNLocatio ns.Checked [iIndex] : = false;
  3529         Exit ;
  3530       end;
  3531     if lstCI RNLocation s.Items.Co unt > 1 th en
  3532       if pie ce(lstCIRN Locations. Items[1],' ^',1) = '0 ' then
  3533         iAll  := 2;
  3534     with frm Reports do
  3535       if pie ce(uRemote Type,'^',2 ) = 'V' th en
  3536         begi n
  3537           lv Reports.It ems.BeginU pdate;
  3538           lv Reports.It ems.Clear;
  3539           lv Reports.Co lumns.Clea r;
  3540           lv Reports.It ems.EndUpd ate;
  3541         end;
  3542     uReportI nstruction  := '';
  3543     frmRepor ts.TabCont rol1.Tabs. Clear;
  3544     frmLabs. TabControl 1.Tabs.Cle ar;
  3545     frmRepor ts.TabCont rol1.Tabs. AddObject( 'Local',ni l);
  3546     frmLabs. TabControl 1.Tabs.Add Object('Lo cal',nil);
  3547     StatusTe xt('Checki ng Remote  Sites...') ;
  3548     if piece (lstCIRNLo cations.It ems[iIndex ],'^',1) =  '0' then  // All sit es have be en clicked
  3549       if lst CIRNLocati ons.Checke d[iIndex]  = false th en // All  selection  is being t urned off
  3550         begi n
  3551           wi th RemoteS ites.SiteL ist do
  3552           fo r j := 0 t o Count -  1 do
  3553              if lstCIRN Locations. Checked[j+ 1] = true  then
  3554                begin
  3555                  lstCIR NLocations .Checked[j +1] := fal se;
  3556                  TRemot eSite(Remo teSites.Si teList[j]) .Selected  := false;
  3557                  TRemot eSite(Remo teSites.Si teList[j]) .ReportCle ar;
  3558                  TRemot eSite(Remo teSites.Si teList[j]) .LabClear;
  3559                end;
  3560         end
  3561       else
  3562         begi n
  3563           wi th RemoteS ites.SiteL ist do
  3564           fo r j := 0 t o Count -  1 do
  3565                begin
  3566                  Screen .Cursor :=  crHourGla ss;
  3567                  Screen .Cursor :=  crDefault ;
  3568                  aMsg : = aMsg + '  at site:  ' + TRemot eSite(Item s[j]).Site Name;
  3569                  s := l stCIRNLoca tions.Item s[j+1];
  3570                  lstCIR NLocations .Items[j+1 ] := piece s(s, '^',  1, 3);
  3571                  case A ccessStatu s of
  3572                  DGSR_F AIL: begin
  3573                                if  piece(aMsg ,':',1) =  'RPC name  not found  at site' t hen //Allo w for back ward compa tibility
  3574                                  b egin
  3575                                     lstCIRNLo cations.Ch ecked[j+1]  := true;
  3576                                     TRemoteSi te(RemoteS ites.SiteL ist[j]).Re portClear;
  3577                                     TRemoteSi te(RemoteS ites.SiteL ist[j]).La bClear;
  3578                                     TRemoteSi te(Items[j ]).Selecte d := true;
  3579                                  e nd
  3580                                els e
  3581                                  b egin
  3582                                     InfoBox(a Msg, TC_DG SR_ERR, MB _OK);
  3583                                     lstCIRNLo cations.Ch ecked[j+1]  := false;
  3584                                     lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1,  3) + '^' +  TC_DGSR_E RR;
  3585                                     TRemoteSi te(Items[j ]).Selecte d := false ;
  3586                                     Continue;
  3587                                  e nd;
  3588                              end;
  3589                  DGSR_N ONE: begin
  3590                                lst CIRNLocati ons.Checke d[j+1] :=  true;
  3591                                TRe moteSite(R emoteSites .SiteList[ j]).Report Clear;
  3592                                TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar;
  3593                                TRe moteSite(I tems[j]).S elected :=  true;
  3594                              end;
  3595                  DGSR_S HOW: begin
  3596                                Inf oBox(AMsg,  TC_DGSR_S HOW, MB_OK );
  3597                                lst CIRNLocati ons.Checke d[j+1] :=  true;
  3598                                TRe moteSite(R emoteSites .SiteList[ j]).Report Clear;
  3599                                TRe moteSite(R emoteSites .SiteList[ j]).LabCle ar;
  3600                                TRe moteSite(I tems[j]).S elected :=  true;
  3601                              end;
  3602                  DGSR_A SK:  if In foBox(AMsg  + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO  or MB_ICO NWARNING o r
  3603                                MB_ DEFBUTTON2 ) = IDYES  then
  3604                                beg in
  3605                                  l stCIRNLoca tions.Chec ked[j+1] : = true;
  3606                                  T RemoteSite (RemoteSit es.SiteLis t[j]).Repo rtClear;
  3607                                  T RemoteSite (RemoteSit es.SiteLis t[j]).LabC lear;
  3608                                  T RemoteSite (Items[j]) .Selected  := true;
  3609                                end
  3610                                els e
  3611                                  b egin
  3612                                     lstCIRNLo cations.Ch ecked[j+1]  := false;
  3613                                     lstCIRNLo cations.It ems[j+1] : = pieces(s , '^', 1,  3) + '^' +  TC_DGSR_S HOW;
  3614                                     TRemoteSi te(Items[j ]).Selecte d := false ;
  3615                                     Continue;
  3616                                  e nd;
  3617                  else        begin
  3618                                Inf oBox(AMsg,  TC_DGSR_D ENY, MB_OK );
  3619                                lst CIRNLocati ons.Checke d[j+1] :=  false;
  3620                                lst CIRNLocati ons.Items[ j+1] := pi eces(s, '^ ', 1, 3) +  '^' + TC_ DGSR_DENY;
  3621                                TRe moteSite(I tems[j]).S elected :=  false;
  3622                                Con tinue;
  3623                              end;
  3624                  end;
  3625                end;
  3626         end
  3627     else
  3628       begin
  3629         if i Index > 0  then
  3630           be gin
  3631              iCur := iI ndex - iAl l;
  3632              TRemoteSit e(RemoteSi tes.SiteLi st[iCur]). Selected : =
  3633                lstCIRNL ocations.C hecked[iIn dex];
  3634              if lstCIRN Locations. Checked[iI ndex] = tr ue then
  3635                with Rem oteSites.S iteList do
  3636                begin
  3637                  Screen .Cursor :=  crHourGla ss;
  3638                  Screen .Cursor :=  crDefault ;
  3639                  aMsg : = aMsg + '  at site:  ' + TRemot eSite(Item s[iCur]).S iteName;
  3640                  s := l stCIRNLoca tions.Item s[iIndex];
  3641                  lstCIR NLocations .Items[iIn dex] := pi eces(s, '^ ', 1, 3);
  3642                  case A ccessStatu s of
  3643                  DGSR_F AIL: begin
  3644                                if  piece(aMsg ,':',1) =  'RPC name  not found  at site' t hen //Allo w for back ward compa tibility
  3645                                  b egin
  3646                                     lstCIRNLo cations.Ch ecked[iInd ex] := tru e;
  3647                                     TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .ReportCle ar;
  3648                                     TRemoteSi te(RemoteS ites.SiteL ist[iCur]) .LabClear;
  3649                                     TRemoteSi te(Items[i Cur]).Sele cted := tr ue;
  3650                                  e nd
  3651                                els e
  3652                                  b egin
  3653                                     InfoBox(a Msg, TC_DG SR_ERR, MB _OK);
  3654                                     lstCIRNLo cations.Ch ecked[iInd ex] := fal se;
  3655                                     lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^',  1, 3) + '^ ' + TC_DGS R_ERR;
  3656                                     TRemoteSi te(Items[i Cur]).Sele cted := fa lse;
  3657                                  e nd;
  3658                              end;
  3659                  DGSR_N ONE: begin
  3660                                lst CIRNLocati ons.Checke d[iIndex]  := true;
  3661                                TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear;
  3662                                TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear;
  3663                                TRe moteSite(I tems[iCur] ).Selected  := true;
  3664                              end;
  3665                  DGSR_S HOW: begin
  3666                                Inf oBox(AMsg,  TC_DGSR_S HOW, MB_OK );
  3667                                lst CIRNLocati ons.Checke d[iIndex]  := true;
  3668                                TRe moteSite(R emoteSites .SiteList[ iCur]).Rep ortClear;
  3669                                TRe moteSite(R emoteSites .SiteList[ iCur]).Lab Clear;
  3670                                TRe moteSite(I tems[iCur] ).Selected  := true;
  3671                              end;
  3672                  DGSR_A SK:  if In foBox(AMsg  + TX_DGSR _YESNO, TC _DGSR_SHOW , MB_YESNO  or MB_ICO NWARNING o r
  3673                                MB_ DEFBUTTON2 ) = IDYES  then
  3674                                beg in
  3675                                  l stCIRNLoca tions.Chec ked[iIndex ] := true;
  3676                                  T RemoteSite (RemoteSit es.SiteLis t[iCur]).R eportClear ;
  3677                                  T RemoteSite (RemoteSit es.SiteLis t[iCur]).L abClear;
  3678                                  T RemoteSite (Items[iCu r]).Select ed := true ;
  3679                                end
  3680                                els e
  3681                                  b egin
  3682                                     lstCIRNLo cations.Ch ecked[iInd ex] := fal se;
  3683                                     lstCIRNLo cations.It ems[iIndex ] := piece s(s, '^',  1, 3) + '^ ' + TC_DGS R_SHOW;
  3684                                  e nd;
  3685                  else        begin
  3686                                Inf oBox(AMsg,  TC_DGSR_D ENY, MB_OK );
  3687                                lst CIRNLocati ons.Checke d[iIndex]  := false;
  3688                                lst CIRNLocati ons.Items[ iIndex] :=  pieces(s,  '^', 1, 3 ) + '^' +  TC_DGSR_DE NY;
  3689                                TRe moteSite(I tems[iCur] ).Selected  := false;
  3690                              end;
  3691                  end;
  3692                  with f rmReports  do
  3693                    if p iece(uRemo teType,'^' ,1) = '1'  then
  3694                      if  not(piece (uRemoteTy pe,'^',2)  = 'V') the n
  3695                         begin
  3696                           TabContr ol1.Visibl e := true;
  3697                           pnlRight Top.Height  := lblTit le.Height  + TabContr ol1.Height ;
  3698                         end;
  3699                  with f rmLabs do
  3700                    if p iece(uLabR emoteType, '^',1) = ' 1' then
  3701                      if  not(piece (uLabRemot eType,'^', 2) = 'V')  then
  3702                         begin
  3703                           TabContr ol1.Visibl e := true;
  3704                           pnlRight Top.Height  := lblTit le.Height  + TabContr ol1.Height ;
  3705                         end;
  3706                end;
  3707           en d;
  3708       end;
  3709     with Rem oteSites.S iteList do
  3710       for j  := 0 to Co unt - 1 do
  3711         if T RemoteSite (Items[j]) .Selected
  3712           an d (not(Lef tStr(TRemo teSite(Ite ms[j]).Sit eID ,4) =  '200N'))   then
  3713           be gin
  3714              frmReports .TabContro l1.Tabs.Ad dObject(TR emoteSite( Items[j]). SiteName,
  3715                TRemoteS ite(Items[ j]));
  3716              frmLabs.Ta bControl1. Tabs.AddOb ject(TRemo teSite(Ite ms[j]).Sit eName,
  3717                TRemoteS ite(Items[ j]));
  3718           en d;
  3719     if not(P iece(uRepo rtID,':',1 ) = 'OR_VW AL')
  3720       and no t(Piece(uR eportID,': ',1) = 'OR _VWRX')
  3721       and no t(Piece(uR eportID,': ',1) = 'OR _VWVS')
  3722       and (f rmReports. tvReports. SelectionC ount > 0)  then frmRe ports.tvRe portsClick (self);
  3723     if not(u LabRepID =  '6:GRAPH' ) and not( uLabRepID  = '5:WORKS HEET')
  3724       and no t(uLabRepI D = '4:SEL ECTED TEST S BY DATE' )
  3725       and (f rmLabs.tvR eports.Sel ectionCoun t > 0) the n frmLabs. tvReportsC lick(self) ;
  3726     StatusTe xt('');
  3727   end;
  3728  
  3729   procedure  TfrmFrame. popCIRNClo seClick(Se nder: TObj ect);
  3730   begin
  3731     lstCIRNL ocations.V isible :=  False;
  3732     lstCirnL ocations.S endToBack;
  3733     pnlCIRN. BevelOuter  := bvRais ed;
  3734   end;
  3735  
  3736   procedure  TfrmFrame. popCIRNSel ectAllClic k(Sender:  TObject);
  3737  
  3738   begin
  3739     lstCIRNL ocations.I temIndex : = 0;
  3740     lstCIRNL ocations.C hecked[0]  := true;
  3741     lstCIRNL ocations.O nClick(Sel f);
  3742   end;
  3743  
  3744   procedure  TfrmFrame. popCIRNSel ectNoneCli ck(Sender:  TObject);
  3745  
  3746   begin
  3747     lstCIRNL ocations.I temIndex : = 0;
  3748     lstCIRNL ocations.C hecked[0]  := false;
  3749     lstCIRNL ocations.O nClick(Sel f);
  3750   end;
  3751  
  3752   procedure  TfrmFrame. mnuFilePri ntSetupCli ck(Sender:  TObject);
  3753   var
  3754     CurrPrt:  string;
  3755   begin
  3756     CurrPrt  := SelectD evice(Self , Encounte r.Location , True, 'P rint Devic e Selectio n');
  3757     User.Cur rentPrinte r := Piece (CurrPrt,  U, 1);
  3758   end;
  3759  
  3760   procedure  TfrmFrame. LabInfo1Cl ick(Sender : TObject) ;
  3761   begin
  3762     ExecuteL abInfo;
  3763   end;
  3764  
  3765   procedure  TfrmFrame. mnuFileNot ifRemoveCl ick(Sender : TObject) ;
  3766   const
  3767     TC_REMOV E_ALERT  =  'Remove C urrent Ale rt';
  3768     TX_REMOV E_ALERT1 =  'This act ion will d elete the  alert you  are curren tly proces sing; the  alert will  ' + CRLF  +
  3769           'd isappear a utomatical ly when al l orders h ave been a cted on, b ut this ac tion may'  + CRLF +
  3770           'b e used to  remove the  alert if  some order s are to b e left unc hanged.' +  CRLF + CR LF +
  3771           'Y our ';
  3772     TX_REMOV E_ALERT2 =  ' alert f or ';
  3773     TX_REMOV E_ALERT3 =  ' will be  deleted!'  + CRLF +  CRLF + 'Ar e you sure ?';
  3774   var
  3775     AlertMsg , AlertTyp e: string;
  3776  
  3777     procedur e StopProc essingNoti fs;
  3778       begin
  3779         Noti fications. Clear;
  3780         FNex tButtonAct ive := Fal se;
  3781         stsA rea.Panels [2].Bevel  := pbLower ed;
  3782         mnuF ileNext.En abled := F alse;
  3783         mnuF ileNotifRe move.Enabl ed := Fals e;
  3784       end;
  3785  
  3786   begin
  3787     if not N otificatio ns.Active  then Exit;
  3788     case Not ifications .Followup  of
  3789       NF_MED ICATIONS_E XPIRING_IN PT    : Al ertType :=  'Expiring  Medicatio ns';
  3790       NF_MED ICATIONS_E XPIRING_OU TPT   : Al ertType :=  'Expiring  Medicatio ns';
  3791       NF_ORD ER_REQUIRE S_ELEC_SIG NATURE: Al ertType :=  'Unsigned  Orders';
  3792       NF_FLA GGED_ORDER S                : Al ertType :=  'Flagged  Orders (fo r clarific ation)';
  3793       NF_UNV ERIFIED_ME DICATION_O RDER  : Al ertType :=  'Unverifi ed Medicat ion Order' ;
  3794       NF_UNV ERIFIED_OR DER              : Al ertType :=  'Unverifi ed Order';
  3795       NF_FLA GGED_OI_EX P_INPT           : Al ertType :=  'Flagged  Orderable  Item (INPT )';
  3796       NF_FLA GGED_OI_EX P_OUTPT          : Al ertType :=  'Flagged  Orderable  Item (OUTP T)';
  3797     else
  3798       Exit;
  3799     end;
  3800     AlertMsg  := TX_REM OVE_ALERT1  + AlertTy pe + TX_RE MOVE_ALERT 2 + Patien t.Name + T X_REMOVE_A LERT3;
  3801     if InfoB ox(AlertMs g, TC_REMO VE_ALERT,  MB_YESNO)  = ID_YES t hen
  3802       begin
  3803         Noti fications. DeleteForC urrentUser ;
  3804         Noti fications. Next;   //  avoid pro mpt if no  more alert s selected  to proces s  {v14a R V}
  3805         if N otificatio ns.Active  then
  3806           be gin
  3807              if (InfoBo x(TX_NOTIF _STOP, TC_ NOTIF_STOP , MB_YESNO ) = ID_NO)  then
  3808                begin
  3809                  Notifi cations.Pr ior;
  3810                  mnuFil eNextClick (Self);
  3811                end
  3812              else
  3813                StopProc essingNoti fs;
  3814           en d
  3815         else
  3816           St opProcessi ngNotifs;
  3817       end;
  3818   end;
  3819  
  3820   procedure  TfrmFrame. mnuToolsOp tionsClick (Sender: T Object);
  3821   // persona l preferen ces - chan ges may ne ed to be a pplied to  chart
  3822   var
  3823     i: integ er;
  3824   begin
  3825     i := 0;
  3826     DialogOp tions(i);
  3827   end;
  3828  
  3829   procedure  TfrmFrame. LoadUserPr eferences;
  3830   begin
  3831     LoadSize sForUser;
  3832     GetUserT emplateDef aults(TRUE );
  3833   end;
  3834  
  3835   procedure  TfrmFrame. SaveUserPr eferences;
  3836   begin
  3837     SaveSize sForUser;          //  position  & size set tings
  3838     SaveUser TemplateDe faults;
  3839   end;
  3840  
  3841   procedure  TfrmFrame. mnuFileRef reshClick( Sender: TO bject);
  3842   begin
  3843     FRefresh ing := TRU E;
  3844     try
  3845       mnuFil eOpenClick (Self);
  3846     finally
  3847       FRefre shing := F ALSE;
  3848       OrderP rintForm : = FALSE;
  3849     end;
  3850   end;
  3851  
  3852   procedure  TfrmFrame. AppActivat ed(Sender:  TObject);
  3853   begin
  3854     if assig ned(FOldAc tivate) th en
  3855       FOldAc tivate(Sen der);
  3856     SetActiv eWindow(Ap plication. Handle);
  3857     if Scree nReaderSys temActive  and assign ed(Patient ) and (Pat ient.Name  <> '') and  (Patient. Status <>  '') then
  3858         Spea kTabAndPat ient;
  3859   end;
  3860  
  3861   // close T reatment F actor hint  window if  alt-tab p ressed.
  3862   procedure  TfrmFrame. AppDeActiv ated(Sende r: TObject );
  3863   begin
  3864     if FRVTF hintWindow Active the n
  3865     begin
  3866        FRVTF HintWindow .ReleaseHa ndle;
  3867        FRVTF HintWindow Active :=  False;
  3868     end
  3869     else
  3870     if FOSTF HintWndAct ive then
  3871     begin
  3872        FOSTF hintWindow .ReleaseHa ndle;
  3873        FOSTF HintWndAct ive := Fal se ;
  3874     end;
  3875     if FHint WinActive  then   //  graphing -  hints on  values
  3876     begin
  3877       FHintW in.Release Handle;
  3878       FHintW inActive : = false;
  3879     end;
  3880   end;
  3881  
  3882   procedure  TfrmFrame. LoadBuffer (Sender: T Object; Lo adList: TS trings; va r ProcessL oad: Boole an);
  3883   Var
  3884     IPAddr:  string;
  3885   begin
  3886     inherite d;
  3887       //Load  the buffe r
  3888    CPAppMon. UserDuz :=  User.DUZ;  //Current  User's DU Z
  3889    IPAddr :=  DottedIPS tr;
  3890    CallVistA ('ORWTIU P OLL', [Use r.DUZ, IPA ddr, IntTo Hex(frmFra me.Handle,  8)], Load List);
  3891    if Piece( LoadList.V alues['(0, 0)'], '^',  1) = '-1'  then
  3892    begin
  3893     ProcessL oad := fal se;
  3894     CPAppMon .StopTheBu ffer;
  3895    end else
  3896     ProcessL oad := tru e;
  3897   end;
  3898  
  3899   procedure  TfrmFrame. LoadProper ties(Sende r: TObject );
  3900   Var
  3901    SavedStyl es, DivID,  WrdRet, T mp: String ;
  3902   begin
  3903     //Load t he paramet ers
  3904     with CPA ppMon do b egin
  3905      //Check  if the bu ffer has a lread load ed
  3906      DivID : = GetDivis ionID;
  3907      CallVis tA('ORWTIU  WRDCOPY',  [DivID],W rdRet);
  3908      NumberO fWordsToBe gin := Str ToFloatDef (Piece(Wrd Ret, '^',  1), 0);
  3909  
  3910      CallVis tA('ORWTIU  PCTCOPY',  [DivID],  Tmp);
  3911      Percent ToVerify : = (StrToFl oatDef(Tmp , 0) * 100 );
  3912  
  3913      //Is su per user?
  3914      CallVis tA('ORWTIU  VIEWCOPY' , [User.DU Z, 0, DivI d], Tmp);
  3915      SuperUs er := Trim (Tmp) = '2 ';
  3916  
  3917      //load  the exlcud ed apps
  3918      GetUser ListParam( ExcludeApp s, 'ORQQTI U COPY/PAS TE EXCLUDE  APP');
  3919  
  3920      //load  the match  text prope rties
  3921      CallVis tA('ORWTIU  LDCPIDNT' , [nil], S avedStyles );
  3922  
  3923      Display Paste := T rim(SavedS tyles) <>  '-1;Visual  Disable O verride';
  3924      CPAppMo n.Enabled  := Trim(Sa vedStyles)  <> '-2';
  3925  
  3926      if Disp layPaste a nd CPAppMo n.Enabled  then begin
  3927       if Sav edStyles < > '' then  begin
  3928        if (P iece(Saved Styles, ', ', 1) = '1 ') then
  3929         Matc hStyle :=  MatchStyle  + [fsBold ];
  3930        if (P iece(Saved Styles, ', ', 2) = '1 ') then
  3931         Matc hStyle :=  MatchStyle  + [fsItal ic];
  3932        if (P iece(Saved Styles, ', ', 3) = '1 ') then
  3933         Matc hStyle :=  MatchStyle  + [fsUnde rline];
  3934  
  3935        Match Highlight  :=  (Piece (SavedStyl es, ',', 4 ) = '1');
  3936        Highl ightColor  := StrToIn tDef(Piece (SavedStyl es, ',', 5 ), clYello w);
  3937  
  3938        //LCS
  3939        LCSTo ggle := (P iece(Saved Styles, ', ', 6) = '1 ');
  3940        if (P iece(Saved Styles, ', ', 7) = '1 ') then
  3941         LCST extStyle : = LCSTextS tyle + [fs Bold];
  3942        if (P iece(Saved Styles, ', ', 8) = '1 ') then
  3943         LCST extStyle : = LCSTextS tyle + [fs Italic];
  3944        if (P iece(Saved Styles, ', ', 9) = '1 ') then
  3945         LCST extStyle : = LCSTextS tyle + [fs Underline] ;
  3946  
  3947        LCSUs eColor :=   (Piece(Sa vedStyles,  ',', 10)  = '1');
  3948        LCSTe xtColor :=  StrToIntD ef(Piece(S avedStyles , ',', 11) , clRed);
  3949        LCSCh arLimit :=  StrToIntD ef(Piece(S avedStyles , ',', 12) , 0)
  3950       end;
  3951      end;
  3952  
  3953     end;
  3954   end;
  3955  
  3956   procedure  TfrmFrame. SaveBuffer (Sender: T Object; Sa veList: TS tringList;
  3957     var Retu rnList: TS tringList) ;
  3958   var
  3959     I, X, Z,  TotalBuff er, LineCn t, SubLine Cnt: Integ er;
  3960     Division ID, aName,  aValue: s tring;
  3961     aList: i ORNetMult;
  3962     LookUpLs t: THashed StringList ;
  3963   begin
  3964     inherite d;
  3965     TotalBuf fer := Str ToIntDef(S aveList.Va lues['Tota lBufferToS ave'], -1) ;
  3966     Division ID := GetD ivisionID;
  3967     If Total Buffer > - 1 then
  3968     begin
  3969       LookUp Lst := THa shedString List.Creat e;
  3970       try
  3971         Look UpLst.Begi nUpdate;
  3972         Look UpLst.Assi gn(SaveLis t);
  3973         Look UpLst.EndU pdate;
  3974  
  3975         newo rNetMult(a List);
  3976  
  3977         for  I := 1 to  TotalBuffe r do
  3978         begi n
  3979           aL ist.AddSub script([I,  0], LookU pLst.Value s[IntToStr (I) + ',0' ]);
  3980  
  3981           Li neCnt := S trToIntDef (LookUpLst .Values[In tToStr(I)  + ',-1'],  -1);
  3982           fo r X := 1 t o LineCnt  - 1 do
  3983           be gin
  3984              SubLineCnt  :=
  3985                StrToInt Def(LookUp Lst.Values [IntToStr( I) + ',' +  IntToStr( X + 1) +
  3986                ',-1'],  -1);
  3987              if SubLine Cnt > -1 t hen
  3988              begin
  3989                for Z :=  1 to SubL ineCnt - 1  do
  3990                begin
  3991                  aName  := IntToSt r(I) + ','  + IntToSt r(X) + ','  +
  3992                    IntT oStr(Z);
  3993                  aValue  := Filter edString(L ookUpLst.V alues[aNam e]);
  3994                  aList. AddSubscri pt([I,X,Z] , aValue);
  3995                end;
  3996              end
  3997              else
  3998              begin
  3999                aName :=  IntToStr( I) + ',' +  IntToStr( X);
  4000                aValue : = Filtered String(Loo kUpLst.Val ues[aName] );
  4001                aList.Ad dSubscript ([I,X], aV alue);
  4002              end;
  4003           en d;
  4004         end;
  4005  
  4006         Call VistA('ORW TIU SVCOPY ', [aList,  DivisionI D], Return List);
  4007       finall y
  4008         Look UpLst.Free ;
  4009       end;
  4010     end;
  4011   end;
  4012  
  4013   procedure  TfrmFrame. StartPollB uff(Sender : TObject;  var Error : Boolean) ;
  4014   Var
  4015    DivID, IP Addr, TmpR tn: string ;
  4016   begin
  4017     inherite d;
  4018     DivID :=  GetDivisi onID;
  4019     IPAddr : = DottedIP Str;
  4020     CallVist A('ORWTIU  START',  [ User.DUZ,  DivID, IPA ddr, IntTo Hex(frmFra me.Handle,  8)], TmpR tn);
  4021     Error :=  TmpRtn =  '0';
  4022   end;
  4023  
  4024   procedure  TfrmFrame. StopPollBu ff(Sender:  TObject;  var Error:  Boolean);
  4025   Var
  4026    IPAddr, T mpRtn: str ing;
  4027   begin
  4028     inherite d;
  4029     IPAddr : = DottedIP Str;
  4030     CallVist A('ORWTIU  STOP', [Us er.DUZ, IP Addr, IntT oHex(frmFr ame.Handle , 8)], Tmp Rtn);
  4031     Error :=  TmpRtn =  '0';
  4032   end;
  4033  
  4034   procedure  TfrmFrame. CreateTab( ATabID: in teger; ALa bel: strin g);
  4035   begin
  4036     //  old  comment -  try making  owner sel f (instead  of applic ation) to  see if sol ves TMenuI tem.Insert  bug
  4037     case ATa bID of
  4038       CT_PRO BLEMS : be gin
  4039                         frmProblem s := TfrmP roblems.Cr eate(Self) ;
  4040                         frmProblem s.Parent : = pnlPage;
  4041                      en d;
  4042       CT_MED S     : be gin
  4043                         frmMeds :=  TfrmMeds. Create(Sel f);
  4044                         frmMeds.Pa rent := pn lPage;
  4045                         frmMeds.In itfMedsSiz e;
  4046                      en d;
  4047       CT_ORD ERS   : be gin
  4048                         frmOrders  := TfrmOrd ers.Create (Self);
  4049                         frmOrders. Parent :=  pnlPage;
  4050                      en d;
  4051       CT_HP        : be gin
  4052                         // not yet
  4053                      en d;
  4054       CT_NOT ES    : be gin
  4055                         frmNotes : = TfrmNote s.Create(S elf);
  4056                         frmNotes.P arent := p nlPage;
  4057                      en d;
  4058       CT_CON SULTS : be gin
  4059                         frmConsult s := TfrmC onsults.Cr eate(Self) ;
  4060                         frmConsult s.Parent : = pnlPage;
  4061                      en d;
  4062       CT_DCS UMM   : be gin
  4063                         frmDCSumm  := TfrmDCS umm.Create (Self);
  4064                         frmDCSumm. Parent :=  pnlPage;
  4065                      en d;
  4066       CT_LAB S     : be gin
  4067                         frmLabs :=  TfrmLabs. Create(Sel f);
  4068                         frmLabs.Pa rent := pn lPage;
  4069                      en d;
  4070       CT_REP ORTS  : be gin
  4071                         frmReports  := TfrmRe ports.Crea te(Self);
  4072                         frmReports .Parent :=  pnlPage;
  4073                      en d;
  4074       CT_SUR GERY  : be gin
  4075                         frmSurgery  := TfrmSu rgery.Crea te(Self);
  4076                         frmSurgery .Parent :=  pnlPage;
  4077                      en d;
  4078       CT_COV ER    : be gin
  4079                         frmCoverSh eet := Tfr mCoverShee t.Create(S elf);
  4080                         frmCoverSh eet.Parent  := pnlPag e;
  4081                         CoverSheet .OnRefresh CWAD := Re freshCWAD;
  4082                         CoverSheet .OnRefresh Reminders  := Reminde rsChanged;
  4083                      en d;
  4084     else
  4085       Exit;
  4086     end;
  4087     if ATabI D = CT_COV ER then
  4088       begin
  4089         uTab List.Inser t(0, IntTo Str(ATabID ));
  4090         tabP age.Tabs.I nsert(0, A Label);
  4091         tabP age.TabInd ex := 0;
  4092       end
  4093     else
  4094       begin
  4095         uTab List.Add(I ntToStr(AT abID));
  4096         tabP age.Tabs.A dd(ALabel) ;
  4097       end;
  4098   end;
  4099  
  4100   procedure  TfrmFrame. ShowHideCh artTabMenu s(AMenuIte m: TMenuIt em);
  4101   var
  4102     i: integ er;
  4103   begin
  4104     for i :=  0 to AMen uItem.Coun t - 1 do
  4105       AMenuI tem.Items[ i].Visible  := TabExi sts(AMenuI tem.Items[ i].Tag);
  4106   end;
  4107  
  4108   function T frmFrame.T abExists(A TabID: int eger): boo lean;
  4109   begin
  4110     Result : = (uTabLis t.IndexOf( IntToStr(A TabID)) >  -1)
  4111   end;
  4112  
  4113   procedure  TfrmFrame. ReportsOnl yDisplay;
  4114   begin
  4115  
  4116   // Configu re "Edit"  menu:
  4117   menuHideAl lBut(mnuEd it, mnuEdi tPref);      // Hide  everything  under Edi t menu exc ept Prefer ences.
  4118   menuHideAl lBut(mnuEd itPref, Pr efs1); //  Hide every thing unde r Preferen ces menu e xcept Font s.
  4119  
  4120   // Remaini ng pull-do wn menus:
  4121   mnuView.vi sible := f alse;
  4122   mnuFileRef resh.visib le := fals e;
  4123   mnuFileEnc ounter.vis ible := fa lse;
  4124   mnuFileRev iew.visibl e := false ;
  4125   mnuFileNex t.visible  := false;
  4126   mnuFileNot ifRemove.v isible :=  false;
  4127   mnuHelpBro ker.visibl e := false ;
  4128   mnuHelpLis ts.visible  := false;
  4129   mnuHelpSym bols.visib le := fals e;
  4130  
  4131   // Top pan el compone nts:
  4132   pnlVisit.h int := 'Pr ovider/Loc ation';
  4133   pnlVisit.o nMouseDown  := nil;
  4134   pnlVisit.o nMouseUp : = nil;
  4135  
  4136   // Forms f or other t abs:
  4137   frmCoverSh eet.visibl e := false ;
  4138   frmProblem s.visible  := false;
  4139   frmMeds.vi sible := f alse;
  4140   frmOrders. visible :=  false;
  4141   frmNotes.v isible :=  false;
  4142   frmConsult s.visible  := false;
  4143   frmDCSumm. visible :=  false;
  4144   if Assigne d(frmSurge ry) then
  4145     frmSurge ry.visible  := false;
  4146   frmLabs.vi sible := f alse;
  4147  
  4148   // Other t abs (so to  speak):
  4149   tabPage.ta bs.clear;
  4150   tabPage.ta bs.add('Re ports');
  4151  
  4152   end;
  4153  
  4154   procedure  TfrmFrame. UpdatePtIn foOnRefres h;
  4155   var
  4156     tmpDFN:  string;
  4157   begin
  4158     tmpDFN : = Patient. DFN;
  4159     Patient. Clear;
  4160     Patient. DFN := tmp DFN;
  4161     uCore.Te mpEncounte rLoc := 0;   //hds759 1  Clinic/ Ward movem ent.
  4162     uCore.Te mpEncounte rLocName : = ''; //hd s7591  Cli nic/Ward m ovement.
  4163     uCore.Te mpEncounte rText := ' ';
  4164     uCore.Te mpEncounte rDateTime  := 0;
  4165     uCore.Te mpEncounte rVistCat : = #0;
  4166     if (not  FRefreshin g) and (FR eviewClick  = false)  then DoNot ChangeEncW indow := f alse;
  4167     if (FPre vInPatient  and Patie nt.Inpatie nt) then                  //tran sfering in side hospi tal
  4168       begin
  4169              if FReview Click = Tr ue then
  4170                begin
  4171                  ucore. TempEncoun terLoc :=  Encounter. Location;
  4172                  uCore. TempEncoun terLocName  := Encoun ter.Locati onName;
  4173                  uCore. TempEncoun terText :=  Encounter .LocationT ext;
  4174                  uCore. TempEncoun terDateTim e := Encou nter.DateT ime;
  4175                  uCore. TempEncoun terVistCat  := Encoun ter.VisitC ategory;
  4176                end
  4177              else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm =  false) th en
  4178                    begi n
  4179                      fr mPrintLoca tion.Switc hEncounter Loction(En counter.Lo cation, En counter.lo cationName , Encounte r.Location Text,
  4180                                                                  En counter.Da teTime, En counter.Vi sitCategor y);
  4181                      Di splayEncou nterText;
  4182                      ex it;
  4183                    end
  4184              else if (p atient.Loc ation <> e ncounter.L ocation) a nd (OrderP rintForm =  True) the n
  4185                begin
  4186                  OrderP rintForm : = false;
  4187                  Exit;
  4188                end;
  4189              if orderpr intform =  false then  Encounter .Location  := Patient .Location;
  4190       end
  4191     else if  (FPrevInPa tient and  (not Patie nt.Inpatie nt)) then      //pati ent was di scharged
  4192     begin
  4193       Encoun ter.Inpati ent := Fal se;
  4194       Encoun ter.Locati on := 0;
  4195       FPrevI nPatient : = False;
  4196       lblPtN ame.Captio n := '';
  4197       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.
  4198     end
  4199     else if  ((not FPre vInPatient ) and Pati ent.Inpati ent) then      //pati ent was ad mitted
  4200     begin
  4201       Encoun ter.Inpati ent := Tru e;
  4202       uCore. TempEncoun terLoc :=  Encounter. Location;   //hds7591   Clinic/W ard moveme nt.
  4203       uCore. TempEncoun terLocName  := Encoun ter.Locati onName; // hds7591  C linic/Ward  movement.
  4204       uCore. TempEncoun terText :=  Encounter .LocationT ext;
  4205       uCore. TempEncoun terDateTim e := Encou nter.DateT ime;
  4206       uCore. TempEncoun terVistCat  := Encoun ter.VisitC ategory;
  4207       lblPtN ame.Captio n := '';
  4208       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.
  4209       if (FR eviewClick  = False)  and (encou nter.Locat ion <> pat ient.Locat ion) and ( OrderPrint Form = fal se) then
  4210           be gin
  4211              frmPrintLo cation.Swi tchEncount erLoction( Encounter. Location,  Encounter. locationNa me, Encoun ter.Locati onText,
  4212                                                       En counter.Da teTime, En counter.Vi sitCategor y);
  4213              //agp valu es are res et dependi ng on the  user proce ss
  4214              uCore.Temp EncounterL oc := 0;   //hds7591   Clinic/Wa rd movemen t.
  4215              uCore.Temp EncounterL ocName :=  ''; //hds7 591  Clini c/Ward mov ement.
  4216              uCore.Temp EncounterT ext := '';
  4217              uCore.Temp EncounterD ateTime :=  0;
  4218              uCore.Temp EncounterV istCat :=  #0;
  4219           en d
  4220       else
  4221       if Ord erPrintFor m = false  then
  4222         begi n
  4223           En counter.Lo cation :=  Patient.Lo cation;
  4224           En counter.Da teTime :=  Patient.Ad mitTime;
  4225           En counter.Vi sitCategor y := 'H';
  4226         end;
  4227       FPrevI nPatient : = True;
  4228     end;
  4229     DisplayE ncounterTe xt;
  4230   end;
  4231  
  4232   procedure  TfrmFrame. UpdateVAAM HVButtons( Sender: TO bject);
  4233   begin
  4234     Patient. RefreshVAA Status;
  4235     Patient. RefreshMHV Status;
  4236  
  4237     if Patie nt.PtIsVAA  then
  4238       laVAA2 .Hint := ' Patient ha s active i nsurance'
  4239     else
  4240       laVAA2 .Hint := ' No active  insurance' ;
  4241  
  4242     if Patie nt.PtIsMHV  then
  4243       laMHV. Hint := 'P atient has  data in M y HealtheV et'
  4244     else
  4245       laMHV. Hint := 'N o MyHealth yVet data' ;
  4246  
  4247     laMHV.Al ign := alT op;
  4248     laMHV.He ight := pa VAA.Client Height div  2;
  4249     laVAA2.A lign := al Client;
  4250  
  4251     laMHV.En abled := P atient.PtI sMHV;
  4252     laVAA2.E nabled :=  Patient.Pt IsVAA;
  4253  
  4254     paVAA.Vi sible := ( Patient.Pt IsVAA or P atient.PtI sMHV);
  4255   end;
  4256  
  4257   procedure  TfrmFrame. FormKeyDow n(Sender:  TObject; v ar Key: Wo rd; Shift:  TShiftSta te);
  4258   var
  4259     NewTabIn dex: integ er;
  4260   begin
  4261     inherite d;
  4262     FCtrlTab Used := FA LSE;
  4263     //CQ2844 : Toggle R emote Data  button us ing Alt+R
  4264      case Ke y of
  4265        82,11 4:  if (ss Alt in Shi ft) then
  4266                     frm Frame.pnlC IRNClick(S ender);
  4267        end;
  4268  
  4269     if (Key  = VK_TAB)  then
  4270     begin
  4271       if (ss Ctrl in Sh ift) then
  4272       begin
  4273         FCtr lTabUsed : = TRUE;
  4274         if n ot (Active Control is  TCustomMe mo) or not  TMemo(Act iveControl ).WantTabs  then begi n
  4275           Ne wTabIndex  := tabPage .TabIndex;
  4276           if  ssShift i n Shift th en
  4277              dec(NewTab Index)
  4278           el se
  4279              inc(NewTab Index);
  4280           if  NewTabInd ex >= tabP age.Tabs.C ount then
  4281              dec(NewTab Index,tabP age.Tabs.C ount)
  4282           el se if NewT abIndex <  0 then
  4283              inc(NewTab Index,tabP age.Tabs.C ount);
  4284           ta bPage.TabI ndex := Ne wTabIndex;
  4285           ta bPageChang e(tabPage) ;
  4286           Ke y := 0;
  4287         end;
  4288       end;
  4289     end;
  4290   end;
  4291  
  4292   procedure  TfrmFrame. FormActiva te(Sender:  TObject);
  4293   var
  4294     aCPRS508 : ICPRS508 ;
  4295   begin
  4296     if Assig ned(FLastP age) then
  4297       if FLa stPage.Inh eritsFrom( TfrmPage)  then
  4298         Tfrm Page(FLast Page).Focu sFirstCont rol
  4299       else i f Supports (fLastPage , ICPRS508 , aCPRS508 ) then
  4300         aCPR S508.OnFoc usFirstCon trol(Sende r);;
  4301   end;
  4302  
  4303   procedure  TfrmFrame. pnlPrimary CareEnter( Sender: TO bject);
  4304   begin
  4305     with Sen der as TPa nel do
  4306       if (Co ntrolCount  > 0) and  (Controls[ 0] is TSpe edButton)  and (TSpee dButton(Co ntrols[0]) .Down)
  4307       then
  4308         Beve lInner :=  bvLowered
  4309       else
  4310         Beve lInner :=  bvRaised;
  4311   end;
  4312  
  4313   procedure  TfrmFrame. pnlPrimary CareExit(S ender: TOb ject);
  4314   var
  4315     ShiftIsD own,TabIsD own : bool ean;
  4316   begin
  4317     with Sen der as TPa nel do beg in
  4318       BevelI nner := bv None;
  4319       //Make  the lstCI RNLocation s act as i f between  pnlCIRN &  pnlReminde rs
  4320       //in t he Tab Ord er
  4321       if (ls tCIRNLocat ions.CanFo cus) then
  4322       begin
  4323         Shif tIsDown :=  Boolean(H i(GetKeySt ate(VK_SHI FT)));
  4324         TabI sDown := B oolean(Hi( GetKeyStat e(VK_TAB)) );
  4325         if T abIsDown t hen
  4326           if  (ShiftIsD own) and ( Name = 'pn lReminders ') then
  4327              lstCIRNLoc ations.Set Focus
  4328           el se if Not  (ShiftIsDo wn) and (N ame = 'pnl CIRN') the n
  4329              lstCIRNLoc ations.Set Focus;
  4330       end;
  4331     end;
  4332   end;
  4333  
  4334   procedure  TfrmFrame. pnlPatient Click(Send er: TObjec t);
  4335   begin
  4336     Screen.C ursor := c rHourglass ; //wat cq  18425 add ed hourgla ss and dis abled mnuF ileOpen
  4337     mnuFileO pen.Enable d := False ;
  4338     try
  4339     pnlPatie nt.Enabled  := false;
  4340     ViewInfo (mnuViewDe mo);
  4341     pnlPatie nt.Enabled  := true;
  4342     finally
  4343       Screen .Cursor :=  crDefault ;
  4344       mnuFil eOpen.Enab led := Tru e;
  4345     end;
  4346   end;
  4347  
  4348   procedure  TfrmFrame. pnlVisitCl ick(Sender : TObject) ;
  4349   begin
  4350     ViewInfo (mnuViewVi sits);
  4351   end;
  4352  
  4353   procedure  TfrmFrame. pnlPrimary CareClick( Sender: TO bject);
  4354   begin
  4355     ViewInfo (mnuViewPr imaryCare) ;
  4356   end;
  4357  
  4358   procedure  TfrmFrame. pnlReminde rsClick(Se nder: TObj ect);
  4359   begin
  4360     if(pnlRe minders.ta g = HAVE_R EMINDERS)  then
  4361         View Info(mnuVi ewReminder s);
  4362  
  4363   end;
  4364  
  4365   procedure  TfrmFrame. pnlPosting sClick(Sen der: TObje ct);
  4366   begin
  4367     ViewInfo (mnuViewPo stings);
  4368   end;
  4369  
  4370   //======== ========== =========  CCOW main  changes == ========== ========== ==
  4371  
  4372   procedure  TfrmFrame. HandleCCOW Error(AMes sage: stri ng);
  4373   begin
  4374     {$ifdef  DEBUG}
  4375       Show50 8Message(A Message);
  4376     {$endif}
  4377     InfoBox( TX_CCOW_ER ROR, TC_CC OW_ERROR,  MB_ICONERR OR or MB_O K);
  4378     FCCOWIns talled :=  False;
  4379     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, 'BM P_CCOW_BRO KEN');
  4380     pnlCCOW. Hint := TX _CCOW_BROK EN;
  4381     mnuFileR esumeConte xt.Visible  := True;
  4382     mnuFileR esumeConte xt.Enabled  := False;
  4383     mnuFileB reakContex t.Visible  := True;
  4384     mnuFileB reakContex t.Enabled  := False;
  4385     FCCOWErr or := True ;
  4386   end;
  4387  
  4388   function T frmFrame.A llowCCOWCo ntextChang e(var CCOW Response:  UserRespon se; NewDFN : string):  boolean;
  4389   var
  4390     PtData :  IContextI temCollect ion;
  4391     PtDataIt em2, PtDat aItem3, Pt DataItem4  : IContext Item;
  4392     response  : UserRes ponse;
  4393     StationN umber: str ing;
  4394     IsProdAc ct: boolea n;
  4395   begin
  4396     Result : = False;
  4397     response  := 0;
  4398     try
  4399       // Sta rt a conte xt change  transactio n
  4400       if FCC OWInstalle d then
  4401          beg in
  4402              FCCOWJustJ oined := F alse;
  4403              FCCOWError  := False;
  4404              imgCCOW.Pi cture.BitM ap.LoadFro mResourceN ame(hInsta nce, 'BMP_ CCOW_CHANG ING');
  4405              pnlCCOW.Hi nt := TX_C COW_CHANGI NG;
  4406              try
  4407                ctxConte xtor.Start ContextCha nge();
  4408              except
  4409                on E: Ex ception do  HandleCCO WError(E.M essage);
  4410              end;
  4411              if FCCOWEr ror then
  4412              begin
  4413                Result : = False;
  4414                Exit;
  4415              end;
  4416              // Set the  new propo sed contex t data.
  4417              PtData :=  CoContextI temCollect ion.Create ();
  4418              StationNum ber := Use r.StationN umber;
  4419              IsProdAcct  := User.I sProductio nAccount;
  4420  
  4421              {$IFDEF CC OWBROKER}
  4422              //IsProdAc ct := RPCB rokerV.Log in.IsProdu ction;  // not yet
  4423              {$ENDIF}
  4424  
  4425              PtDataItem 2 := CoCon textItem.C reate();
  4426              PtDataItem 2.Set_Name ('Patient. co.Patient Name');                  // Pati ent.Name
  4427              PtDataItem 2.Set_Valu e(Piece(Pa tient.Name , ',', 1)  + U + Piec e(Patient. Name, ',',  2) + '^^^ ^');
  4428              PtData.Add (PtDataIte m2);
  4429  
  4430              PtDataItem 3 := CoCon textItem.C reate();
  4431              if not IsP rodAcct th en
  4432                PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber  + '_TEST' )    // Pa tient.DFN
  4433              else
  4434                PtDataIt em3.Set_Na me('Patien t.id.MRN.D FN_' + Sta tionNumber );              // Pa tient.DFN
  4435              PtDataItem 3.Set_Valu e(Patient. DFN);
  4436              PtData.Add (PtDataIte m3);
  4437  
  4438              if Patient .ICN <> ''  then
  4439                begin
  4440                  PtData Item4 := C oContextIt em.Create( );
  4441                  if not  IsProdAcc t then
  4442                    PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber_ TEST')   / / Patient. ICN
  4443                  else
  4444                    PtDa taItem4.Se t_Name('Pa tient.id.M RN.Nationa lIDNumber' );       / / Patient. ICN
  4445                  PtData Item4.Set_ Value(Pati ent.ICN);
  4446                  PtData .Add(PtDat aItem4);
  4447                end;
  4448  
  4449              // End the  context c hange tran saction.
  4450              FCCOWError  := False;
  4451              try
  4452                response  := ctxCon textor.End ContextCha nge(true,  PtData);
  4453              except
  4454                on E: Ex ception do  HandleCCO WError(E.M essage);
  4455              end;
  4456              if FCCOWEr ror then
  4457              begin
  4458                HideEver ything;
  4459                Result : = False;
  4460                Exit;
  4461              end;
  4462          end
  4463       else
  4464         begi n
  4465           Re sult := Tr ue;
  4466           Ex it;
  4467         end;
  4468  
  4469       CCOWRe sponse :=  response;
  4470       if (re sponse = U rCommit) t hen
  4471       begin
  4472         // N ew context  is commit ted.
  4473         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4474         mnuF ileBreakCo ntext.Enab led := Tru e;
  4475         FCCO WIconName  := 'BMP_CC OW_LINKED' ;
  4476         pnlC COW.Hint : = TX_CCOW_ LINKED;
  4477         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4478         Resu lt := True ;
  4479       end
  4480       else i f (respons e = UrCanc el) then
  4481       begin
  4482         // P roposed co ntext chan ge is canc eled. Retu rn to the  current co ntext.
  4483         PtDa ta.RemoveA ll;
  4484         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4485         mnuF ileBreakCo ntext.Enab led := Tru e;
  4486         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4487         Resu lt := Fals e;
  4488       end
  4489       else i f (respons e = UrBrea k) then
  4490       begin
  4491         // T he context or has bro ken the li nk by susp ending.  T his app sh ould
  4492         // u pdate the  Clinical L ink icon,  enable the  Resume me nu item, a nd
  4493         // d isable the  Suspend m enu item.
  4494         PtDa ta.RemoveA ll;
  4495         mnuF ileResumeC ontext.Ena bled := Tr ue;
  4496         mnuF ileBreakCo ntext.Enab led := Fal se;
  4497         FCCO WIconName  := 'BMP_CC OW_BROKEN' ;
  4498         pnlC COW.Hint : = TX_CCOW_ BROKEN;
  4499         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4500         if P atient.Inp atient the n
  4501         begi n
  4502           En counter.In patient :=  True;
  4503           En counter.Lo cation :=  Patient.Lo cation;
  4504           En counter.Da teTime :=  Patient.Ad mitTime;
  4505           En counter.Vi sitCategor y := 'H';
  4506         end;
  4507         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  4508         Setu pPatient;
  4509         tabP age.TabInd ex := Page IDToTab(Us er.Initial Tab);
  4510         tabP ageChange( tabPage);
  4511         Resu lt := Fals e;
  4512       end;
  4513     except
  4514       on exc  : EOleExc eption do
  4515         Show Msg('EOleE xception:  ' + exc.Me ssage);
  4516     end;
  4517   end;
  4518  
  4519   procedure  TfrmFrame. ctxContext orCanceled (Sender: T Object);
  4520   begin
  4521     // Appli cation sho uld mainta in its sta te as the  current (e xisting) c ontext.
  4522     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4523   end;
  4524  
  4525   procedure  TfrmFrame. ctxContext orPending( Sender: TO bject;
  4526     const aC ontextItem Collection : IDispatc h);
  4527   var
  4528     Reason,  HyperLinkR eason: str ing;
  4529     PtChange d: boolean ;
  4530   {$IFDEF CC OWBROKER}
  4531     UserChan ged: boole an;
  4532   {$ENDIF}
  4533   begin
  4534     // If th e app woul d lose dat a, or have  other pro blems chan ging conte xt at
  4535     // this  time, it s hould retu rn a messa ge using S etSurveyRe ponse. Not e that the
  4536     // user  may decide  to commit  the conte xt change  anyway.
  4537     //
  4538     // if (c annot-chan ge-context -without-a -problem)  then
  4539     //   con textor.Set SurveyResp onse('Cond itional ac cept reaso n...');
  4540     if FCCOW Busy then
  4541     begin
  4542       Sleep( 10000);
  4543     end;
  4544  
  4545     FCCOWErr or := Fals e;
  4546     try
  4547       CheckF orDifferen tPatient(a ContextIte mCollectio n, PtChang ed);
  4548   {$IFDEF CC OWBROKER}
  4549       CheckF orDifferen tUser(aCon textItemCo llection,  UserChange d);
  4550   {$ENDIF}
  4551     except
  4552       on E:  Exception  do HandleC COWError(E .Message);
  4553     end;
  4554     if FCCOW Error then
  4555     begin
  4556       HideEv erything;
  4557       Exit;
  4558     end;
  4559  
  4560   {$IFDEF CC OWBROKER}
  4561     if PtCha nged or Us erChanged  then
  4562   {$ELSE}
  4563     if PtCha nged then
  4564   {$ENDIF}
  4565       begin
  4566         FCCO WContextCh anging :=  True;
  4567         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  'BMP_CCOW _CHANGING' );
  4568         pnlC COW.Hint : = TX_CCOW_ CHANGING;
  4569         Allo wContextCh angeAll(Re ason);
  4570       end;
  4571     CheckHyp erlinkResp onse(aCont extItemCol lection, H yperlinkRe ason);
  4572     Reason : = Hyperlin kReason +  Reason;
  4573     if Pos(' COM_OBJECT _ACTIVE',  Reason) >  0 then
  4574       Sleep( 12000)
  4575     else if  Length(Rea son) > 0 t hen
  4576       ctxCon textor.Set SurveyResp onse(Reaso n)
  4577     else
  4578       begin
  4579         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  'BMP_CCOW _LINKED');
  4580         pnlC COW.Hint : = TX_CCOW_ LINKED;
  4581       end;
  4582     FCCOWCon textChangi ng := Fals e;
  4583   end;
  4584  
  4585   procedure  TfrmFrame. ctxContext orCommitte d(Sender:  TObject);
  4586   var
  4587     Reason:  string;
  4588     PtChange d: boolean ;
  4589     i: integ er;
  4590   begin
  4591     // Appli cation sho uld now ac cess the n ew context  and updat e its stat e.
  4592     FCCOWErr or := Fals e;
  4593     try
  4594     {$IFDEF  CCOWBROKER }
  4595       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
  4596       begin
  4597         Reas on := 'COM MIT';
  4598         if A llowContex tChangeAll (Reason) t hen
  4599         begi n
  4600           Cl ose;
  4601           Ex it;
  4602         end;
  4603       end;
  4604     {$ENDIF}
  4605       CheckF orDifferen tPatient(c txContexto r.CurrentC ontext, Pt Changed);
  4606     except
  4607       on E:  Exception  do HandleC COWError(E .Message);
  4608     end;
  4609     if FCCOW Error then
  4610     begin
  4611       HideEv erything;
  4612       Exit;
  4613     end;
  4614     if not P tChanged t hen exit;
  4615     FCCOWDri vedChange  := True;
  4616     i := 0;
  4617     while Le ngth(Scree n.Forms[i] .Name) > 0  do
  4618     begin
  4619       if fsM odal in Sc reen.Forms [i].FormSt ate then
  4620       begin
  4621         Scre en.Forms[i ].ModalRes ult := mrC ancel;
  4622         i :=  i + 1;
  4623       end el se  // the  fsModal f orms alway s sequence d prior to  the none- fsModal fo rms
  4624         Brea k;
  4625     end;
  4626     Reason : = 'COMMIT' ;
  4627     if Allow ContextCha ngeAll(Rea son) then  UpdateCCOW Context;
  4628     FCCOWIco nName := ' BMP_CCOW_L INKED';
  4629     pnlCCOW. Hint := TX _CCOW_LINK ED;
  4630     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4631   end;
  4632  
  4633   function T frmFrame.F indBestCCO WDFN: stri ng;
  4634   var
  4635     data: IC ontextItem Collection ;
  4636     anItem:  IContextIt em;
  4637     StationN umber, tem pDFN: stri ng;
  4638     IsProdAc ct:  Boole an;
  4639  
  4640     procedur e FindNext BestDFN;
  4641     begin
  4642       Statio nNumber :=  User.Stat ionNumber;
  4643       if IsP rodAcct th en
  4644         anIt em := data .Present(' Patient.id .MRN.DFN_'  + Station Number)
  4645       else
  4646         anIt em := data .Present(' Patient.id .MRN.DFN_'  + Station Number + ' _TEST');
  4647       if anI tem <>  ni l then tem pDFN := an Item.Get_V alue();
  4648     end;
  4649  
  4650   begin
  4651     if uCore .User = ni l then
  4652     begin
  4653       Result  := '';
  4654       exit;
  4655     end;
  4656     IsProdAc ct := User .IsProduct ionAccount ;
  4657     // Get a n item col lection of  the curre nt context
  4658     FCCOWErr or := Fals e;
  4659     try
  4660       data : = ctxConte xtor.Curre ntContext;
  4661     except
  4662       on E:  Exception  do HandleC COWError(E .Message);
  4663     end;
  4664     if FCCOW Error then
  4665     begin
  4666       HideEv erything;
  4667       Exit;
  4668     end;
  4669     // Retri eve the Co ntextItem  name and v alue as st rings
  4670     if IsPro dAcct then
  4671       anItem  := data.P resent('Pa tient.id.M RN.Nationa lIDNumber' )
  4672     else
  4673       anItem  := data.P resent('Pa tient.id.M RN.Nationa lIDNumber_ TEST');
  4674     if anIte m <> nil t hen
  4675       begin
  4676         temp DFN := Get DFNFromICN (anItem.Ge t_Value()) ;                        // "Pub lic" RPC c all
  4677         if t empDFN = ' -1' then F indNextBes tDFN;
  4678       end
  4679     else
  4680       FindNe xtBestDFN;
  4681     Result : = tempDFN;
  4682     data :=  nil;
  4683     anItem : = nil;
  4684   end;
  4685  
  4686   procedure  TfrmFrame. UpdateCCOW Context;
  4687   var
  4688     PtDFN(*,  PtName*):  string;
  4689   begin
  4690     if not F CCOWInstal led then e xit;
  4691     DoNotCha ngeEncWind ow := fals e;
  4692     PtDFN :=  FindBestC COWDFN;
  4693     if StrTo Int64Def(P tDFN, 0) >  0 then
  4694       begin
  4695         // S elect new  patient ba sed on con text value
  4696         if P atient.DFN  = PtDFN t hen exit;
  4697         Pati ent.DFN :=  PtDFN;
  4698         if ( Patient.Na me = '-1')  then
  4699           be gin
  4700              HideEveryt hing;
  4701              exit;
  4702           en d
  4703         else
  4704           Sh owEverythi ng;
  4705         Enco unter.Clea r;
  4706         if P atient.Inp atient the n
  4707         begi n
  4708           En counter.In patient :=  True;
  4709           En counter.Lo cation :=  Patient.Lo cation;
  4710           En counter.Da teTime :=  Patient.Ad mitTime;
  4711           En counter.Vi sitCategor y := 'H';
  4712         end;
  4713         if U ser.IsProv ider then  Encounter. Provider : = User.DUZ ;
  4714         if n ot FFirstL oad then S etupPatien t;
  4715         { fr mCover.Upd ateVAAButt on; //VAA}
  4716         Upda teVAAMHVBu ttons(nil) ;
  4717         Dete rmineNextT ab;
  4718         tabP age.TabInd ex := Page IDToTab(Ne xtTab);
  4719         tabP ageChange( tabPage);
  4720       end
  4721     else
  4722       HideEv erything;
  4723   end;
  4724  
  4725   procedure  TfrmFrame. mnuFileBre akContextC lick(Sende r: TObject );
  4726   begin
  4727     FCCOWErr or := Fals e;
  4728     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4729     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4730     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4731     try
  4732       ctxCon textor.Sus pend;
  4733     except
  4734       on E:  Exception  do HandleC COWError(E .Message);
  4735     end;
  4736     if FCCOW Error then  exit;
  4737     FCCOWIco nName := ' BMP_CCOW_B ROKEN';
  4738     pnlCCOW. Hint := TX _CCOW_BROK EN;
  4739     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4740     mnuFileR esumeConte xt.Enabled  := True;
  4741     mnuFileB reakContex t.Enabled  := False;
  4742   end;
  4743  
  4744   procedure  TfrmFrame. mnuFileRes umeContext GetClick(S ender: TOb ject);
  4745   var
  4746     Reason:  string;
  4747   begin
  4748     Reason : = '';
  4749     if not A llowContex tChangeAll (Reason) t hen exit;
  4750     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4751     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4752     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4753     FCCOWErr or := Fals e;
  4754     try
  4755       ctxCon textor.Res ume;
  4756     except
  4757       on E:  Exception  do HandleC COWError(E .Message);
  4758     end;
  4759     if FCCOW Error then  exit;
  4760     UpdateCC OWContext;
  4761     if not F NoPatientS elected th en
  4762     begin
  4763       FCCOWI conName :=  'BMP_CCOW _LINKED';
  4764       pnlCCO W.Hint :=  TX_CCOW_LI NKED;
  4765       imgCCO W.Picture. BitMap.Loa dFromResou rceName(hI nstance, F CCOWIconNa me);
  4766       mnuFil eResumeCon text.Enabl ed := Fals e;
  4767       mnuFil eBreakCont ext.Visibl e := True;
  4768       mnuFil eBreakCont ext.Enable d := True;
  4769     end;
  4770   end;
  4771  
  4772   procedure  TfrmFrame. mnuFileRes umeContext SetClick(S ender: TOb ject);
  4773   var
  4774     CCOWResp onse: User Response;
  4775     Reason:  string;
  4776   begin
  4777     Reason : = '';
  4778     if not A llowContex tChangeAll (Reason) t hen exit;
  4779     FCCOWIco nName := ' BMP_CCOW_C HANGING';
  4780     pnlCCOW. Hint := TX _CCOW_CHAN GING;
  4781     imgCCOW. Picture.Bi tMap.LoadF romResourc eName(hIns tance, FCC OWIconName );
  4782     FCCOWErr or := Fals e;
  4783     try
  4784       ctxCon textor.Res ume;
  4785     except
  4786       on E:  Exception  do HandleC COWError(E .Message);
  4787     end;
  4788     if FCCOW Error then  exit;
  4789     if (Allo wCCOWConte xtChange(C COWRespons e, Patient .DFN)) the n
  4790       begin
  4791         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4792         mnuF ileBreakCo ntext.Visi ble := Tru e;
  4793         mnuF ileBreakCo ntext.Enab led := Tru e;
  4794         FCCO WIconName  := 'BMP_CC OW_LINKED' ;
  4795         pnlC COW.Hint : = TX_CCOW_ LINKED;
  4796         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4797       end
  4798     else
  4799       begin
  4800         mnuF ileResumeC ontext.Ena bled := Tr ue;
  4801         mnuF ileBreakCo ntext.Enab led := Fal se;
  4802         FCCO WIconName  := 'BMP_CC OW_BROKEN' ;
  4803         pnlC COW.Hint : = TX_CCOW_ BROKEN;
  4804         imgC COW.Pictur e.BitMap.L oadFromRes ourceName( hInstance,  FCCOWIcon Name);
  4805         try
  4806           if  ctxContex tor.State  in [csPart icipating]  then ctxC ontextor.S uspend;
  4807         exce pt
  4808           on  E: Except ion do Han dleCCOWErr or(E.Messa ge);
  4809         end;
  4810      end;
  4811     SetupPat ient;
  4812     tabPage. TabIndex : = PageIDTo Tab(User.I nitialTab) ;
  4813     tabPageC hange(tabP age);
  4814   end;
  4815  
  4816   procedure  TfrmFrame. CheckForDi fferentPat ient(aCont extItemCol lection: I Dispatch;  var PtChan ged: boole an);
  4817   var
  4818     data : I ContextIte mCollectio n;
  4819     anItem:  IContextIt em;
  4820     PtDFN, P tName: str ing;
  4821   begin
  4822     if uCore .Patient =  nil then
  4823     begin
  4824       PtChan ged := Fal se;
  4825       Exit;
  4826     end;
  4827     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4828     PtDFN :=  FindBestC COWDFN;
  4829     // Retri eve the Co ntextItem  name and v alue as st rings
  4830     anItem : = data.Pre sent('Pati ent.co.Pat ientName') ;
  4831     if anIte m <> nil t hen PtName  := anItem .Get_Value ();
  4832     PtChange d := not ( (PtDFN = P atient.DFN ) and (PtN ame = Piec e(Patient. Name, ',',  1) + U +  Piece(Pati ent.Name,  ',', 2) +  '^^^^'));
  4833   end;
  4834  
  4835   {$IFDEF CC OWBROKER}
  4836   procedure  TfrmFrame. CheckForDi fferentUse r(aContext ItemCollec tion: IDis patch; var  UserChang ed: boolea n);
  4837   var
  4838     data : I ContextIte mCollectio n;
  4839   begin
  4840     if uCore .User = ni l then
  4841     begin
  4842       UserCh anged := F alse;
  4843       Exit;
  4844     end;
  4845     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4846     UserChan ged := RPC BrokerV.Is UserContex tPending(d ata);
  4847   end;
  4848   {$ENDIF}
  4849  
  4850   procedure  TfrmFrame. CheckHyper linkRespon se(aContex tItemColle ction: IDi spatch; va r Hyperlin kReason: s tring);
  4851   var
  4852     data : I ContextIte mCollectio n;
  4853     anItem :  IContextI tem;
  4854     itemvalu e: string;
  4855     PtSubjec t: string;
  4856   begin
  4857     data :=  IContextIt emCollecti on(aContex tItemColle ction) ;
  4858       anItem :=  data.Prese nt('[hds_m ed_ DOMAIN . EXT ]request.i d.name');
  4859     // Retri eve the Co ntextItem  name and v alue as st rings
  4860     if anIte m <> nil t hen
  4861       begin
  4862         item Value := a nItem.Get_ Value();
  4863         if i temValue =  'GetWindo wHandle' t hen
  4864           be gin
  4865              PtSubject  := 'patien t.id.mrn.d fn_' + Use r.StationN umber;
  4866              if not Use r.IsProduc tionAccoun t then PtS ubject :=  PtSubject  + '_test';
  4867              if data.Pr esent(PtSu bject) <>  nil then
  4868                Hyperlin kReason :=  '!@#$' +  IntToStr(S elf.Handle ) + ':0:'
  4869              else
  4870                Hyperlin kReason :=  '';
  4871           en d;
  4872       end;
  4873   end;
  4874  
  4875   procedure  TfrmFrame. HideEveryt hing(AMess age: strin g = 'No pa tient is c urrently s elected.') ;
  4876   begin
  4877     FNoPatie ntSelected  := TRUE;
  4878     pnlNoPat ientSelect ed.Caption  := AMessa ge;
  4879     pnlNoPat ientSelect ed.Visible  := True;
  4880     pnlNoPat ientSelect ed.BringTo Front;
  4881     mnuFileR eview.Enab led := Fal se;
  4882     mnuFileP rint.Enabl ed := Fals e;
  4883     mnuFileP rintSelect edItems.En abled := F alse;
  4884     mnuFileE ncounter.E nabled :=  False;
  4885     mnuFileN ext.Enable d := False ;
  4886     mnuFileR efresh.Ena bled := Fa lse;
  4887     mnuFileP rintSetup. Enabled :=  False;
  4888     mnuFileP rintSelect edItems.En abled := F alse;
  4889     mnuFileN otifRemove .Enabled : = False;
  4890     mnuFileR esumeConte xt.Enabled  := False;
  4891     mnuFileB reakContex t.Enabled  := False;
  4892     mnuEdit. Enabled :=  False;
  4893     mnuView. Enabled :=  False;
  4894     mnuTools .Enabled : = False;
  4895     if FNext ButtonActi ve then FN extButton. Visible :=  False;
  4896   end;
  4897  
  4898   procedure  TfrmFrame. ShowEveryt hing;
  4899   begin
  4900     FNoPatie ntSelected  := FALSE;
  4901     pnlNoPat ientSelect ed.Caption  := '';
  4902     pnlNoPat ientSelect ed.Visible  := False;
  4903     pnlNoPat ientSelect ed.SendToB ack;
  4904     mnuFileR eview.Enab led := Tru e;
  4905     mnuFileP rint.Enabl ed := True ;
  4906     mnuFileE ncounter.E nabled :=  True;
  4907     mnuFileN ext.Enable d := True;
  4908     mnuFileR efresh.Ena bled := Tr ue;
  4909     mnuFileP rintSetup. Enabled :=  True;
  4910     mnuFileP rintSelect edItems.En abled := T rue;
  4911     mnuFileN otifRemove .Enabled : = True;
  4912     if not F CCOWError  then
  4913     begin
  4914       if FCC OWIconName = 'BMP_CCO W_BROKEN'  then
  4915       begin
  4916         mnuF ileResumeC ontext.Ena bled := Tr ue;
  4917         mnuF ileBreakCo ntext.Enab led := Fal se;
  4918       end el se
  4919       begin
  4920         mnuF ileResumeC ontext.Ena bled := Fa lse;
  4921         mnuF ileBreakCo ntext.Enab led := Tru e;
  4922       end;
  4923     end;
  4924     mnuEdit. Enabled :=  True;
  4925     mnuView. Enabled :=  True;
  4926     mnuTools .Enabled : = True;
  4927     if FNext ButtonActi ve then FN extButton. Visible :=  True;
  4928   end;
  4929  
  4930  
  4931   procedure  TfrmFrame. pnlFlagMou seDown(Sen der: TObje ct; Button : TMouseBu tton;
  4932     Shift: T ShiftState ; X, Y: In teger);
  4933   begin
  4934     pnlFlag. BevelOuter  := bvLowe red;
  4935   end;
  4936  
  4937   procedure  TfrmFrame. pnlFlagMou seUp(Sende r: TObject ; Button:  TMouseButt on;
  4938     Shift: T ShiftState ; X, Y: In teger);
  4939   begin
  4940     pnlFlag. BevelOuter  := bvRais ed;
  4941   end;
  4942  
  4943   procedure  TfrmFrame. pnlOTHDCli ck(Sender:  TObject);  // rpk 1/ 5/2018
  4944   var
  4945     tmpstr:  String;
  4946   begin
  4947     inherite d;
  4948     tmpstr : = 'Other T han Honora ble Status ' + CRLF +  CRLF +
  4949       OTHDLo ngStr1;
  4950     if OTHDL ongStr2 >  '' then
  4951       tmpstr  := tmpstr  + CRLF +  OTHDLongSt r2;
  4952     if OTHDL ocalMsg >  '' then
  4953       tmpstr  := tmpstr  + CRLF +  CRLF + OTH DLocalMsg;
  4954     ShowMsg( tmpstr);   // rpk 2/2 8/2018
  4955   end;
  4956  
  4957   procedure  TfrmFrame. pnlOTHDEnt er(Sender:  TObject);   // rpk 1 /5/2018
  4958   const
  4959     M_WVERT        = 6;
  4960   begin
  4961     inherite d;
  4962     lblOTHDT itle.Capti on := 'Oth er than Ho norable: '  + OTHDLoc alMsg;
  4963     lblOTHD. Caption :=  OTHDLongS tr1;
  4964     if OTHDL ongStr2 >  '' then
  4965       lblOTH D.Caption  := lblOTHD .Caption +  ', ' + OT HDLongStr2 ;
  4966     pnlOTHD. Width        := Highe rOf( (lblO THDTitle.W idth + (M_ WVERT * 2) ),
  4967                               (lbl OTHD.Width  + (M_WVER T * 2)) );   // rpk 1 2/6/2017
  4968     pnlOTHD. Left := pa VAA.Left -  pnlOTHD.W idth; // r pk 1/4/201 8
  4969     with Sen der as TPa nel do
  4970       BevelI nner := bv Raised;
  4971   end;
  4972  
  4973   procedure  TfrmFrame. pnlOTHDExi t(Sender:  TObject);   // rpk 1/ 5/2018
  4974   const
  4975     M_WVERT        = 6;
  4976   begin
  4977     inherite d;
  4978     with Sen der as TPa nel do
  4979       BevelI nner := bv None;
  4980     lblOTHDT itle.Capti on := 'OTH ';
  4981     lblOTHD. Caption :=  OTHDShort Str;
  4982     pnlOTHD. Width        := Highe rOf( (lblO THDTitle.W idth + (M_ WVERT * 2) ),
  4983                               (lbl OTHD.Width  + (M_WVER T * 2)) );   // rpk 1 2/6/2017
  4984     pnlOTHD. Left := pa VAA.Left -  pnlOTHD.W idth; // r pk 1/4/201 8
  4985     lblPtCar e.Refresh;
  4986     lblPtAtt ending.Ref resh;
  4987     lblPtMHT C.Refresh;
  4988   end;
  4989  
  4990  
  4991   procedure  TfrmFrame. pnlFlagCli ck(Sender:  TObject);
  4992   begin
  4993     ViewInfo (mnuViewFl ags);
  4994   end;
  4995  
  4996   procedure  TfrmFrame. mnuFilePri ntSelected ItemsClick (Sender: T Object);
  4997   begin
  4998       case T abToPageID (tabPage.T abIndex) o f
  4999         CT_N OTES:    f rmNotes.Ls tNotesToPr int;
  5000         CT_C ONSULTS: f rmConsults .LstConsul tsToPrint;
  5001         CT_D CSUMM:   f rmDCSumm.L stSummsToP rint;
  5002    end; {cas e}
  5003   end;
  5004  
  5005   procedure  TfrmFrame. mnuAlertRe newClick(S ender: TOb ject);
  5006   var XQAID:  string;
  5007   begin
  5008     XQAID :=  Piece(Not ifications .RecordID,  '^', 2);
  5009     RenewAle rt(XQAID);
  5010   end;
  5011  
  5012   procedure  TfrmFrame. mnuFileVie wNotificat ionsClick( Sender: TO bject);
  5013   begin
  5014     ShowPati entNotific ations(mnu FileNextCl ick);
  5015   end;
  5016  
  5017   procedure  TfrmFrame. mnuAlertFo rwardClick (Sender: T Object);
  5018   var
  5019     XQAID, A lertMsg: s tring;
  5020   begin
  5021     XQAID :=  Piece(Not ifications .RecordID, '^', 2);
  5022     AlertMsg  := Piece( Notificati ons.Record ID, '^', 1 );
  5023     RenewAle rt(XQAID);   // must  renew/rest ore an ale rt before  it can be  forwarded
  5024     ForwardA lertTo(XQA ID + '^' +  AlertMsg) ;
  5025   end;
  5026  
  5027   procedure  TfrmFrame. mnuGECStat usClick(Se nder: TObj ect);
  5028   var
  5029   ans, Resul t,str,str1 ,title: st ring;
  5030   cnt,i: int eger;
  5031   fin: boole an;
  5032  
  5033   begin
  5034   //  Result  := sCallV ('ORQQPXRM  GEC STATU S PROMPT',  [Patient. DFN]);
  5035     if CallV istA('ORQQ PXRM GEC S TATUS PROM PT', [Pati ent.DFN],R esult) and
  5036       (Piece (Result,U, 1) <> '0')  then
  5037       begin
  5038         titl e := Piece (Result,U, 2);
  5039           if  pos('~',P iece(Resul t,U,1))>0  then
  5040                   begin
  5041                   str:= '';
  5042                   str1  := Piece(R esult,U,1) ;
  5043                   cnt : = DelimCou nt(str1, ' ~');
  5044                   for i :=1 to cnt +1 do
  5045                       b egin
  5046                       i f i = 1 th en str :=  Piece(str1 ,'~',i);
  5047                       i f i > 1 th en str :=s tr+CRLF+Pi ece(str1,' ~',i);
  5048                       e nd;
  5049                 end
  5050                 else st r := Piece (Result,U, 1);
  5051           if  Piece(Res ult,U,3)=' 1' then
  5052              begin
  5053                 fin :=  (InfoBox(s tr,title,  MB_YESNO o r MB_DEFBU TTON2)=IDY ES);
  5054                 if fin  = true the n ans := ' 1';
  5055                 if fin  = false th en ans :=  '0';
  5056   //              CallV ('ORQQPXRM  GEC FINIS HED?',[Pat ient.DFN,a ns]);
  5057                 CallVis tA('ORQQPX RM GEC FIN ISHED?',[P atient.DFN ,ans]);
  5058              end
  5059           el se
  5060           In foBox(str, title, MB_ OK);
  5061       end;
  5062   end;
  5063  
  5064   procedure  TfrmFrame. pnlFlagEnt er(Sender:  TObject);
  5065   begin
  5066     pnlFlag. BevelInner  := bvRais ed;
  5067     pnlFlag. BevelOuter  := bvNone ;
  5068     pnlFlag. BevelWidth  := 3;
  5069   end;
  5070  
  5071   procedure  TfrmFrame. pnlFlagExi t(Sender:  TObject);
  5072   begin
  5073     pnlFlag. BevelWidth  := 2;
  5074     pnlFlag. BevelInner  := bvNone ;
  5075     pnlFlag. BevelOuter  := bvRais ed;
  5076   end;
  5077  
  5078   procedure  TfrmFrame. tabPageMou seDown(Sen der: TObje ct; Button : TMouseBu tton;
  5079     Shift: T ShiftState ; X, Y: In teger);
  5080   begin
  5081     inherite d;
  5082     TabCtrlC licked :=  True;
  5083   end;
  5084  
  5085   procedure  TfrmFrame. tabPageMou seUp(Sende r: TObject ; Button:  TMouseButt on;
  5086     Shift: T ShiftState ; X, Y: In teger);
  5087   begin
  5088     LastTab  := TabToPa geID((send er as TTab Control).T abIndex);
  5089   end;
  5090  
  5091   procedure  TfrmFrame. lstCIRNLoc ationsExit (Sender: T Object);
  5092   begin
  5093       //Make  the lstCI RNLocation s act as i f between  pnlCIRN &  pnlReminde rs
  5094       //in t he Tab Ord er
  5095     if Boole an(Hi(GetK eyState(VK _TAB))) th en
  5096       if Boo lean(Hi(Ge tKeyState( VK_SHIFT)) ) then
  5097         pnlC IRN.SetFoc us
  5098       else
  5099         pnlR eminders.S etFocus;
  5100   end;
  5101  
  5102   procedure  TfrmFrame. AppEventsA ctivate(Se nder: TObj ect);
  5103   begin
  5104     FJustEnt eredApp :=  True;
  5105   end;
  5106  
  5107   procedure  TfrmFrame. AppEventsM essage(var  Msg: tagM SG; var Ha ndled: Boo lean);
  5108   var
  5109     Control:  TComponen t;
  5110   begin
  5111     Handled  := false;
  5112     if (Msg. message =  WM_MOUSEWH EEL) and ( GetKeyStat e(VK_LBUTT ON) < 0) t hen begin
  5113       Contro l := FindC ontrol(Msg .hwnd);
  5114       if not  Assigned( Control) t hen
  5115         Hand led := Tru e
  5116       else i f (Control  is TRichE dit) then  begin
  5117         Hand led := Tru e;
  5118         Send Message(se lf.Handle,  EM_SETZOO M, 0, 0);
  5119       end;
  5120      end;
  5121   end;
  5122  
  5123   procedure  TfrmFrame. ScreenActi veFormChan ge(Sender:  TObject);
  5124   begin
  5125     if(assig ned(FOldAc tiveFormCh ange)) the n
  5126       FOldAc tiveFormCh ange(Sende r);
  5127     //Focus  the Form t hat Stays  on Top aft er the App lication R egains foc us.
  5128     if FJust EnteredApp  then
  5129       FocusA pplication TopForm;
  5130     FJustEnt eredApp :=  false;
  5131   end;
  5132  
  5133   procedure  TfrmFrame. FocusAppli cationTopF orm;
  5134   var
  5135     I : inte ger;
  5136   begin
  5137     for I :=  (Screen.F ormCount-1 ) downto 0  do //Set  the last o ne opened  last
  5138     begin
  5139       with S creen.Form s[I] do
  5140         if ( FormStyle  = fsStayOn Top) and ( Enabled) a nd (Visibl e) then
  5141           Se tFocus;
  5142     end;
  5143   end;
  5144  
  5145   procedure  TfrmFrame. AppEventsS hortCut(va r Msg: TWM Key;
  5146     var Hand led: Boole an);
  5147   begin
  5148     if ((Boo lean(Hi(Ge tKeyState( VK_MENU{AL T})))) and  (Msg.Char Code = VK_ F1)) then
  5149     begin
  5150       FocusA pplication TopForm;
  5151       Handle d := True;
  5152     end;
  5153   end;
  5154  
  5155   procedure  TfrmFrame. mnuToolsGr aphingClic k(Sender:  TObject);
  5156   var
  5157     contexth int: strin g;
  5158   begin
  5159     Screen.C ursor := c rHourGlass ;
  5160     contexth int := mnu ToolsGraph ing.Hint;
  5161     if Graph Float = ni l then                // new gra ph
  5162     begin
  5163       GraphF loat := Tf rmGraphs.C reate(self );
  5164       try
  5165         with  GraphFloa t do
  5166         begi n
  5167           if  btnClose. Tag = 1 th en
  5168           be gin
  5169              Screen.Cur sor := crD efault;
  5170              exit;
  5171           en d;
  5172           In itialize;
  5173           Ca ption := ' CPRS Graph ing - Pati ent: ' + M ixedCase(P atient.Nam e);
  5174           Bo rderIcons  := [biSyst emMenu, bi Maximize,  biMinimize ];
  5175           Bo rderStyle  := bsSizea ble;
  5176           Bo rderWidth  := 1;
  5177           //  context s ensitive        type  (tabPage.T abIndex)   & [item]
  5178           Re sizeAnchor edFormToFo nt(GraphFl oat);
  5179           Gr aphFloat.p nlFooter.H int := con texthint;    // conte xt from la b most rec ent
  5180           Sh ow;
  5181         end;
  5182       finall y
  5183         if G raphFloat. btnClose.T ag = 1 the n
  5184         begi n
  5185           Gr aphFloatAc tive := fa lse;
  5186           Gr aphFloat.F ree;
  5187           Gr aphFloat : = nil;
  5188         end
  5189         else
  5190           Gr aphFloatAc tive := tr ue;
  5191       end;
  5192     end
  5193     else
  5194     begin
  5195       GraphF loat.Capti on := 'CPR S Graphing  - Patient : ' + Mixe dCase(Pati ent.Name);
  5196       GraphF loat.pnlFo oter.Hint  := context hint;   //  context f rom lab mo st recent
  5197       if Gra phFloat.bt nClose.Tag  = 1 then
  5198       begin
  5199         Scre en.Cursor  := crDefau lt;
  5200         exit ;
  5201       end
  5202       else i f GraphFlo atActive a nd (frmGra phData.pnl Data.Hint  = Patient. DFN) then
  5203       begin
  5204         if l ength(Grap hFloat.pnl Footer.Hin t) > 1 the n
  5205         begi n
  5206           Gr aphFloat.C lose;
  5207           Gr aphFloatAc tive := tr ue;
  5208           Gr aphFloat.S how;
  5209         end;
  5210         Grap hFloat.Bri ngToFront;               // grap h is activ e, same pa tient
  5211       end
  5212       else i f frmGraph Data.pnlDa ta.Hint =  Patient.DF N then
  5213       begin                                     // graph  is not ac tive, same  patient
  5214         // c ontext sen sitive
  5215         Grap hFloat.Sho w;
  5216         Grap hFloatActi ve := true ;
  5217       end
  5218       else
  5219       //with  GraphFloa t do                      // new  patient
  5220       begin
  5221         Grap hFloat.Ini tialRetain ;
  5222         Grap hFloatActi ve := fals e;
  5223         Grap hFloat.Fre e;
  5224         Grap hFloat :=  nil;
  5225         mnuT oolsGraphi ngClick(se lf);           // del ete and re curse
  5226       end;
  5227     end;
  5228     mnuTools Graphing.H int := '';
  5229     Screen.C ursor := c rDefault;
  5230   end;
  5231  
  5232   procedure  TfrmFrame. pnlCIRNMou seDown(Sen der: TObje ct; Button : TMouseBu tton; Shif t: TShiftS tate; X, Y : Integer) ;
  5233   begin
  5234     pnlCIRN. BevelOuter  := bvLowe red;
  5235   end;
  5236  
  5237   procedure  TfrmFrame. pnlCIRNMou seUp(Sende r: TObject ; Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  5238   begin
  5239     pnlCIRN. BevelOuter  := bvRais ed;
  5240   end;
  5241  
  5242   procedure  TfrmFrame. laMHVClick (Sender: T Object);
  5243   begin
  5244     ViewInfo (mnuViewMy HealtheVet );
  5245   end;
  5246  
  5247   procedure  TfrmFrame. laVAA2Clic k(Sender:  TObject);
  5248   begin
  5249     ViewInfo (mnuInsura nce);
  5250   end;
  5251  
  5252   procedure  TfrmFrame. lblOTHDCli ck(Sender:  TObject);  // rpk 1/ 5/2018
  5253   begin
  5254     inherite d;
  5255     pnlOTHDC lick(lblOT HD);
  5256   end;
  5257  
  5258   procedure  TfrmFrame. lblOTHDTit leClick(Se nder: TObj ect);  //  rpk 1/5/20 18
  5259   begin
  5260     inherite d;
  5261     pnlOTHDC lick(lblOT HDTitle);
  5262   end;
  5263  
  5264   procedure  TfrmFrame. ViewInfo(S ender: TOb ject);
  5265   var
  5266     SelectNe w: Boolean ;
  5267     { TODO 5  -oDanP -c New CoverS heet : Nee d to finis h the VAA  button stu ff ASAP! }
  5268     aInsuran ceSubscrib erName: st ring;
  5269     aReportT ext: TStri ngList;
  5270     aAddress : string;
  5271     ID: inte ger;
  5272     aCPRS508 : ICPRS508 ;
  5273     sl: TStr ings;
  5274   begin
  5275     if Sende r is TMenu Item then  begin
  5276       ID :=  TMenuItem( Sender).Ta g;
  5277     end else  if Sender  is TActio n then beg in
  5278       ID :=  TAction(Se nder).Tag;
  5279     end else  begin
  5280       ID :=  -1;
  5281     end;
  5282     case ID  of
  5283       1:begi n { displa ys patient  inquiry r eport (whi ch optiona lly allows  new patie nt to be s elected) }
  5284           St atusText(T X_PTINQ);
  5285           Pa tientInqui ry(SelectN ew);
  5286           if  Assigned( FLastPage)  then
  5287              if FLastPa ge.Inherit sFrom(Tfrm Page) then
  5288                TfrmPage (FLastPage ).FocusFir stControl
  5289              else if Su pports(fLa stPage, IC PRS508, aC PRS508) th en
  5290                aCPRS508 .OnFocusFi rstControl (Sender);
  5291           St atusText(' ');
  5292           if  SelectNew  then mnuF ileOpenCli ck(mnuView Demo);
  5293         end;
  5294       2:begi n
  5295           if  (not User .IsReports Only) then  // Report s Only tab .
  5296              mnuFileEnc ounterClic k(Self);
  5297         end;
  5298       3:begi n
  5299           sl  := TSTrin gList.Crea te;
  5300           tr y
  5301              setDetailP rimaryCare (sl,Patien t.DFN);
  5302              ReportBox( sl, 'Prima ry Care',  True);
  5303           fi nally
  5304              sl.Free;
  5305           en d;
  5306         end;
  5307       4:begi n
  5308           if  Patient.P tIsMHV the n
  5309               ShellExecu te(laMHV.H andle, 'op en', PChar ('http://w ww.myhealt h. DNS     /'), '', ' ', SW_NORM AL);
  5310         end;
  5311       5:begi n
  5312          if  Patient.Pt IsVAA then
  5313            t ry
  5314               aReportTe xt := TStr ingList.Cr eate;
  5315               Patient.G etVAAInfor mation(aIn suranceSub scriberNam e, aReport Text);
  5316               ReportBox (aReportTe xt, aInsur anceSubscr iberName,  True);
  5317            f inally
  5318               FreeAndNi l(aReportT ext);
  5319            e nd;
  5320         end;
  5321       6:begi n
  5322           Sh owFlags;
  5323         end;
  5324       7:begi n
  5325           if  uUseVista Web = true  then
  5326              begin
  5327                lblCIRN. Alignment  := taCente r;
  5328                lstCIRNL ocations.V isible :=  false;
  5329                lstCIRNL ocations.S endToBack;
  5330                aAddress  := GetVis taWebAddre ss(Patient .DFN);
  5331                ShellExe cute(pnlCi rn.Handle,  'open', P Char(aAddr ess), PCha r(''), '',  SW_NORMAL );
  5332                pnlCIRN. BevelOuter  := bvRais ed;
  5333                Exit;
  5334              end;
  5335           if  not Remot eSites.Rem oteDataExi sts then E xit;
  5336           if  (not lstC IRNLocatio ns.Visible ) then
  5337              begin
  5338                pnlCIRN. BevelOuter  := bvLowe red;
  5339                lstCIRNL ocations.V isible :=  True;
  5340                lstCIRNL ocations.B ringToFron t;
  5341                lstCIRNL ocations.S etFocus;
  5342                pnlCIRN. Hint := 'C lick to cl ose list.' ;
  5343              end
  5344           el se
  5345              begin
  5346                pnlCIRN. BevelOuter  := bvRais ed;
  5347                lstCIRNL ocations.V isible :=  False;
  5348                lstCIRNL ocations.S endToBack;
  5349                pnlCIRN. Hint := 'C lick to di splay othe r faciliti es having  data for t his patien t.';
  5350              end;
  5351         end;
  5352       8:begi n
  5353           Vi ewReminder Tree;
  5354         end;
  5355       9:begi n { displa ys the win dow that s hows crisi s notes, w arnings, a llergies,  & advance  directives  }
  5356           Sh owCWAD;
  5357         end;
  5358     end;
  5359   end;
  5360  
  5361   procedure  TfrmFrame. mnuViewInf ormationCl ick(Sender : TObject) ;
  5362   begin
  5363     mnuViewD emo.Enable d := frmFr ame.pnlPat ient.Enabl ed;
  5364     mnuViewV isits.Enab led := frm Frame.pnlV isit.Enabl ed;
  5365     mnuViewP rimaryCare .Enabled : = frmFrame .pnlPrimar yCare.Enab led;
  5366     mnuViewM yHealtheVe t.Enabled  := not (Co py(frmFram e.laMHV.Hi nt, 1, 2)  = 'No');
  5367     mnuInsur ance.Enabl ed := not  (Copy(frmF rame.laVAA 2.Hint, 1,  2) = 'No' );
  5368     mnuViewF lags.Enabl ed := frmF rame.lblFl ag.Enabled ;
  5369     mnuViewR emoteData. Enabled :=  frmFrame. lblCirn.En abled;
  5370     mnuViewR eminders.E nabled :=  frmFrame.p nlReminder s.Enabled;
  5371     mnuViewP ostings.En abled := f rmFrame.pn lPostings. Enabled;
  5372   end;
  5373  
  5374   procedure  TfrmFrame. SetActiveT ab(PageID:  Integer);
  5375   begin
  5376     tabPage. TabIndex : = frmFrame .PageIDToT ab(PageID) ;
  5377     tabPageC hange(tabP age);
  5378   end;
  5379  
  5380   procedure  TfrmFrame. NextButton Click(Send er: TObjec t);
  5381   begin
  5382     if FProc cessingNex tClick the n Exit;
  5383     FProcces singNextCl ick := tru e;
  5384     popAlert s.AutoPopu p := TRUE;
  5385     mnuFileN ext.Enable d := True;
  5386     mnuFileN extClick(S elf);
  5387     FProcces singNextCl ick := fal se;
  5388   end;
  5389  
  5390   procedure  TfrmFrame. NextButton MouseDown( Sender: TO bject; But ton: TMous eButton;
  5391         Shif t: TShiftS tate; X, Y : Integer) ;
  5392   begin
  5393      popAler ts.AutoPop up := TRUE ;
  5394   end;
  5395  
  5396   procedure  TfrmFrame. SetUpNextB utton;
  5397    begin
  5398      if FNex tButton <>  nil then
  5399      begin
  5400         FNex tButton.fr ee;
  5401         FNex tButton :=  nil;
  5402      end;
  5403      FNextBu tton := TB itBtn.Crea te(self);
  5404      FNextBu tton.Paren t:= frmFra me;
  5405      FNextBu tton.Glyph  := FNextB uttonBitma p;
  5406      FNextBu tton.OnMou seDown :=  NextButton MouseDown;
  5407      FNextBu tton.OnCli ck := Next ButtonClic k;
  5408      FNextBu tton.Capti on := '&Ne xt';
  5409      FNextBu tton.Popup Menu := po pAlerts;
  5410      FNextBu tton.Top : = stsArea. Top;
  5411      FNextBu tton.Left  := FNextBu ttonL;
  5412      FNextBu tton.Heigh t := stsAr ea.Height;
  5413      FNextBu tton.Width  := stsAre a.Panels[2 ].Width;
  5414      FNextBu tton.TabSt op := True ;
  5415      FNextBu tton.TabOr der := 1;
  5416      FNextBu tton.show;
  5417   end;
  5418  
  5419   Procedure  TfrmFrame. GetExclude dFromMixed ();
  5420   var
  5421    VistaList : TStringL ist;
  5422    I: intege r;
  5423   begin
  5424    VistaList  := TStrin gList.Crea te;
  5425    try
  5426     GetUserL istParam(V istaList,  'OR EXCLUD E FROM MIX CASE');
  5427     if Vista List.Count  > 0 then
  5428     begin
  5429       Exclud eFromMixed .Clear;
  5430       for I  := 0 to Vi staList.Co unt - 1 do
  5431         Excl udeFromMix ed.Add(Mix edCase(Pie ce(VistaLi st[I], U,  2), True)) ;
  5432     end;
  5433    finally
  5434     VistaLis t.Free;
  5435    end;
  5436   end;
  5437  
  5438   // PaPI == ========== ========== ========== ========== ========== ========== ==========
  5439   procedure  TfrmFrame. UMEncUpd(v ar Message : TMessage );
  5440   begin
  5441     try
  5442       frmMed s.PaPI_GUI Setup(papi ParkingAva ilable(Enc ounter));
  5443     except
  5444       on E:  Exception  do
  5445         Show Message(E. Message);
  5446     end;
  5447   end;
  5448  
  5449   procedure  TfrmFrame. UMPAPI(var  Message:  TMessage);
  5450   begin
  5451     try
  5452       tabPag e.TabIndex  := Messag e.WParam;
  5453       tabPag eChange(ta bPage);
  5454     except
  5455       on E:  Exception  do
  5456         Show Message(E. Message);
  5457     end;
  5458   end;
  5459  
  5460   initializa tion
  5461     SpecifyF ormIsNotAD ialog(Tfrm Frame);
  5462  
  5463   finalizati on
  5464  
  5465  
  5466   end.