50. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 3/31/2017 10:45:44 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

50.1 Files compared

# Location File Last Modified
1 CPRS v31A.zip\CPRS v31A\YS_MHA_128_src.zip\OR_SRC_CREATION\CPRS-Chart fFrame.pas Mon Sep 19 18:58:14 2016 UTC
2 CPRS v31A.zip\CPRS v31A\YS_MHA_128_src.zip\OR_SRC_CREATION\CPRS-Chart fFrame.pas Fri Mar 31 15:03:01 2017 UTC

50.2 Comparison summary

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

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

50.4 Active regular expressions

No regular expressions were active.

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