61. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 8/3/2017 2:38:25 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.

61.1 Files compared

# Location File Last Modified
1 V32.zip\V32\OR_30_405V28_SRC fFrame.pas Wed May 10 17:35:40 2017 UTC
2 V32.zip\V32\OR_30_405V28_SRC fFrame.pas Thu Aug 3 17:36:02 2017 UTC

61.2 Comparison summary

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

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

61.4 Active regular expressions

No regular expressions were active.

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

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