68. EPMO Open Source Coordination Office Redaction File Detail Report

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

68.1 Files compared

#	Location	File	Last Modified
1	v31B.zip\v31B\377\OR_30_377V235_SRC	fFrame.pas	Wed May 17 14:56:08 2017 UTC
2	v31B.zip\v31B\377\OR_30_377V235_SRC	fFrame.pas	Thu Jul 13 14:42:50 2017 UTC

68.2 Comparison summary

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

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

68.4 Active regular expressions

No regular expressions were active.

68.5 Comparison detail

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