3. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 3/1/2017 4:26:04 PM Central Standard 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.

3.1 Files compared

# Location File Last Modified
1 v31A_T105_CIF.zip\OR_30_434V104_SRC\CPRS-chart fFrame.pas Mon Dec 19 18:51:44 2016 UTC
2 v31A_T105_CIF.zip\OR_30_434V104_SRC\CPRS-chart fFrame.pas Wed Mar 1 21:32:21 2017 UTC

3.2 Comparison summary

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

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

3.4 Active regular expressions

No regular expressions were active.

3.5 Comparison detail

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