Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/fFrame.pas@ 487

Last change on this file since 487 was 487, checked in by Kevin Toppenberg, 16 years ago
adding skin support (incomplete)
File size: 190.0 KB

Line
1	//kt -- Modified with SourceScanner on 7/17/2007
2	unit fFrame;
3	{ This is the main form for the CPRS GUI. It provides a patient-encounter-user framework
4	which all the other forms of the GUI use. }
5
6	{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
7	{$WARN SYMBOL_PLATFORM OFF}
8	{$DEFINE CCOWBROKER}
9
10	{.$define debug}
11
12	interface
13
14	uses
15	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Tabs, ComCtrls,
16	ExtCtrls, Menus, StdCtrls, Buttons, ORFn, fPage, uConst, ORCtrls, Trpcb,
17	OleCtrls, VERGENCECONTEXTORLib_TLB, ComObj, AppEvnts, inifiles,
18	//kt mod 6/29/07 -----
19	{$IFDEF USE_SKINS}
20	ipSkinManager,//kt 9/7/08
21	{$ENDIF}
22	fWebTab,
23	DKLang, TntForms, TntStdCtrls, TntSystem, TntSysUtils;
24	//kt end mod ---------
25
26	type
27	TfrmFrame = class(TForm)
28	pnlToolbar: TPanel;
29	stsArea: TStatusBar;
30	tabPage: TTabControl;
31	pnlPage: TPanel;
32	bvlPageTop: TBevel;
33	bvlToolTop: TBevel;
34	pnlPatient: TKeyClickPanel;
35	lblPtName: TStaticText;
36	lblPtSSN: TStaticText;
37	lblPtAge: TStaticText;
38	pnlVisit: TKeyClickPanel;
39	lblPtLocation: TStaticText;
40	lblPtProvider: TStaticText;
41	mnuFrame: TMainMenu;
42	mnuFile: TMenuItem;
43	mnuFileExit: TMenuItem;
44	mnuFileOpen: TMenuItem;
45	mnuFileReview: TMenuItem;
46	Z1: TMenuItem;
47	mnuFilePrint: TMenuItem;
48	mnuEdit: TMenuItem;
49	mnuEditUndo: TMenuItem;
50	Z3: TMenuItem;
51	mnuEditCut: TMenuItem;
52	mnuEditCopy: TMenuItem;
53	mnuEditPaste: TMenuItem;
54	Z4: TMenuItem;
55	mnuEditPref: TMenuItem;
56	Prefs1: TMenuItem;
57	mnu24pt1: TMenuItem;
58	mnu18pt1: TMenuItem;
59	mnu14pt1: TMenuItem;
60	mnu12pt1: TMenuItem;
61	mnu10pt1: TMenuItem;
62	mnu8pt: TMenuItem;
63	mnuHelp: TMenuItem;
64	mnuHelpContents: TMenuItem;
65	mnuHelpTutor: TMenuItem;
66	Z5: TMenuItem;
67	mnuHelpAbout: TMenuItem;
68	mnuTools: TMenuItem;
69	mnuView: TMenuItem;
70	mnuViewChart: TMenuItem;
71	mnuChartReports: TMenuItem;
72	mnuChartLabs: TMenuItem;
73	mnuChartDCSumm: TMenuItem;
74	mnuChartCslts: TMenuItem;
75	mnuChartNotes: TMenuItem;
76	mnuChartOrders: TMenuItem;
77	mnuChartMeds: TMenuItem;
78	mnuChartProbs: TMenuItem;
79	mnuChartCover: TMenuItem;
80	mnuHelpBroker: TMenuItem;
81	mnuFileEncounter: TMenuItem;
82	mnuViewDemo: TMenuItem;
83	mnuViewPostings: TMenuItem;
84	mnuHelpLists: TMenuItem;
85	Z6: TMenuItem;
86	mnuHelpSymbols: TMenuItem;
87	mnuFileNext: TMenuItem;
88	Z7: TMenuItem;
89	mnuFileRefresh: TMenuItem;
90	pnlPrimaryCare: TKeyClickPanel;
91	lblPtCare: TStaticText;
92	lblPtAttending: TStaticText;
93	pnlCIRN: TKeyClickPanel;
94	lblCIRN: TLabel;
95	lblCIRNData: TLabel;
96	pnlReminders: TKeyClickPanel;
97	imgReminder: TImage;
98	mnuViewReminders: TMenuItem;
99	anmtRemSearch: TAnimate;
100	lstCIRNLocations: TORListBox;
101	popCIRN: TPopupMenu;
102	popCIRNSelectAll: TMenuItem;
103	popCIRNSelectNone: TMenuItem;
104	popCIRNClose: TMenuItem;
105	mnuFilePrintSetup: TMenuItem;
106	LabInfo1: TMenuItem;
107	mnuFileNotifRemove: TMenuItem;
108	Z8: TMenuItem;
109	mnuToolsOptions: TMenuItem;
110	mnuChartSurgery: TMenuItem;
111	OROpenDlg: TOpenDialog;
112	mnuFileResumeContext: TMenuItem;
113	mnuFileResumeContextSet: TMenuItem;
114	Useexistingcontext1: TMenuItem;
115	mnuFileBreakContext: TMenuItem;
116	pnlCCOW: TPanel;
117	imgCCOW: TImage;
118	pnlPatientSelected: TPanel;
119	pnlNoPatientSelected: TPanel;
120	pnlFlag: TKeyClickPanel;
121	lblFlag: TLabel;
122	pnlPostings: TKeyClickPanel;
123	lblPtPostings: TStaticText;
124	lblPtCWAD: TStaticText;
125	mnuFilePrintSelectedItems: TMenuItem;
126	popAlerts: TPopupMenu;
127	mnuAlertContinue: TMenuItem;
128	mnuAlertForward: TMenuItem;
129	mnuAlertRenew: TMenuItem;
130	AppEvents: TApplicationEvents;
131	paVAA: TKeyClickPanel;
132	mnuToolsGraphing: TMenuItem;
133	laVAA2: TButton;
134	laMHV: TButton;
135	lblCIRNAvail: TLabel;
136	mnuViewInformation: TMenuItem;
137	mnuViewVisits: TMenuItem;
138	mnuViewPrimaryCare: TMenuItem;
139	mnuViewMyHealtheVet: TMenuItem;
140	mnuInsurance: TMenuItem;
141	mnuViewFlags: TMenuItem;
142	mnuViewRemoteData: TMenuItem;
143	DKLanguageController1: TDKLanguageController;
144	EditDemographics: TMenuItem;
145	procedure tabPageChange(Sender: TObject);
146	procedure FormCreate(Sender: TObject);
147	procedure CheckForTMGPatch;
148	procedure FormResize(Sender: TObject);
149	procedure pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
150	Shift: TShiftState; X, Y: Integer);
151	procedure pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
152	Shift: TShiftState; X, Y: Integer);
153	procedure pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
154	Shift: TShiftState; X, Y: Integer);
155	procedure pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
156	Shift: TShiftState; X, Y: Integer);
157	procedure mnuFileExitClick(Sender: TObject);
158	procedure pnlPostingsMouseDown(Sender: TObject; Button: TMouseButton;
159	Shift: TShiftState; X, Y: Integer);
160	procedure pnlPostingsMouseUp(Sender: TObject; Button: TMouseButton;
161	Shift: TShiftState; X, Y: Integer);
162	procedure mnuFontSizeClick(Sender: TObject);
163	procedure mnuChartTabClick(Sender: TObject);
164	procedure FormDestroy(Sender: TObject);
165	procedure mnuFileOpenClick(Sender: TObject);
166	procedure mnuHelpBrokerClick(Sender: TObject);
167	procedure mnuFileEncounterClick(Sender: TObject);
168	procedure mnuViewPostingsClick(Sender: TObject);
169	procedure mnuHelpAboutClick(Sender: TObject);
170	procedure mnuFileReviewClick(Sender: TObject);
171	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
172	procedure mnuHelpListsClick(Sender: TObject);
173	procedure ToolClick(Sender: TObject);
174	procedure mnuEditClick(Sender: TObject);
175	procedure mnuEditUndoClick(Sender: TObject);
176	procedure mnuEditCutClick(Sender: TObject);
177	procedure mnuEditCopyClick(Sender: TObject);
178	procedure mnuEditPasteClick(Sender: TObject);
179	procedure mnuHelpSymbolsClick(Sender: TObject);
180	procedure FormClose(Sender: TObject; var Action: TCloseAction);
181	procedure mnuFilePrintClick(Sender: TObject);
182	procedure mnuGECStatusClick(Sender: TObject);
183	procedure mnuFileNextClick(Sender: TObject);
184	procedure stsAreaMouseDown(Sender: TObject; Button: TMouseButton;
185	Shift: TShiftState; X, Y: Integer);
186	procedure stsAreaMouseUp(Sender: TObject; Button: TMouseButton;
187	Shift: TShiftState; X, Y: Integer);
188	procedure stsAreaDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
189	const Rect: TRect);
190	procedure pnlPrimaryCareMouseDown(Sender: TObject;
191	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
192	procedure pnlPrimaryCareMouseUp(Sender: TObject; Button: TMouseButton;
193	Shift: TShiftState; X, Y: Integer);
194	function FormHelp(Command: Word; Data: Integer;
195	var CallHelp: Boolean): Boolean;
196	procedure pnlRemindersMouseDown(Sender: TObject; Button: TMouseButton;
197	Shift: TShiftState; X, Y: Integer);
198	procedure pnlRemindersMouseUp(Sender: TObject; Button: TMouseButton;
199	Shift: TShiftState; X, Y: Integer);
200	procedure pnlCIRNClick(Sender: TObject);
201	procedure lstCIRNLocationsClick(Sender: TObject);
202	procedure popCIRNCloseClick(Sender: TObject);
203	procedure popCIRNSelectAllClick(Sender: TObject);
204	procedure popCIRNSelectNoneClick(Sender: TObject);
205	procedure mnuFilePrintSetupClick(Sender: TObject);
206	procedure lstCIRNLocationsChange(Sender: TObject);
207	procedure LabInfo1Click(Sender: TObject);
208	procedure mnuFileNotifRemoveClick(Sender: TObject);
209	procedure mnuToolsOptionsClick(Sender: TObject);
210	procedure mnuFileRefreshClick(Sender: TObject);
211	procedure FormKeyDown(Sender: TObject; var Key: Word;
212	Shift: TShiftState);
213	procedure FormActivate(Sender: TObject);
214	procedure pnlPrimaryCareEnter(Sender: TObject);
215	procedure pnlPrimaryCareExit(Sender: TObject);
216	procedure pnlPatientClick(Sender: TObject);
217	procedure pnlVisitClick(Sender: TObject);
218	procedure pnlPrimaryCareClick(Sender: TObject);
219	procedure pnlRemindersClick(Sender: TObject);
220	procedure pnlPostingsClick(Sender: TObject);
221	procedure ctxContextorCanceled(Sender: TObject);
222	procedure ctxContextorCommitted(Sender: TObject);
223	procedure ctxContextorPending(Sender: TObject;
224	const aContextItemCollection: IDispatch);
225	procedure mnuFileBreakContextClick(Sender: TObject);
226	procedure mnuFileResumeContextGetClick(Sender: TObject);
227	procedure mnuFileResumeContextSetClick(Sender: TObject);
228	procedure pnlFlagMouseDown(Sender: TObject; Button: TMouseButton;
229	Shift: TShiftState; X, Y: Integer);
230	procedure pnlFlagMouseUp(Sender: TObject; Button: TMouseButton;
231	Shift: TShiftState; X, Y: Integer);
232	procedure pnlFlagClick(Sender: TObject);
233	procedure mnuFilePrintSelectedItemsClick(Sender: TObject);
234	procedure mnuAlertRenewClick(Sender: TObject);
235	procedure mnuAlertForwardClick(Sender: TObject);
236	procedure pnlFlagEnter(Sender: TObject);
237	procedure pnlFlagExit(Sender: TObject);
238	procedure tabPageMouseUp(Sender: TObject; Button: TMouseButton;
239	Shift: TShiftState; X, Y: Integer);
240	procedure lstCIRNLocationsExit(Sender: TObject);
241	procedure AppEventsActivate(Sender: TObject);
242	procedure ScreenActiveFormChange(Sender: TObject);
243	procedure AppEventsShortCut(var Msg: TWMKey; var Handled: Boolean);
244	procedure mnuToolsClick(Sender: TObject);
245	procedure mnuToolsGraphingClick(Sender: TObject);
246	procedure pnlCIRNMouseDown(Sender: TObject; Button: TMouseButton;
247	Shift: TShiftState; X, Y: Integer);
248	procedure pnlCIRNMouseUp(Sender: TObject; Button: TMouseButton;
249	Shift: TShiftState; X, Y: Integer);
250	procedure laMHVClick(Sender: TObject);
251	procedure laVAA2Click(Sender: TObject);
252	procedure ViewInfo(Sender: TObject);
253	procedure mnuViewInformationClick(Sender: TObject);
254	procedure EditDemographicsClick(Sender: TObject);
255	procedure tabPageDrawTab(Control: TCustomTabControl; TabIndex: Integer;
256	const Rect: TRect; Active: Boolean);
257	private
258	//kt Begin Mod (change Consts to Vars) 7/17/2007
259	TX_ECSOPT : string;
260	TX_PTINQ : string;
261	TX_NOTIF_STOP : string;
262	TC_NOTIF_STOP : string;
263	TX_UNK_NOTIF : string;
264	TC_UNK_NOTIF : string;
265	TX_NO_SURG_NOTIF : string;
266	TC_NO_SURG_NOTIF : string;
267	TX_VER1 : string;
268	TX_VER2 : string;
269	TX_VER3 : string;
270	TX_VER_REQ : string;
271	TX_VER_OLD : string;
272	TX_VER_OLD2 : string;
273	TX_VER_NEW : string;
274	TC_VER : string;
275	TC_CLIERR : string;
276	TC_DGSR_ERR : string;
277	TC_DGSR_SHOW : string;
278	TC_DGSR_DENY : string;
279	TX_DGSR_YESNO : string;
280	TX_CCOW_LINKED : string;
281	TX_CCOW_CHANGING: string;
282	TX_CCOW_BROKEN : string;
283	TX_CCOW_ERROR : string;
284	TC_CCOW_ERROR : string;
285	//kt End Mod -------------------
286	FJustEnteredApp : boolean;
287	FCCOWInstalled: boolean;
288	FCCOWContextChanging: boolean;
289	FCCOWIconName: string;
290	FCCOWDrivedChange: boolean;
291	FCCOWBusy: boolean;
292	FCCOWError: boolean;
293	FNoPatientSelected: boolean;
294	FRefreshing: boolean;
295	FClosing: boolean;
296	FContextChanging: Boolean;
297	FChangeSource: Integer;
298	FCreateProgress: Integer;
299	FEditCtrl: TCustomEdit;
300	FLastPage: TfrmPage;
301	FNextButtonL: Integer;
302	FNextButtonR: Integer;
303	FNextButtonActive: Boolean;
304	FNextButtonBitmap: TBitmap;
305	FTerminate: Boolean;
306	FTabChanged: TNotifyEvent;
307	FOldActivate: TNotifyEvent;
308	FOldActiveFormChange: TNotifyEvent;
309	FECSAuthUser: Boolean;
310	FFixedStatusWidth: integer;
311	FPrevInPatient: Boolean;
312	FFirstLoad: Boolean;
313	FFlagList: TStringList;
314	FPrevPtID: string;
315	FVitalsDLLActive: boolean;
316	FGraphFloatActive: boolean;
317	FGraphContext: string;
318	procedure RefreshFixedStatusWidth;
319	procedure FocusApplicationTopForm;
320	procedure AppActivated(Sender: TObject);
321	procedure AppDeActivated(Sender: TObject);
322	procedure AppException(Sender: TObject; E: Exception);
323	function AllowContextChangeAll(var Reason: string): Boolean;
324	procedure ClearPatient;
325	procedure ChangeFont(NewFontSize: Integer);
326	procedure LoadTabColors(INIFile : TIniFile; ColorsList : TStringList); //kt added 8/8/08
327	procedure SaveTabColors(INIFile : TIniFile; ColorsList : TStringList);
328	//procedure CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
329	procedure CreateTab(ATabID: integer; ALabel: string);
330	procedure DetermineNextTab;
331	function ExpandCommand(x: string): string;
332	procedure FitToolbar;
333	procedure LoadSizesForUser;
334	procedure SaveSizesForUser;
335	procedure LoadUserPreferences;
336	procedure SaveUserPreferences;
337	procedure SwitchToPage(NewForm: TfrmPage);
338	function TabToPageID(Tab: Integer): Integer;
339	function TimeoutCondition: boolean;
340	function GetTimedOut: boolean;
341	procedure TimeOutAction;
342	procedure SetUserTools;
343	procedure SetDebugMenu;
344	procedure SetupPatient(AFlaggedList : TStringList = nil);
345	//procedure SetUpCIRN;
346	procedure RemindersChanged(Sender: TObject);
347	procedure ReportsOnlyDisplay;
348	procedure UMInitiate(var Message: TMessage); message UM_INITIATE;
349	procedure UMNewOrder(var Message: TMessage); message UM_NEWORDER;
350	procedure UMStatusText(var Message: TMessage); message UM_STATUSTEXT;
351	procedure UMShowPage(var Message: TMessage); message UM_SHOWPAGE;
352	procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
353	procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
354	procedure UpdateECSParameter(var CmdParameter: string);
355	function ValidECSUser: boolean;
356	procedure StartCCOWContextor;
357	function AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean;
358	procedure UpdateCCOWContext;
359	procedure CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
360	procedure CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
361	{$IFDEF CCOWBROKER}
362	procedure CheckForDifferentUser(aContextItemCollection: IDispatch; var UserChanged: boolean);
363	{$ENDIF}
364	procedure HideEverything;
365	procedure ShowEverything;
366	//function FindBestCCOWDFN(var APatientName: string): string;
367	function FindBestCCOWDFN: string;
368	procedure HandleCCOWError(AMessage: string);
369	procedure SetupVars;
370	procedure DrawTab(Control: TCustomTabControl; TabIndex: Integer;
371	const Rect: TRect; Color : TColor; Active: Boolean); //kt added 8/8/08
372	public
373	EnduringPtSelSplitterPos: integer;
374	SkinAtStartup : boolean; //kt 9/8/08
375	CurrentSkinFile : string; //kt 9/8/08
376	{$IFDEF USE_SKINS}
377	SkinManager : TipSkinManager;
378	{$ENDIF}
379	procedure ActivateCurrentSkin; //kt 9/8/08
380	procedure InactivateSkin; //kt 9/8/08
381	procedure SetBADxList;
382	function PageIDToTab(PageID: Integer): Integer;
383	procedure ShowHideChartTabMenus(AMenuItem: TMenuItem);
384	procedure UpdatePtInfoOnRefresh;
385	function TabExists(ATabID: integer): boolean;
386	procedure DisplayEncounterText;
387	property ChangeSource: Integer read FChangeSource;
388	property CCOWContextChanging: Boolean read FCCOWContextChanging;
389	property CCOWDrivedChange: Boolean read FCCOWDrivedChange;
390	property CCOWBusy: Boolean read FCCOWBusy write FCCOWBusy;
391	property ContextChanging: Boolean read FContextChanging;
392	property TimedOut: Boolean read GetTimedOut;
393	property Closing: Boolean read FClosing;
394	property OnTabChanged: TNotifyEvent read FTabChanged write FTabChanged;
395	property VitalsDLLActive: boolean read FVitalsDLLActive write FVitalsDLLActive;
396	property GraphFloatActive: boolean read FGraphFloatActive write FGraphFloatActive;
397	property GraphContext: string read FGraphContext write FGraphContext;
398	procedure ToggleMenuItemChecked(Sender: TObject);
399	procedure SetUpCIRN;
400	procedure RenameTabs; //kt added
401	procedure RenameATab(ATabID: integer; ALabel: string); //kt added
402	procedure SetATabVisibility(ATabID: integer; Visible: boolean; ALabel:string='x'); //kt added
403	procedure SetWebTabsPerServer; //kt added
404	procedure SetOneWebTabPerServer(WebTabNum: integer; URLMsg : string); //kt added
405	end;
406
407	var
408	frmFrame: TfrmFrame;
409	uTabList: TStringList;
410	uTabColorsList : TStringList; //kt added 8/8/08
411	uRemoteType : string;
412	FlaggedPTList: TStringList;
413	ctxContextor : TContextorControl;
414	NextTab, LastTab: Integer;
415	uToolsMaxed, uToolsWarned: boolean;
416	boolTMGPatchInstalled: boolean; //elh 6/20/08
417
418	const
419	PASSCODE = '_gghwn7pghCrOJvOV61PtPvgdeEU2u5cRsGvpkVDjKT_H7SdKE_hqFYWsUIVT1H7JwT6Yz8oCtd2u2PALqWxibNXx3Yo8GPcTYsNaxW' +
420	'ZFo8OgT11D5TIvpu3cDQuZd3Yh_nV9jhkvb0ZBGdO9n-uNXPPEK7xfYWCI2Wp3Dsu9YDSd_EM34nvrgy64cqu9_jFJKJnGiXY96Lf1ecLiv4LT9qtmJ-BawYt7O9JZGAswi344BmmCbNxfgvgf0gfGZea';
421
422	function TX_IN_USE : string; //kt replaced local constant with global scope function
423
424	implementation
425
426	{$R *.DFM}
427	{$R sBitmaps}
428	{$R sRemSrch}
429
430	uses
431	ORNet, rCore, fPtSelMsg, fPtSel, fCover, fProbs, fMeds, fOrders, rOrders, fNotes, fConsults, fDCSumm,
432	rMisc, Clipbrd, fLabs, fReports, rReports, fPtDemo, fEncnt, fPtCWAD, uCore, fAbout, fReview, fxBroker,
433	fxLists, fxServer, ORSystem, fRptBox, fSplash, rODAllergy, uInit, fLabTests, fLabInfo,
434	uReminders, fReminderTree, ORClasses, fDeviceSelect, fDrawers, fReminderDialog, ShellAPI, rVitals,
435	fOptions, fGraphs, rTemplates, fSurgery, rSurgery, uEventHooks, uSignItems, fDefaultEvent,rECS,
436	fIconLegend, uOrders, fPtSelOptns, DateUtils, uSpell, uOrPtf, fPatientFlagMulti,
437	fAlertForward, UBAGlobals, fBAOptionsDiagnoses, UBACore, fOrdersSign, uVitals, fOrdersRenew, uFormMonitor,
438	fImages //kt 8/19/05
439	{$IFDEF CCOWBROKER}
440	, CCOW_const
441	{$ENDIF}
442	, fPtDemoEdit
443	, fOptionsOther;
444
445	var // RV 05/11/04
446	IsRunExecuted: Boolean = FALSE; // RV 05/11/04
447	GraphFloat: TfrmGraphs;
448	tempFrmWebTab : TfrmWebTab; //kt added
449	const
450	// moved to uConst - RV v16
451	(* CT_NOPAGE = -1; // chart tab - none selected
452	CT_UNKNOWN = 0; // chart tab - unknown (shouldn't happen)
453	CT_COVER = 1; // chart tab - cover sheet
454	CT_PROBLEMS = 2; // chart tab - problem list
455	CT_MEDS = 3; // chart tab - medications screen
456	CT_ORDERS = 4; // chart tab - doctor's orders
457	CT_HP = 5; // chart tab - history & physical
458	CT_NOTES = 6; // chart tab - progress notes
459	CT_CONSULTS = 7; // chart tab - consults
460	CT_DCSUMM = 8; // chart tab - discharge summaries
461	CT_LABS = 9; // chart tab - laboratory results
462	CT_REPORTS = 10; // chart tab - reports
463	CT_SURGERY = 11; // chart tab - surgery*)
464
465	FCP_UPDATE = 10; // form create about to check auto-update
466	FCP_SETHOOK = 20; // form create about to set timeout hooks
467	FCP_SERVER = 30; // form create about to connect to server
468	FCP_CHKVER = 40; // form create about to check version
469	FCP_OBJECTS = 50; // form create about to create core objects
470	FCP_FORMS = 60; // form create about to create child forms
471	FCP_PTSEL = 70; // form create about to select patient
472	FCP_FINISH = 99; // form create finished successfully
473
474	SHOW_NOTIFICATIONS = True;
475
476	//kt 7-17-07 Begin mod. Constanst removed and converted to variables.
477	//TX_IN_USE = 'VistA CPRS in use by: ';
478	TX_OPTION = 'OR CPRS GUI CHART';
479	TX_ECSOPT = 'EC GUI CONTEXT';
480	//TX_PTINQ = 'Retrieving demographic information...';
481	//TX_NOTIF_STOP = 'Stop processing notifications?';
482	//TC_NOTIF_STOP = 'Currently Processing Notifications';
483	//TX_UNK_NOTIF = 'Unable to process the follow up action for this notification';
484	//TC_UNK_NOTIF = 'Follow Up Action Not Implemented';
485	//TX_NO_SURG_NOTIF = 'This notification must be processed using the Surgery tab, ' + CRLF +
486	// 'which is not currently available to you.';
487	//TC_NO_SURG_NOTIF = 'Surgery Tab Not Available';
488	//TX_VER1 = 'This is version ';
489	//TX_VER2 = ' of CPRSChart.exe.';
490	//TX_VER3 = CRLF + 'The running server version is ';
491	//TX_VER_REQ = ' version server is required.';
492	//TX_VER_OLD = CRLF + 'It is strongly recommended that you upgrade.';
493	//TX_VER_OLD2 = CRLF + 'The program cannot be run until the client is upgraded.';
494	//TX_VER_NEW = CRLF + 'The program cannot be run until the server is upgraded.';
495	//TC_VER = 'Server/Client Incompatibility';
496	//TC_CLIERR = 'Client Specifications Mismatch';
497
498	//TC_DGSR_ERR = 'Remote Data Error';
499	//TC_DGSR_SHOW = 'Restricted Remote Record';
500	//TC_DGSR_DENY = 'Remote Access Denied';
501	//TX_DGSR_YESNO = CRLF + 'Do you want to continue accessing this remote patient record?';
502
503	//TX_CCOW_LINKED = 'Clinical Link On';
504	//TX_CCOW_CHANGING = 'Clinical link changing';
505	//TX_CCOW_BROKEN = 'Clinical link broken';
506	//TX_CCOW_ERROR = 'CPRS was unable to communicate with the CCOW Context Vault' + CRLF +
507	// 'CCOW patient synchronization will be unavailable for the remainder of this session.';
508	//TC_CCOW_ERROR = 'CCOW Error';
509	//kt 7-17-07 end mod ---------------
510
511	function TX_IN_USE : string;
512	begin Result := DKLangConstW('fFrame_VistA_CPRS_in_use_byx'); //kt added 7/17/2007
513	end;
514
515	procedure TfrmFrame.SetupVars;
516	//kt Added entire function to replace constant declarations 7/17/2007
517	begin
518	TX_PTINQ := DKLangConstW('fFrame_Retrieving_demographic_informationxxx'); //kt added 7/17/2007
519	TX_NOTIF_STOP := DKLangConstW('fFrame_Stop_processing_notificationsx'); //kt added 7/17/2007
520	TC_NOTIF_STOP := DKLangConstW('fFrame_Currently_Processing_Notifications'); //kt added 7/17/2007
521	TX_UNK_NOTIF := DKLangConstW('fFrame_Unable_to_process_the_follow_up_action_for_this_notification'); //kt added 7/17/2007
522	TC_UNK_NOTIF := DKLangConstW('fFrame_Follow_Up_Action_Not_Implemented'); //kt added 7/17/2007
523	TX_NO_SURG_NOTIF := DKLangConstW('fFrame_This_notification_must_be_processed_using_the_Surgery_tabx') + CRLF +
524	DKLangConstW('fFrame_which_is_not_currently_available_to_youx'); //kt added 7/17/2007
525	TC_NO_SURG_NOTIF := DKLangConstW('fFrame_Surgery_Tab_Not_Available'); //kt added 7/17/2007
526	TX_VER1 := DKLangConstW('fFrame_This_is_version'); //kt added 7/17/2007
527	TX_VER2 := DKLangConstW('fFrame_of_CPRSChartxexex'); //kt added 7/17/2007
528	TX_VER3 := CRLF + DKLangConstW('fFrame_The_running_server_version_is'); //kt added 7/17/2007
529	TX_VER_REQ := DKLangConstW('fFrame_version_server_is_requiredx'); //kt added 7/17/2007
530	TX_VER_OLD := CRLF + DKLangConstW('fFrame_It_is_strongly_recommended_that_you_upgradex'); //kt added 7/17/2007
531	TX_VER_OLD2 := CRLF + DKLangConstW('fFrame_The_program_cannot_be_run_until_the_client_is_upgradedx'); //kt added 7/17/2007
532	TX_VER_NEW := CRLF + DKLangConstW('fFrame_The_program_cannot_be_run_until_the_server_is_upgradedx'); //kt added 7/17/2007
533	TC_VER := DKLangConstW('fFrame_ServerxClient_Incompatibility'); //kt added 7/17/2007
534	TC_CLIERR := DKLangConstW('fFrame_Client_Specifications_Mismatch'); //kt added 7/17/2007
535	TC_DGSR_ERR := DKLangConstW('fFrame_Remote_Data_Error'); //kt added 7/17/2007
536	TC_DGSR_SHOW := DKLangConstW('fFrame_Restricted_Remote_Record'); //kt added 7/17/2007
537	TC_DGSR_DENY := DKLangConstW('fFrame_Remote_Access_Denied'); //kt added 7/17/2007
538	TX_DGSR_YESNO := CRLF + DKLangConstW('fFrame_Do_you_want_to_continue_accessing_this_remote_patient_recordx'); //kt added 7/17/2007
539
540	TX_CCOW_LINKED := DKLangConstW('fFrame_Clinical_Link_On'); //kt added 7/17/2007
541	TX_CCOW_CHANGING := DKLangConstW('fFrame_Clinical_link_changing'); //kt added 7/17/2007
542	TX_CCOW_BROKEN := DKLangConstW('fFrame_Clinical_link_broken'); //kt added 7/17/2007
543	TX_CCOW_ERROR := DKLangConstW('fFrame_CPRS_was_unable_to_communicate_with_the_CCOW_Context_Vault') + CRLF +
544	DKLangConstW('fFrame_CCOW_patient_synchronization_will_be_unavailable_for_the_remainder_of_this_sessionx'); //kt added 7/17/2007
545	TC_CCOW_ERROR := DKLangConstW('fFrame_CCOW_Error'); //kt added 7/17/2007
546	end;
547
548
549
550	function TfrmFrame.TimeoutCondition: boolean;
551	begin
552	Result := (FCreateProgress < FCP_PTSEL);
553	end;
554
555	function TfrmFrame.GetTimedOut: boolean;
556	begin
557	Result := uInit.TimedOut;
558	end;
559
560	procedure TfrmFrame.TimeOutAction;
561	begin
562	if frmFrame.VitalsDLLActive then
563	CloseVitalsDLL()
564	else
565	Close;
566	end;
567
568	{ General Functions and Procedures }
569
570	procedure TfrmFrame.AppException(Sender: TObject; E: Exception);
571	var
572	AnAddr: Pointer;
573	ErrMsg: string;
574	begin
575	Application.NormalizeTopMosts;
576	if (E is EIntError) then
577	begin
578	ErrMsg := E.Message + CRLF +
579	// 'CreateProgress: ' + IntToStr(FCreateProgress) + CRLF + <-- original line. //kt 7/17/2007
580	DKLangConstW('fFrame_CreateProgressx') + IntToStr(FCreateProgress) + CRLF + //kt added 7/17/2007
581	// 'RPC Info: ' + RPCLastCall; <-- original line. //kt 7/17/2007
582	DKLangConstW('fFrame_RPC_Infox') + RPCLastCall; //kt added 7/17/2007
583	if EExternal(E).ExceptionRecord <> nil then
584	begin
585	AnAddr := EExternal(E).ExceptionRecord^.ExceptionAddress;
586	// ErrMsg := ErrMsg + CRLF + 'Address was ' + IntToStr(Integer(AnAddr)); <-- original line. //kt 7/17/2007
587	ErrMsg := ErrMsg + CRLF + DKLangConstW('fFrame_Address_was') + IntToStr(Integer(AnAddr)); //kt added 7/17/2007
588	end;
589	ShowMessage(ErrMsg);
590	end
591	else if (E is EBrokerError) then
592	begin
593	Application.ShowException(E);
594	FCreateProgress := FCP_FORMS;
595	Close;
596	end
597	else if (E is EOleException) then
598	begin
599	Application.ShowException(E);
600	FCreateProgress := FCP_FORMS;
601	Close;
602	end
603	else Application.ShowException(E);
604	Application.RestoreTopMosts;
605	end;
606
607	function TfrmFrame.AllowContextChangeAll(var Reason: string): Boolean;
608	var
609	Silent: Boolean;
610	begin
611	if pnlNoPatientSelected.Visible then
612	begin
613	Result := True;
614	exit;
615	end;
616	FContextChanging := True;
617	Result := True;
618	if COMObjectActive or SpellCheckInProgress or VitalsDLLActive then
619	begin
620	Reason := 'COM_OBJECT_ACTIVE';
621	Result:= False;
622	end;
623	if Result then Result := frmCover.AllowContextChange(Reason);
624	if Result then Result := frmProblems.AllowContextChange(Reason);
625	if Result then Result := frmMeds.AllowContextChange(Reason);
626	if Result then Result := frmOrders.AllowContextChange(Reason);
627	if Result then Result := frmNotes.AllowContextChange(Reason);
628	if Result then Result := frmConsults.AllowContextChange(Reason);
629	if Result then Result := frmDCSumm.AllowContextChange(Reason);
630	if Result then
631	if Assigned(frmSurgery) then Result := frmSurgery.AllowContextChange(Reason);;
632	if Result then Result := frmLabs.AllowContextChange(Reason);;
633	if Result then Result := frmReports.AllowContextChange(Reason);
634	if (not User.IsReportsOnly) then
635	if Result and Changes.RequireReview then //Result := ReviewChanges(TimedOut);
636	case BOOLCHAR[FCCOWContextChanging] of
637	'1': begin
638	if Changes.RequireReview then
639	begin
640	// Reason := 'Items will be left unsigned.'; <-- original line. //kt 7/17/2007
641	Reason := DKLangConstW('fFrame_Items_will_be_left_unsignedx'); //kt added 7/17/2007
642	Result := False;
643	end
644	else
645	Result := True;
646	end;
647	'0': begin
648	Silent := (TimedOut) or (Reason = 'COMMIT');
649	Result := ReviewChanges(Silent);
650	end;
651	end;
652	FContextChanging := False;
653	end;
654
655	procedure TfrmFrame.ClearPatient;
656	{ call all pages to make sure patient related information is cleared (when switching patients) }
657	begin
658	if frmFrame.Timedout then Exit; // added to correct Access Violation when "Refresh Patient Information" selected
659	lblPtName.Caption := '';
660	lblPtSSN.Caption := '';
661	lblPtAge.Caption := '';
662	pnlPatient.Caption := '';
663	lblPtCWAD.Caption := '';
664	//lblPtLocation.Caption := 'Visit Not Selected'; <-- original line. //kt 7/17/2007
665	lblPtLocation.Caption := DKLangConstW('fFrame_Visit_Not_Selected'); //kt added 7/17/2007
666	//lblPtProvider.Caption := 'Current Provider Not Selected'; <-- original line. //kt 7/17/2007
667	lblPtProvider.Caption := DKLangConstW('fFrame_Current_Provider_Not_Selected'); //kt added 7/17/2007
668	pnlVisit.Caption := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
669	//lblPtCare.Caption := 'Primary Care Team Unassigned'; <-- original line. //kt 7/17/2007
670	lblPtCare.Caption := DKLangConstW('fFrame_Primary_Care_Team_Unassigned'); //kt added 7/17/2007
671	lblPtAttending.Caption := '';
672	pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption;
673	frmCover.ClearPtData;
674	frmProblems.ClearPtData;
675	frmMeds.ClearPtData;
676	frmOrders.ClearPtData;
677	frmNotes.ClearPtData;
678	frmConsults.ClearPtData;
679	frmDCSumm.ClearPtData;
680	if Assigned(frmSurgery) then frmSurgery.ClearPtData;
681	frmLabs.ClearPtData;
682	frmReports.ClearPtData;
683	tabPage.TabIndex := PageIDToTab(CT_NOPAGE); // to make sure DisplayPage gets called
684	tabPageChange(tabPage);
685	ClearReminderData;
686	SigItems.Clear;
687	lstCIRNLocations.Clear;
688	uRemoteType := '';
689	ClearFlag;
690	if Assigned(FlagList) then FlagList.Clear;
691	HasFlag := False;
692	HidePatientSelectMessages;
693	if (GraphFloat <> nil) and GraphFloatActive then
694	with GraphFloat do
695	begin
696	Initialize;
697	DisplayData('top');
698	DisplayData('bottom');
699	lstCheck.Items.Clear;
700	// Caption := 'CPRS Graphing - Patient: ' + MixedCase(Patient.Name); <-- original line. //kt 7/17/2007
701	Caption := DKLangConstW('fFrame_CPRS_Graphing_x_Patientx') + MixedCase(Patient.Name); //kt added 7/17/2007
702	end;
703	end;
704
705	procedure TfrmFrame.DisplayEncounterText;
706	{ updates the display in the header bar of encounter related information (location & provider) }
707	begin
708	with Encounter do
709	begin
710	if Length(LocationText) > 0
711	then lblPtLocation.Caption := LocationText
712	// else lblPtLocation.Caption := 'Visit Not Selected'; <-- original line. //kt 7/17/2007
713	else lblPtLocation.Caption := DKLangConstW('fFrame_Visit_Not_Selected'); //kt added 7/17/2007
714	if Length(ProviderName) > 0
715	// then lblPtProvider.Caption := 'Provider: ' + ProviderName <-- original line. //kt 7/17/2007
716	then lblPtProvider.Caption := DKLangConstW('fFrame_Providerx') + ProviderName //kt added 7/17/2007
717	// else lblPtProvider.Caption := 'Current Provider Not Selected'; <-- original line. //kt 7/17/2007
718	else lblPtProvider.Caption := DKLangConstW('fFrame_Current_Provider_Not_Selected'); //kt added 7/17/2007
719	end;
720	pnlVisit.Caption := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
721	FitToolBar;
722	end;
723
724	{ Form Events (Create, Destroy) ----------------------------------------------------------- }
725
726	procedure TfrmFrame.RefreshFixedStatusWidth;
727	begin
728	with stsArea do
729	FFixedStatusWidth := Panels[0].Width + Panels[2].Width + Panels[3].Width + Panels[4].Width;
730	end;
731
732	procedure TfrmFrame.FormCreate(Sender: TObject);
733	{ connect to server, create tab pages, select a patient, & initialize core objects }
734	var
735	ClientVer, ServerVer, ServerReq: string;
736	tempS : string; //kt
737	i : integer; //kt added 6/29/07
738	CPRSChartINI: TINIFile; //elh 6/23/08
739	tempPosition : TTabPosition; //kt
740	begin
741	//kt 6/29/07 Begin modification -------------------
742	SetupVars;
743	// Scan for language files in the app directory and register them in the LangManager object
744	LangManager.ScanForLangFiles(WideExtractFileDir(WideParamStr(0)), '*.lng', False);
745	//later, allow setting language from command line parameter
746	//kt end modification ------------------------------
747
748	FJustEnteredApp := false;
749	SizeHolder := TSizeHolder.Create;
750	FOldActiveFormChange := Screen.OnActiveFormChange;
751	Screen.OnActiveFormChange := ScreenActiveFormChange;
752	if not (ParamSearch('CCOW')='DISABLE') then
753	try
754	StartCCOWContextor;
755	except
756	IsRunExecuted := False;
757	FCCOWInstalled := False;
758	pnlCCOW.Visible := False;
759	mnuFileResumeContext.Visible := False;
760	mnuFileBreakContext.Visible := False;
761	end
762	else
763	begin
764	IsRunExecuted := False;
765	FCCOWInstalled := False;
766	pnlCCOW.Visible := False;
767	mnuFileResumeContext.Visible := False;
768	mnuFileBreakContext.Visible := False;
769	end;
770	RefreshFixedStatusWidth;
771	FTerminate := False;
772	AutoUpdateCheck;
773
774	FFlagList := TStringList.Create;
775
776	// setup initial timeout here so can timeout logon
777	FCreateProgress := FCP_SETHOOK;
778	InitTimeOut(TimeoutCondition, TimeOutAction);
779
780	// connect to the server and create an option context
781	FCreateProgress := FCP_SERVER;
782
783	{$IFDEF CCOWBROKER}
784	EnsureBroker;
785	if ctxContextor <> nil then
786	begin
787	if ParamSearch('CCOW') = 'PATIENTONLY' then
788	RPCBrokerV.Contextor := nil
789	else
790	RPCBrokerV.Contextor := ctxContextor;
791	end
792	else
793	RPCBrokerV.Contextor := nil;
794	{$ENDIF}
795
796	if not ConnectToServer(TX_OPTION) then
797	begin
798	if Assigned(RPCBrokerV) then
799	// InfoBox(RPCBrokerV.RPCBError, 'Error', MB_OK or MB_ICONERROR); <-- original line. //kt 7/17/2007
800	InfoBox(RPCBrokerV.RPCBError, DKLangConstW('fFrame_Error'), MB_OK or MB_ICONERROR); //kt added 7/17/2007
801	Close;
802	Exit;
803	end;
804
805	if ctxContextor <> nil then
806	begin
807	if not (ParamSearch('CCOW') = 'PATIENTONLY') then
808	ctxContextor.NotificationFilter := ctxContextor.NotificationFilter + ';User';
809	end;
810
811	FECSAuthUser := ValidECSUser;
812	uECSReport := TECSReport.Create;
813	uECSReport.ECSPermit := FECSAuthUser;
814	RPCBrokerV.CreateContext(TX_OPTION);
815	Application.OnException := AppException;
816	FOldActivate := Application.OnActivate;
817	Application.OnActivate := AppActivated;
818	Application.OnDeActivate := AppDeActivated;
819
820	// load language ini settings //elh added
821	CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini'); // Read from INI elh 6/23/08
822	LangManager.LanguageID := CPRSChartINI.ReadInteger('Options','Language',1033);
823	tempPosition := TTabPosition(CPRSChartINI.ReadInteger('TAB_POSITION','Tab Location',0));
824	if tempPosition > tpRight then tempPosition := tpBottom;
825	fOptionsOther.SetTabPosition(tempPosition);
826	{$IFDEF USE_SKINS}
827	SkinManager := TipSkinManager.Create(self);
828	{$ENDIF}
829	SkinAtStartup := CPRSChartINI.ReadBool('Skin','Load At Startup',false);
830	CurrentSkinFile := CPRSChartINI.ReadString('Skin','Default Skin','TMG_Extra\Skins\ICQ_Longhorn_v.1.2.ipz');
831	if SkinAtStartup then ActivateCurrentSkin;
832	//kt -- end mod --
833
834	//frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')'; //kt added
835	//frmFrame.RenameTabs; //Resets names of tabs to correct translation //kt
836
837	// create initial core objects
838	FCreateProgress := FCP_OBJECTS;
839	User := TUser.Create;
840
841	// make sure we're using the matching server version
842	FCreateProgress := FCP_CHKVER;
843	ClientVer := ClientVersion(Application.ExeName); //kt Added: allows 'SPOOF-VER=x.x.x.x' command-line parameter
844	ServerVer := ServerVersion(TX_OPTION, ClientVer);
845	if (ServerVer = '0.0.0.0') then
846	begin
847	// InfoBox('Unable to determine current version of server.', TX_OPTION, MB_OK); <-- original line. //kt 7/17/2007
848	InfoBox(DKLangConstW('fFrame_Unable_to_determine_current_version_of_serverx'), TX_OPTION, MB_OK); //kt added 7/17/2007
849	Close;
850	Exit;
851	end;
852	ServerReq := Piece(FileVersionValue(Application.ExeName, FILE_VER_INTERNALNAME), ' ', 1);
853	tempS := Trim(ParamSearch('SPOOF-VER')); //kt added
854	if tempS <>'' then ServerReq := tempS; //kt added
855	if (ClientVer <> ServerReq) then
856	begin
857	// InfoBox('Client "version" does not match client "required" server.', TC_CLIERR, MB_OK); <-- original line. //kt 7/17/2007
858	InfoBox(DKLangConstW('fFrame_Client_xversionx_does_not_match_client_xrequiredx_serverx')+#10+#13+
859	#10+#13+
860	' ' + DKLangConstW('fFrame_Server')+' = ''' + ServerVer + '''' + #10+#13+
861	' ' + DKLangConstW('fFrame_ThisCPRS')+' = ''' + ClientVer + '''' + #10+#13+
862	#10+#13+
863	DKLangConstW('fFrame_Aborting')
864	, TC_CLIERR, MB_OK); //kt added 7/17/2007, expanded 5/25/08
865	Close;
866	Exit;
867	end;
868	if (CompareVersion(ServerVer, ServerReq) <> 0) then
869	begin
870	if (sCallV('ORWU DEFAULT DIVISION', [nil]) = '1') then
871	begin
872	// if (InfoBox('Proceed with mismatched Client and Server versions?', TC_CLIERR, MB_YESNO) = ID_NO) then <-- original line. //kt 7/17/2007
873	if (InfoBox(DKLangConstW('fFrame_Proceed_with_mismatched_Client_and_Server_versionsx'), TC_CLIERR, MB_YESNO) = ID_NO) then //kt added 7/17/2007
874	begin
875	Close;
876	Exit;
877	end;
878	end
879	else
880	begin
881	if (CompareVersion(ServerVer, ServerReq) > 0) then // Server newer than Required
882	begin
883	// NEXT LINE COMMENTED OUT - CHANGED FOR VERSION 19.16, PATCH OR3155:
884	// if GetUserParam('ORWOR REQUIRE CURRENT CLIENT') = '1' then
885	if (true) then // "True" statement guarantees "required" current version client.
886	begin
887	InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD2, TC_VER, MB_OK);
888	Close;
889	Exit;
890	end;
891	end
892	else InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD, TC_VER, MB_OK);
893	end;
894	if (CompareVersion(ServerVer, ServerReq) < 0) then // Server older then Required
895	begin
896	InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_NEW, TC_VER, MB_OK);
897	Close;
898	Exit;
899	end;
900	end;
901
902	// Add future tabs here as they are created/implemented:
903	if (
904	(not User.HasCorTabs) and
905	(not User.HasRptTab)
906	)
907	then
908	begin
909	// InfoBox('No valid tabs assigned', 'Tab Access Problem', MB_OK); <-- original line. //kt 7/17/2007
910	InfoBox(DKLangConstW('fFrame_No_valid_tabs_assigned'), DKLangConstW('fFrame_Tab_Access_Problem'), MB_OK); //kt added 7/17/2007
911	Close;
912	Exit;
913	end;
914
915	CheckForTMGPatch; //Check For TMG Patch elh 6/20/08
916
917	// create creating core objects
918	Patient := TPatient.Create;
919	Encounter := TEncounter.Create;
920	Changes := TChanges.Create;
921	Notifications := TNotifications.Create;
922	RemoteSites := TRemoteSiteList.Create;
923	RemoteReports := TRemoteReportList.Create;
924	uTabList := TStringList.Create;
925	uTabColorsList := TStringList.Create; //kt added 8/8/08
926	FlaggedPTList := TStringList.Create;
927	HasFlag := False;
928	FlagList := TStringList.Create;
929	// set up structures specific to the user
930	Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')';
931	SetDebugMenu;
932	if InteractiveRemindersActive then
933	NotifyWhenRemindersChange(RemindersChanged);
934	// load all the tab pages
935	FCreateProgress := FCP_FORMS;
936	//CreateTab(TObject(frmProblems), TfrmProblems, CT_PROBLEMS, 'Problems');
937	CreateTab(CT_PROBLEMS, DKLangConstW('fFrame_Problems')); //kt
938	//kt original line --> CreateTab(CT_PROBLEMS, 'Problems');
939	CreateTab(CT_MEDS, DKLangConstW('fFrame_Meds')); //kt
940	//kt original line --> CreateTab(CT_MEDS, 'Meds');
941	CreateTab(CT_ORDERS, DKLangConstW('fFrame_Orders')); //kt
942	//kt original line --> CreateTab(CT_ORDERS, 'Orders');
943	CreateTab(CT_NOTES, DKLangConstW('fFrame_Notes')); //kt
944	//kt original line --> CreateTab(CT_NOTES, 'Notes');
945	CreateTab(CT_CONSULTS, DKLangConstW('fFrame_Consults')); //kt
946	//kt original line --> CreateTab(CT_CONSULTS, 'Consults');
947	if ShowSurgeryTab then CreateTab(CT_SURGERY, DKLangConstW('fFrame_Surgery')); //kt
948	//kt original line --> if ShowSurgeryTab then CreateTab(CT_SURGERY, 'Surgery');
949	CreateTab(CT_DCSUMM, DKLangConstW('fFrame_D_C_Summ')); //kt
950	//kt original line --> CreateTab(CT_DCSUMM, 'D/C Summ');
951	CreateTab(CT_LABS, DKLangConstW('fFrame_Labs')); //kt
952	//kt original line --> CreateTab(CT_LABS, 'Labs');
953	CreateTab(CT_REPORTS, DKLangConstW('fFrame_Reports')); //kt
954	//kt original line --> CreateTab(CT_REPORTS, 'Reports');
955	CreateTab(CT_COVER, DKLangConstW('fFrame_Cover_Sheet')); //kt
956	//kt original line --> CreateTab(CT_COVER, 'Cover Sheet');
957
958	for i := CT_WEBTAB1 to CT_LAST_WEBTAB do begin
959	CreateTab(i, IntToStr(i-CT_WEBTAB1+1)); //kt
960	SetATabVisibility(i, false); //kt hide until activated by RPC
961	end;
962	//kt replace later... CreateTab(CT_IMAGES, 'Images'); //kt 8/19/05
963	LoadTabColors(CPRSChartINI,uTabColorsList); //kt added 8/8/08
964
965	ShowHideChartTabMenus(mnuViewChart);
966	// We defer calling LoadUserPreferences to UMInitiate, so that the font sizing
967	// routines recognize this as the application's main form (this hasn't been
968	// set yet).
969	FNextButtonBitmap := TBitmap.Create;
970	FNextButtonBitmap.LoadFromResourceName(hInstance, 'BMP_HANDRIGHT');
971	// set the timeout to DTIME now that there is a connection
972	UpdateTimeOutInterval(User.DTIME * 1000); // DTIME * 1000 mSec
973	// get a patient
974	HandleNeeded; // make sure handle is there for ORWPT SHARE call
975	FCreateProgress := FCP_PTSEL;
976	Enabled := False;
977	FFirstLoad := True; // First time to initialize the fFrame
978	FCreateProgress := FCP_FINISH;
979	pnlReminders.Visible := InteractiveRemindersActive;
980	GraphFloatActive := false;
981	GraphContext := '';
982	uRemoteType := '';
983	FPrevPtID := '';
984	SetUserTools;
985
986	EditDemographics.Enabled := boolTMGPatchInstalled; //elh 6/20/08
987
988	EnduringPtSelSplitterPos := 0;
989	if User.IsReportsOnly then // Reports Only tab.
990	ReportsOnlyDisplay; // Calls procedure to hide all components/menus not needed.
991	InitialOrderVariables;
992	PostMessage(Handle, UM_INITIATE, 0, 0); // select patient after main form is created
993	// mnuFileOpenClick(Self);
994	// if Patient.DFN = '' then //DFN
995	// begin
996	// Close;
997	// Exit;
998	// end;
999	// if WindowState = wsMinimized then WindowState := wsNormal;
1000	SetFormMonitoring(true);
1001	CPRSChartINI.Free; //kt added 8/8/08
1002	end;
1003
1004	procedure TfrmFrame.ActivateCurrentSkin;
1005	begin
1006	{$IFDEF USE_SKINS}
1007	SkinManager.SkinFile := ExtractFilePath (Application.ExeName) + CurrentSkinFile;
1008	if FileExists(SkinManager.SkinFile)=false then begin
1009	SkinManager.SkinFile := '';
1010	end;
1011	if SkinManager.SkinFile <>'' then begin
1012	try
1013	SkinManager.Active := true;
1014	except
1015	on EInvalidOperation do begin
1016	MessageDlg('Error Applying Skin. Please try another.',mtInformation,[mbOK],0);
1017	end;
1018	else begin
1019	MessageDlg('Error Applying Skin. Please try another.',mtInformation,[mbOK],0);
1020	end;
1021	end;
1022	end else begin
1023	SkinManager.Active := false;
1024	end;
1025	{$ENDIF}
1026	end;
1027
1028	procedure TfrmFrame.InactivateSkin;
1029	begin
1030	{$IFDEF USE_SKINS}
1031	SkinManager.Active := false;
1032	{$ENDIF}
1033	end;
1034
1035
1036	procedure TfrmFrame.RenameTabs; //kt added entire function;
1037	//Allows refresh of tab names after initial startup (i.e. when language has changed)
1038	begin
1039	RenameATab(CT_PROBLEMS, DKLangConstW('fFrame_Problems')); //kt
1040	RenameATab(CT_MEDS, DKLangConstW('fFrame_Meds')); //kt
1041	RenameATab(CT_ORDERS, DKLangConstW('fFrame_Orders')); //kt
1042	RenameATab(CT_NOTES, DKLangConstW('fFrame_Notes')); //kt
1043	RenameATab(CT_CONSULTS, DKLangConstW('fFrame_Consults')); //kt
1044	RenameATab(CT_SURGERY, DKLangConstW('fFrame_Surgery')); //kt
1045	RenameATab(CT_DCSUMM, DKLangConstW('fFrame_D_C_Summ')); //kt
1046	RenameATab(CT_LABS, DKLangConstW('fFrame_Labs')); //kt
1047	RenameATab(CT_REPORTS, DKLangConstW('fFrame_Reports')); //kt
1048	RenameATab(CT_COVER, DKLangConstW('fFrame_Cover_Sheet')); //kt
1049	//kt Note: WebTab names will be driven by a RPC call from server, so don't rename here.
1050	end;
1051
1052
1053	procedure TfrmFrame.RenameATab(ATabID: integer; ALabel: string); //kt added entire function;
1054	var index : integer;
1055	begin
1056	index := uTabList.IndexOf(IntToStr(ATabID));
1057	if index > -1 then tabPage.Tabs.Strings[index] := ALabel;
1058	end;
1059
1060	//kt added entire function;
1061	procedure TfrmFrame.SetATabVisibility(ATabID: integer; Visible: boolean; ALabel:string='x');
1062	//kt Note: if Visible=True, then ALabel is expected to contain label for tab. (Not remembered from before setting visible=false)
1063	//Note: This presumes that CreateTab has already been called prior to setting visiblity.
1064	var index : integer;
1065	begin
1066	index := uTabList.IndexOf(IntToStr(ATabID));
1067	if (index > -1) and (Visible=false) then begin
1068	uTabList.Delete(index);
1069	tabPage.Tabs.Delete(index);
1070	end else if (index < 0) and (Visible=true) then begin
1071	if ATabID = CT_COVER then begin
1072	uTabList.Insert(0, IntToStr(ATabID));
1073	tabPage.Tabs.Insert(0, ALabel);
1074	tabPage.TabIndex := 0;
1075	end else begin
1076	uTabList.Add(IntToStr(ATabID));
1077	tabPage.Tabs.Add(ALabel);
1078	end;
1079	end else if (index > -1) and (Visible=true) then begin
1080	tabPage.Tabs.Strings[index] := ALabel; //ensure label is correct.
1081	end;
1082	end;
1083
1084
1085	procedure TfrmFrame.SetWebTabsPerServer; //kt added entire function.
1086	var
1087	URLList: TStringList;
1088	i : integer;
1089	result : string;
1090	begin
1091	URLList := TStringList.Create;
1092	result := fWebTab.AskServerForURLs(URLList);
1093	try
1094	if piece(result,'^',1)='0' then begin
1095	MessageDlg(piece(result,'^',2),mtError,[mbOK],0);
1096	exit;
1097	end;
1098	if piece(result,'^',1)='1' then begin
1099	for i := 1 to URLList.Count-1 do begin
1100	SetOneWebTabPerServer(i, URLList[i]);
1101	end;
1102	end;
1103
1104	finally
1105	URLList.Free;
1106	end;
1107	end;
1108
1109	procedure TfrmFrame.SetOneWebTabPerServer(WebTabNum: integer; URLMsg : string); //kt added entire function.
1110	//Msg format: TabLabelName^URL
1111	// ^about:blank <-- will make tab visible, but blank
1112	// ^<!HIDE!> <-- will make tab invisible
1113	//WebTabNum must be 1..(CT_LAST_WEBTAB-CT_WEBTAB1+1)
1114	var
1115	ATabID : integer;
1116	TabLabel,URL : string;
1117	begin
1118	ATabID := WebTabNum + CT_WEBTAB1 - 1;
1119	if (ATabID < CT_WEBTAB1) or (ATabID > CT_LAST_WEBTAB) then exit;
1120	TabLabel := piece (URLMsg,'^',1);
1121	URL := pieces (URLMsg,'^',2,32);
1122	//returns e.g. 'www.yahoo.com^^^^^^^^^^' etc,
1123	// This allows for ^ to be contained in URL itself (but final character will be trimmed)
1124	while URL[Length(URL)]='^' do begin //trim trailing '^'s
1125	Delete(URL,Length(URL),1);
1126	end;
1127	if URL='<!HIDE!>' then begin
1128	SetATabVisibility(ATabID, false);
1129	end else if URL<>'<!NOCHANGE!>' then begin
1130	SetATabVisibility(ATabID, true, TabLabel);
1131	tempFrmWebTab := TfrmWebTab(frmWebTabs[WebTabNum-1]);
1132	if tempFrmWebTab <> nil then tempFrmWebTab.NagivateTo(URL);
1133	end;
1134	end;
1135
1136
1137	procedure TfrmFrame.StartCCOWContextor;
1138	begin
1139	try
1140	ctxContextor := TContextorControl.Create(Self);
1141	with ctxContextor do
1142	begin
1143	OnPending := ctxContextorPending;
1144	OnCommitted := ctxContextorCommitted;
1145	OnCanceled := ctxContextorCanceled;
1146	end;
1147	FCCOWBusy := False;
1148	FCCOWInstalled := True;
1149	FCCOWDrivedChange := False;
1150	ctxContextor.Run('CPRSChart', '', TRUE, 'Patient');
1151	IsRunExecuted := True;
1152	except
1153	on exc : EOleException do
1154	begin
1155	IsRunExecuted := False;
1156	FreeAndNil(ctxContextor);
1157	try
1158	ctxContextor := TContextorControl.Create(Self);
1159	with ctxContextor do
1160	begin
1161	OnPending := ctxContextorPending;
1162	OnCommitted := ctxContextorCommitted;
1163	OnCanceled := ctxContextorCanceled;
1164	end;
1165	FCCOWBusy := False;
1166	FCCOWInstalled := True;
1167	FCCOWDrivedChange := False;
1168	ctxContextor.Run('CPRSChart' + '#', '', TRUE, 'Patient');
1169	IsRunExecuted := True;
1170	if ParamSearch('CCOW') = 'FORCE' then
1171	begin
1172	mnuFileResumeContext.Enabled := False;
1173	mnuFileBreakContext.Visible := True;
1174	mnuFileBreakContext.Enabled := True;
1175	end
1176	else
1177	begin
1178	ctxContextor.Suspend;
1179	mnuFileResumeContext.Visible := True;
1180	mnuFileBreakContext.Visible := True;
1181	mnuFileBreakContext.Enabled := False;
1182	end;
1183	except
1184	IsRunExecuted := False;
1185	FCCOWInstalled := False;
1186	FreeAndNil(ctxContextor);
1187	pnlCCOW.Visible := False;
1188	mnuFileResumeContext.Visible := False;
1189	mnuFileBreakContext.Visible := False;
1190	end;
1191	end;
1192	end
1193	end;
1194
1195	procedure TfrmFrame.UMInitiate(var Message: TMessage);
1196	begin
1197	NotifyOtherApps(NAE_OPEN, IntToStr(User.DUZ));
1198	LoadUserPreferences;
1199	GetBAStatus(User.DUZ,Patient.DFN);
1200	mnuFileOpenClick(Self);
1201	Enabled := True;
1202	// If TimedOut, Close has already been called.
1203	if not TimedOut and (Patient.DFN = '') then Close;
1204	end;
1205
1206	procedure TfrmFrame.FormDestroy(Sender: TObject);
1207	{ free core objects used by CPRS }
1208	var
1209	CPRSChartINI: TINIFile; //kt 8/8/08
1210
1211	begin
1212	Application.OnActivate := FOldActivate;
1213	Screen.OnActiveFormChange := FOldActiveFormChange;
1214	FNextButtonBitmap.Free;
1215	uTabList.Free;
1216	//kt --- 8/8/08 start mod ---
1217	CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini');
1218	CPRSChartINI.WriteInteger('Options','Language',LangManager.LanguageID);
1219	SaveTabColors(CPRSChartINI,uTabColorsList);
1220	uTabColorsList.Free;
1221	CPRSChartINI.WriteInteger('TAB_POSITION','Tab Location',integer(tabPage.TabPosition));
1222	//kt --- end mod ---
1223
1224	FlaggedPTList.Free;
1225	RemoteSites.Free;
1226	RemoteReports.Free;
1227	Notifications.Free;
1228	Changes.Free;
1229	Encounter.Free;
1230	Patient.Free;
1231	User.Free;
1232	SizeHolder.Free;
1233	ctxContextor.Free;
1234	end;
1235
1236	procedure TfrmFrame.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
1237	{ cancels close if the user cancels the ReviewChanges screen }
1238	var
1239	Reason: string;
1240	begin
1241	if (FCreateProgress < FCP_FINISH) then Exit;
1242	if User.IsReportsOnly then // Reports Only tab.
1243	exit;
1244	if TimedOut then
1245	begin
1246	if Changes.RequireReview then ReviewChanges(TimedOut);
1247	Exit;
1248	end;
1249	if not AllowContextChangeAll(Reason) then CanClose := False;
1250	end;
1251
1252	procedure TfrmFrame.SetUserTools;
1253	var
1254	ToolItems: TToolItemList;
1255	i: Integer;
1256	UserTool: TMenuItem;
1257	MaxedOut: boolean;
1258	// OptionsClick: TNotifyEvent;
1259	begin
1260	if User.IsReportsOnly then // Reports Only tab.
1261	begin
1262	mnuTools.Clear; // Remove all current items.
1263	UserTool := TMenuItem.Create(Self);
1264	// UserTool.Caption := 'Options...'; <-- original line. //kt 7/17/2007
1265	UserTool.Caption := DKLangConstW('fFrame_Optionsxxx'); //kt added 7/17/2007
1266	// UserTool.Hint := 'Options'; <-- original line. //kt 7/17/2007
1267	UserTool.Hint := DKLangConstW('fFrame_Options'); //kt added 7/17/2007
1268	UserTool.OnClick := mnuToolsOptionsClick;
1269	mnuTools.Add(UserTool); // Add back the "Options" menu.
1270	exit;
1271	end;
1272	if User.GECStatus then
1273	begin
1274	UserTool := TMenuItem.Create(self);
1275	// UserTool.Caption := 'GEC Referral Status Display'; <-- original line. //kt 7/17/2007
1276	UserTool.Caption := DKLangConstW('fFrame_GEC_Referral_Status_Display'); //kt added 7/17/2007
1277	// UserTool.Hint := 'GEC Referral Status Display'; <-- original line. //kt 7/17/2007
1278	UserTool.Hint := DKLangConstW('fFrame_GEC_Referral_Status_Display'); //kt added 7/17/2007
1279	UserTool.OnClick := mnuGECStatusClick;
1280	mnuTools.Add(UserTool); // Add back the "Options" menu.
1281	//exit;
1282	end;
1283	GetToolMenu(ToolItems, MaxedOut); // For all other users, proceed normally with creation of Tools menu:
1284	for i := Low(ToolItems) to High(ToolItems) do
1285	begin
1286	// if (AnsiCompareText(ToolItems[i].Caption, 'Event Capture Interface') = 0 ) and <-- original line. //kt 7/17/2007
1287	if (AnsiCompareText(ToolItems[i].Caption, DKLangConstW('fFrame_Event_Capture_Interface')) = 0 ) and //kt added 7/17/2007
1288	(not uECSReport.ECSPermit) then
1289	begin
1290	ToolItems[i].Caption := '';
1291	ToolItems[i].Action := '';
1292	Break;
1293	end;
1294	end;
1295	if MaxedOut then
1296	begin
1297	uToolsMaxed := True;
1298	uToolsWarned := False;
1299	end;
1300	for i := 0 to MAX_TOOLITEMS do with ToolItems[i] do if Length(Caption) > 0 then
1301	begin
1302	UserTool := TMenuItem.Create(Self);
1303	UserTool.Caption := Caption;
1304	UserTool.Hint := Action;
1305	UserTool.OnClick := ToolClick;
1306	mnuTools.Insert(i, UserTool);
1307	end;
1308	end;
1309
1310	procedure TfrmFrame.mnuToolsClick(Sender: TObject);
1311	//const
1312	//TX_TOO_MANY_TOOLS = 'Some defined items may not be shown'; <-- original line. //kt 7/17/2007
1313	//TC_TOO_MANY_TOOLS = 'Tool Menu Limit Exceeded'; <-- original line. //kt 7/17/2007
1314	var
1315	TX_TOO_MANY_TOOLS : string;
1316	TC_TOO_MANY_TOOLS : string;
1317	begin
1318	TX_TOO_MANY_TOOLS := DKLangConstW('fFrame_Some_defined_items_may_not_be_shown'); //kt added 7/17/2007
1319	TC_TOO_MANY_TOOLS := DKLangConstW('fFrame_Tool_Menu_Limit_Exceeded'); //kt added 7/17/2007
1320	if uToolsMaxed and (not uToolsWarned) then
1321	begin
1322	InfoBox(TX_TOO_MANY_TOOLS, TC_TOO_MANY_TOOLS, MB_ICONWARNING or MB_OK);
1323	uToolsWarned := True;
1324	end;
1325	end;
1326
1327	procedure TfrmFrame.UpdateECSParameter(var CmdParameter: string); //ECS
1328	var
1329	vstID,AccVer,Svr,SvrPort,VUser: string;
1330	begin
1331	AccVer := '';
1332	Svr := '';
1333	SvrPort := '';
1334	VUser := '';
1335	if RPCBrokerV <> nil then
1336	begin
1337	AccVer := RPCBrokerV.AccessVerifyCodes;
1338	Svr := RPCBrokerV.Server;
1339	SvrPort := IntToStr(RPCBrokerV.ListenerPort);
1340	VUser := RPCBrokerV.User.DUZ;
1341	end;
1342	vstID := GetVisitID;
1343	CmdParameter :=' Svr=' +Svr
1344	+' SvrPort='+SvrPort
1345	+' VUser='+ VUser
1346	+' PtIEN='+ Patient.DFN
1347	+' PdIEN='+IntToStr(Encounter.Provider)
1348	+' vstIEN='+vstID
1349	+' locIEN='+IntToStr(Encounter.Location)
1350	+' Date=0'
1351	+' Division='+GetDivisionID;
1352	end;
1353
1354	function TfrmFrame.ValidECSUser: boolean; //ECS
1355	var
1356	isTrue: boolean;
1357	begin
1358	Result := True;
1359	with RPCBrokerV do
1360	begin
1361	ShowErrorMsgs := semQuiet;
1362	Connected := True;
1363	try
1364	isTrue := CreateContext(TX_ECSOPT);
1365	if not isTrue then
1366	Result := False;
1367	ShowErrorMsgs := semRaise;
1368	except
1369	on E: Exception do
1370	begin
1371	ShowErrorMsgs := semRaise;
1372	Result := False;
1373	end;
1374	end;
1375	end;
1376	end;
1377
1378	procedure TfrmFrame.FormClose(Sender: TObject; var Action: TCloseAction);
1379	//var
1380	// i: Integer;
1381	// UserTool: TMenuItem;
1382	begin
1383	FClosing := TRUE;
1384	SetFormMonitoring(false);
1385	if FCreateProgress < FCP_FINISH then FTerminate := True;
1386
1387	FlushNotifierBuffer;
1388	if FCreateProgress = FCP_FINISH then NotifyOtherApps(NAE_CLOSE, '');
1389	TerminateOtherAppNotification;
1390
1391	if GraphFloat <> nil then
1392	begin
1393	if frmFrame.GraphFloatActive then
1394	GraphFloat.Close;
1395	GraphFloat.Release;
1396	end;
1397
1398	// unhook the timeout hooks
1399	ShutDownTimeOut;
1400	// clearing changes will unlock notes
1401	if FCreateProgress = FCP_FINISH then Changes.Clear;
1402	// clear server side flag global tmp
1403	if FCreateProgress = FCP_FINISH then ClearFlag;
1404	// save user preferences
1405	if FCreateProgress = FCP_FINISH then SaveUserPreferences;
1406	// call close for each page in case there is any special processing
1407	if FCreateProgress > FCP_FORMS then
1408	begin
1409	mnuFrame.Merge(nil);
1410	frmCover.Close; //frmCover.Release;
1411	frmProblems.Close; //frmProblems.Release;
1412	frmMeds.Close; //frmMeds.Release;
1413	frmOrders.Close; //frmOrders.Release;
1414	frmNotes.Close; //frmNotes.Release;
1415	frmConsults.Close; //frmConsults.Release;
1416	frmDCSumm.Close; //frmDCSumm.Release;
1417	if Assigned(frmSurgery) then frmSurgery.Close; //frmSurgery.Release;
1418	frmLabs.Close; //frmLabs.Release;
1419	frmReports.Close; //frmReports.Release;
1420	end;
1421	// with mnuTools do for i := Count - 1 downto 0 do
1422	// begin
1423	// UserTool := Items[i];
1424	// if UserTool <> nil then
1425	// begin
1426	// Delete(i);
1427	// UserTool.Free;
1428	// end;
1429	// end;
1430	//Application.ProcessMessages; // so everything finishes closing
1431	// if < FCP_FINISH we came here from inside FormCreate, so need to call terminate
1432	//if GraphFloat <> nil then GraphFloat.Release;
1433	if FCreateProgress < FCP_FINISH then Application.Terminate;
1434	end;
1435
1436	procedure TfrmFrame.SetDebugMenu;
1437	var
1438	IsProgrammer: Boolean;
1439	begin
1440	IsProgrammer := User.HasKey('XUPROGMODE');
1441	mnuHelpBroker.Visible := IsProgrammer;
1442	mnuHelpLists.Visible := IsProgrammer;
1443	mnuHelpSymbols.Visible := IsProgrammer;
1444	Z6.Visible := IsProgrammer;
1445	end;
1446
1447	{ Updates posted to MainForm --------------------------------------------------------------- }
1448
1449	procedure TfrmFrame.UMNewOrder(var Message: TMessage);
1450	{ post a notice of change in orders to all TPages, wParam=OrderAction, lParam=TOrder }
1451	var
1452	OrderAct: string;
1453	begin
1454	with Message do
1455	begin
1456	frmCover.NotifyOrder(WParam, TOrder(LParam));
1457	frmProblems.NotifyOrder(WParam, TOrder(LParam));
1458	frmMeds.NotifyOrder(WParam, TOrder(LParam));
1459	frmOrders.NotifyOrder(WParam, TOrder(LParam));
1460	frmNotes.NotifyOrder(WParam, TOrder(LParam));
1461	frmConsults.NotifyOrder(WParam, TOrder(LParam));
1462	frmDCSumm.NotifyOrder(WParam, TOrder(LParam));
1463	if Assigned(frmSurgery) then frmSurgery.NotifyOrder(WParam, TOrder(LParam));
1464	frmLabs.NotifyOrder(WParam, TOrder(LParam));
1465	frmReports.NotifyOrder(WParam, TOrder(LParam));
1466	lblPtCWAD.Caption := GetCWADInfo(Patient.DFN);
1467	if Length(lblPtCWAD.Caption) > 0
1468	// then lblPtPostings.Caption := 'Postings' <-- original line. //kt 7/17/2007
1469	then lblPtPostings.Caption := DKLangConstW('fFrame_Postings') //kt added 7/17/2007
1470	// else lblPtPostings.Caption := 'No Postings'; <-- original line. //kt 7/17/2007
1471	else lblPtPostings.Caption := DKLangConstW('fFrame_No_Postings'); //kt added 7/17/2007
1472	pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
1473	OrderAct := '';
1474	case WParam of
1475	ORDER_NEW: OrderAct := 'NW';
1476	ORDER_DC: OrderAct := 'DC';
1477	ORDER_RENEW: OrderAct := 'RN';
1478	ORDER_HOLD: OrderAct := 'HD';
1479	ORDER_EDIT: OrderAct := 'XX';
1480	ORDER_ACT: OrderAct := 'AC';
1481	end;
1482	if Length(OrderAct) > 0 then NotifyOtherApps(NAE_ORDER, OrderAct + U + TOrder(LParam).ID); // add FillerID
1483	end;
1484	end;
1485
1486	{ Tab Selection (navigate between pages) --------------------------------------------------- }
1487
1488	procedure TfrmFrame.WMSetFocus(var Message: TMessage);
1489	begin
1490	if (FLastPage <> nil) and (not TimedOut) and
1491	(not (csDestroying in FLastPage.ComponentState)) and FLastPage.Visible
1492	then FLastPage.FocusFirstControl;
1493	end;
1494
1495	procedure TfrmFrame.UMShowPage(var Message: TMessage);
1496	{ shows a page when the UM_SHOWPAGE message is received }
1497	begin
1498	if FCCOWDrivedChange then FCCOWDrivedChange := False;
1499	if FLastPage <> nil then FLastPage.DisplayPage;
1500	FChangeSource := CC_CLICK; // reset to click so we're only dealing with exceptions to click
1501	if assigned(FTabChanged) then
1502	FTabChanged(Self);
1503	end;
1504
1505	procedure TfrmFrame.SwitchToPage(NewForm: TfrmPage);
1506	{ unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code }
1507	begin
1508	if FLastPage = NewForm then
1509	begin
1510	if Notifications.Active then PostMessage(Handle, UM_SHOWPAGE, 0, 0);
1511	Exit;
1512	end;
1513	if (FLastPage <> nil) then
1514	begin
1515	mnuFrame.Unmerge(FLastPage.Menu);
1516	FLastPage.Hide;
1517	end;
1518	if Assigned(NewForm) then
1519	begin
1520	{if ((FLastPage = frmOrders) and (NewForm.Name <> frmMeds.Name))
1521	or ((FLastPage = frmMeds) and (NewForm.Name <> frmOrders.Name)) then
1522	begin
1523	if not CloseOrdering then
1524	Exit;
1525	end;}
1526	mnuFrame.Merge(NewForm.Menu);
1527	NewForm.Show;
1528	end;
1529	lstCIRNLocations.Visible := False;
1530	pnlCIRN.BevelOuter := bvRaised;
1531	lstCIRNLocations.SendToBack;
1532	mnuFilePrint.Enabled := False; // let individual page enable this
1533	mnuFilePrintSetup.Enabled := False; // let individual page enable this
1534	mnuFilePrintSelectedItems.Enabled := False;
1535	FLastPage := NewForm;
1536	if NewForm <> nil then
1537	begin
1538	if NewForm.Name = frmNotes.Name then frmNotes.Align := alClient
1539	else frmNotes.Align := alNone;
1540	if NewForm.Name = frmConsults.Name then frmConsults.Align := alClient
1541	else frmConsults.Align := alNone;
1542	if NewForm.Name = frmDCSumm.Name then frmDCSumm.Align := alClient
1543	else frmDCSumm.Align := alNone;
1544	if Assigned(frmSurgery) then
1545	if NewForm.Name = frmSurgery.Name then frmSurgery.Align := alclient
1546	else frmSurgery.Align := alNone;
1547	//kt -- start addition
1548	//below taken out 6/29/07 to achieve compile. Fix later...
1549	//if NewForm.Name = frmImages.Name then frmImages.Align := alClient
1550	// else frmImages.Align := alNone;
1551	//kt -- end addition
1552	NewForm.BringToFront; // to cause tab switch to happen immediately
1553	NewForm.FocusFirstControl;
1554	Application.ProcessMessages;
1555	PostMessage(Handle, UM_SHOWPAGE, 0, 0); // this calls DisplayPage for the form
1556	end;
1557	end;
1558
1559	procedure TfrmFrame.mnuChartTabClick(Sender: TObject);
1560	{ use the Tag property of the menu item to switch to proper page }
1561	begin
1562	with Sender as TMenuItem do tabPage.TabIndex := PageIDToTab(Tag);
1563	LastTab := TabToPageID(tabPage.TabIndex) ;
1564	tabPageChange(tabPage);
1565	end;
1566
1567	procedure TfrmFrame.tabPageChange(Sender: TObject);
1568	{ switches to form linked to NewTab }
1569	var
1570	TabID : integer; //kt added.
1571	begin
1572
1573	if (not User.IsReportsOnly) then
1574	begin
1575	TabID := TabToPageID((sender as TTabControl).TabIndex); //kt
1576	//kt original line --> case TabToPageID((sender as TTabControl).TabIndex) of
1577	case TabID of
1578	CT_NOPAGE: SwitchToPage(nil);
1579	CT_COVER: SwitchToPage(frmCover);
1580	CT_PROBLEMS: SwitchToPage(frmProblems);
1581	CT_MEDS: SwitchToPage(frmMeds);
1582	CT_ORDERS: SwitchToPage(frmOrders);
1583	CT_NOTES: SwitchToPage(frmNotes);
1584	CT_CONSULTS: SwitchToPage(frmConsults);
1585	CT_DCSUMM: SwitchToPage(frmDCSumm);
1586	CT_SURGERY: SwitchToPage(frmSurgery);
1587	CT_LABS: SwitchToPage(frmLabs);
1588	CT_REPORTS: SwitchToPage(frmReports);
1589	CT_WEBTAB1..CT_LAST_WEBTAB: SwitchToPage(frmWebTabs[TabID-CT_WEBTAB1]); //kt added 8/6/08
1590	//kt CT_IMAGES: SwitchToPage(frmImages); //kt 8/19/05
1591	end; {case}
1592	end
1593	else // Reports Only tab.
1594	SwitchToPage(frmReports);
1595
1596	end;
1597
1598	function TfrmFrame.PageIDToTab(PageID: Integer): Integer;
1599	{ returns the tab index that corresponds to a given PageID }
1600	VAR
1601	i: integer;
1602	begin
1603	i := uTabList.IndexOf(IntToStr(PageID));
1604	Result := i;
1605	//Result := uTabList.IndexOf(IntToStr(PageID));
1606	(*
1607	Result := -1;
1608	case PageID of
1609	CT_NOPAGE: Result := -1;
1610	CT_COVER: Result := 0;
1611	CT_PROBLEMS: Result := 1;
1612	CT_MEDS: Result := 2;
1613	CT_ORDERS: Result := 3;
1614	{CT_HP: Result := 4;}
1615	CT_NOTES: Result := 4;
1616	CT_CONSULTS: Result := 5;
1617	CT_DCSUMM: Result := 6;
1618	CT_LABS: Result := 7;
1619	CT_REPORTS: Result := 8;
1620	end;*)
1621	end;
1622
1623	function TfrmFrame.TabToPageID(Tab: Integer): Integer;
1624	{ returns the constant that identifies the page given a TabIndex }
1625	begin
1626	if (Tab > -1) and (Tab < uTabList.Count) then
1627	Result := StrToIntDef(uTabList[Tab], CT_UNKNOWN)
1628	else
1629	Result := CT_NOPAGE;
1630	(* case Tab of
1631	-1: Result := CT_NOPAGE;
1632	0: Result := CT_COVER;
1633	1: Result := CT_PROBLEMS;
1634	2: Result := CT_MEDS;
1635	3: Result := CT_ORDERS;
1636	{4: Result := CT_HP;}
1637	4: Result := CT_NOTES;
1638	5: Result := CT_CONSULTS;
1639	6: Result := CT_DCSUMM;
1640	7: Result := CT_LABS;
1641	8: Result := CT_REPORTS;
1642	end;*)
1643	end;
1644
1645	{ File Menu Events ------------------------------------------------------------------------- }
1646
1647	procedure TfrmFrame.SetupPatient(AFlaggedList : TStringList);
1648	var
1649	AMsg, SelectMsg: string;
1650	begin
1651	with Patient do
1652	begin
1653	ClearPatient; // must be called to avoid leaving previous patient's information visible!
1654	Visible := True;
1655	Application.ProcessMessages;
1656	lblPtName.Caption := Name;
1657	lblPtSSN.Caption := SSN;
1658	lblPtAge.Caption := FormatFMDateTime('mmm dd,yyyy', DOB) + ' (' + IntToStr(Age) + ')';
1659	pnlPatient.Caption := lblPtName.Caption + ' ' + lblPtSSN.Caption + ' ' + lblPtAge.Caption;
1660	if Length(CWAD) > 0
1661	// then lblPtPostings.Caption := 'Postings' <-- original line. //kt 7/17/2007
1662	then lblPtPostings.Caption := DKLangConstW('fFrame_Postings') //kt added 7/17/2007
1663	// else lblPtPostings.Caption := 'No Postings'; <-- original line. //kt 7/17/2007
1664	else lblPtPostings.Caption := DKLangConstW('fFrame_No_Postings'); //kt added 7/17/2007
1665	lblPtCWAD.Caption := CWAD;
1666	pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
1667	if (Length(PrimaryTeam) > 0) or (Length(PrimaryProvider) > 0)
1668	then lblPtCare.Caption := PrimaryTeam + ' / ' + MixedCase(PrimaryProvider);
1669	// if Length(Attending) > 0 then lblPtAttending.Caption := 'Attending: ' + MixedCase(Attending); <-- original line. //kt 7/17/2007
1670	if Length(Attending) > 0 then lblPtAttending.Caption := DKLangConstW('fFrame_Attendingx') + MixedCase(Attending); //kt added 7/17/2007
1671	pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption;
1672	SetUpCIRN;
1673	DisplayEncounterText;
1674	SetShareNode(DFN, Handle);
1675	with Patient do
1676	NotifyOtherApps(NAE_NEWPT, SSN + U + FloatToStr(DOB) + U + Name);
1677	SelectMsg := '';
1678	if MeansTestRequired(Patient.DFN, AMsg) then SelectMsg := AMsg;
1679	if HasLegacyData(Patient.DFN, AMsg) then SelectMsg := SelectMsg + CRLF + AMsg;
1680
1681	HasActiveFlg(FlagList, HasFlag, Patient.DFN);
1682	if HasFlag then
1683	begin
1684	pnlFlag.Enabled := True;
1685	lblFlag.Font.Color := clMaroon;
1686	lblFlag.Enabled := True;
1687	if (not FReFreshing) and (TriggerPRFPopUp(Patient.DFN)) then
1688	ShowFlags;
1689	end else
1690	begin
1691	pnlFlag.Enabled := False;
1692	lblFlag.Font.Color := clBtnFace;
1693	lblFlag.Enabled := False;
1694	end;
1695	FPrevPtID := patient.DFN;
1696	frmCover.UpdateVAAButton; //VAA CQ7525 (moved here in v26.30 (RV))
1697	ProcessPatientChangeEventHook;
1698	if Length(SelectMsg) > 0 then ShowPatientSelectMessages(SelectMsg);
1699	end;
1700	end;
1701
1702	procedure TfrmFrame.mnuFileNextClick(Sender: TObject);
1703	var
1704	SaveDFN, NewDFN: string; // DFN
1705	NextIndex: Integer;
1706	Reason: string;
1707	CCOWResponse: UserResponse;
1708
1709	procedure UpdatePatientInfoForAlert;
1710	begin
1711	if Patient.Inpatient then
1712	begin
1713	Encounter.Inpatient := True;
1714	Encounter.Location := Patient.Location;
1715	Encounter.DateTime := Patient.AdmitTime;
1716	Encounter.VisitCategory := 'H';
1717	end;
1718	if User.IsProvider then Encounter.Provider := User.DUZ;
1719	SetupPatient(FlaggedPTList);
1720	if (FlaggedPTList.IndexOf(Patient.DFN) < 0) then
1721	FlaggedPTList.Add(Patient.DFN);
1722	end;
1723
1724	begin
1725	SaveDFN := Patient.DFN;
1726	Notifications.Next;
1727	if Notifications.Active then
1728	begin
1729	NewDFN := Notifications.DFN;
1730	//Patient.DFN := Notifications.DFN;
1731	//if SaveDFN <> Patient.DFN then
1732	if SaveDFN <> NewDFN then
1733	begin
1734	// newdfn does not have new patient.co information for CCOW call
1735	if (AllowContextChangeAll(Reason)) then
1736	begin
1737	RemindersStarted := FALSE;
1738	Patient.DFN := NewDFN;
1739	Encounter.Clear;
1740	Changes.Clear;
1741	if Assigned(FlagList) then
1742	begin
1743	FlagList.Clear;
1744	HasFlag := False;
1745	HasActiveFlg(FlagList, HasFlag, NewDFN);
1746	end;
1747	if FCCOWInstalled and (ctxContextor.State = csParticipating) then
1748	begin
1749	if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
1750	UpdatePatientInfoForAlert
1751	else
1752	begin
1753	case CCOWResponse of
1754	urCancel:
1755	begin
1756	Patient.DFN := SaveDFN;
1757	Notifications.Prior;
1758	Exit;
1759	end;
1760	urBreak:
1761	begin
1762	// do not revert to old DFN if context was manually broken by user - v26 (RV)
1763	if (ctxContextor.State = csParticipating) then Patient.DFN := SaveDFN;
1764	UpdatePatientInfoForAlert;
1765	end;
1766	else
1767	UpdatePatientInfoForAlert;
1768	end;
1769	end;
1770	end
1771	else
1772	UpdatePatientInfoForAlert
1773	end else
1774	begin
1775	Patient.DFN := SaveDFN;
1776	Notifications.Prior;
1777	Exit;
1778	end;
1779	end;
1780	stsArea.Panels.Items[1].Text := Notifications.Text;
1781	FChangeSource := CC_NOTIFICATION;
1782	NextIndex := PageIDToTab(CT_COVER);
1783	tabPage.TabIndex := CT_NOPAGE;
1784	tabPageChange(tabPage);
1785	mnuFileNotifRemove.Enabled := Notifications.Followup in [NF_FLAGGED_ORDERS,
1786	NF_ORDER_REQUIRES_ELEC_SIGNATURE,
1787	NF_MEDICATIONS_EXPIRING_INPT,
1788	NF_MEDICATIONS_EXPIRING_OUTPT,
1789	NF_UNVERIFIED_MEDICATION_ORDER,
1790	NF_UNVERIFIED_ORDER,
1791	NF_FLAGGED_OI_EXP_INPT,
1792	NF_FLAGGED_OI_EXP_OUTPT];
1793	case Notifications.FollowUp of
1794	NF_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1795	NF_FLAGGED_ORDERS : NextIndex := PageIDToTab(CT_ORDERS);
1796	NF_ORDER_REQUIRES_ELEC_SIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
1797	NF_ABNORMAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1798	NF_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
1799	NF_CONSULT_REQUEST_RESOLUTION : NextIndex := PageIDToTab(CT_CONSULTS);
1800	NF_ABNORMAL_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
1801	NF_IMAGING_REQUEST_CANCEL_HELD : NextIndex := PageIDToTab(CT_ORDERS);
1802	NF_NEW_SERVICE_CONSULT_REQUEST : NextIndex := PageIDToTab(CT_CONSULTS);
1803	NF_CONSULT_REQUEST_CANCEL_HOLD : NextIndex := PageIDToTab(CT_CONSULTS);
1804	NF_SITE_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1805	NF_ORDERER_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1806	NF_ORDER_REQUIRES_COSIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
1807	NF_LAB_ORDER_CANCELED : NextIndex := PageIDToTab(CT_ORDERS);
1808	NF_STAT_RESULTS :
1809	if Piece(Piece(Notifications.AlertData, '\|', 2), '@', 2) = 'LRCH' then
1810	NextIndex := PageIDToTab(CT_LABS)
1811	else if Piece(Piece(Notifications.AlertData, '\|', 2), '@', 2) = 'GMRC' then
1812	NextIndex := PageIDToTab(CT_CONSULTS)
1813	else if Piece(Piece(Notifications.AlertData, '\|', 2), '@', 2) = 'RA' then
1814	NextIndex := PageIDToTab(CT_REPORTS);
1815	NF_DNR_EXPIRING : NextIndex := PageIDToTab(CT_ORDERS);
1816	NF_MEDICATIONS_EXPIRING_INPT : NextIndex := PageIDToTab(CT_ORDERS);
1817	NF_MEDICATIONS_EXPIRING_OUTPT : NextIndex := PageIDToTab(CT_ORDERS);
1818	NF_UNVERIFIED_MEDICATION_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1819	NF_NEW_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1820	NF_IMAGING_RESULTS_AMENDED : NextIndex := PageIDToTab(CT_REPORTS);
1821	NF_CRITICAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1822	NF_UNVERIFIED_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1823	NF_FLAGGED_OI_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1824	NF_FLAGGED_OI_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1825	NF_DC_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1826	NF_CONSULT_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_CONSULTS);
1827	NF_DCSUMM_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_DCSUMM);
1828	NF_NOTES_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_NOTES);
1829	NF_CONSULT_REQUEST_UPDATED : NextIndex := PageIDToTab(CT_CONSULTS);
1830	NF_FLAGGED_OI_EXP_INPT : NextIndex := PageIDToTab(CT_ORDERS);
1831	NF_FLAGGED_OI_EXP_OUTPT : NextIndex := PageIDToTab(CT_ORDERS);
1832	NF_CONSULT_PROC_INTERPRETATION : NextIndex := PageIDToTab(CT_CONSULTS);
1833	NF_IMAGING_REQUEST_CHANGED :
1834	begin
1835	ReportBox(GetNotificationFollowUpText(Patient.DFN, Notifications.FollowUp, Notifications.AlertData), Pieces(Piece(Notifications.RecordID, U, 1), ':', 2, 3), True);
1836	Notifications.Delete;
1837	end;
1838	NF_LAB_THRESHOLD_EXCEEDED : NextIndex := PageIDToTab(CT_LABS);
1839	NF_SURGERY_UNSIGNED_NOTE : if TabExists(CT_SURGERY) then
1840	NextIndex := PageIDToTab(CT_SURGERY)
1841	else
1842	InfoBox(TX_NO_SURG_NOTIF, TC_NO_SURG_NOTIF, MB_OK);
1843	//NextIndex := PageIDToTab(CT_NOTES);
1844	else InfoBox(TX_UNK_NOTIF, TC_UNK_NOTIF, MB_OK);
1845	end;
1846	tabPage.TabIndex := NextIndex;
1847	tabPageChange(tabPage);
1848	end
1849	else mnuFileOpenClick(mnuFileNext);
1850	end;
1851
1852
1853	procedure TfrmFrame.SetBADxList;
1854	var
1855	i: smallint;
1856	begin
1857	if not Assigned(UBAGlobals.tempDxList) then
1858	begin
1859	UBAGlobals.tempDxList := TList.Create;
1860	UBAGlobals.tempDxList.Count := 0;
1861	Application.ProcessMessages;
1862	end
1863	else
1864	begin
1865	//Kill the old Dx list
1866	for i := 0 to pred(UBAGlobals.tempDxList.Count) do
1867	TObject(UBAGlobals.tempDxList[i]).Free;
1868
1869	UBAGlobals.tempDxList.Clear;
1870	Application.ProcessMessages;
1871
1872	//Create new Dx list for newly selected patient
1873	if not Assigned(UBAGlobals.tempDxList) then
1874	begin
1875	UBAGlobals.tempDxList := TList.Create;
1876	UBAGlobals.tempDxList.Count := 0;
1877	Application.ProcessMessages;
1878	end;
1879	end;
1880	end;
1881
1882	procedure TfrmFrame.mnuFileOpenClick(Sender: TObject);
1883	{ select a new patient & update the header displays (patient id, encounter, postings) }
1884	var
1885	SaveDFN, Reason: string;
1886	//NextTab: Integer; // moved up for visibility - v23.4 rV
1887	ok, OldRemindersStarted, PtSelCancelled: boolean;
1888	//i: smallint;
1889	CCOWResponse: UserResponse;
1890	begin
1891	SetWebTabsPerServer; //kt added
1892	PtSelCancelled := FALSE;
1893	DetermineNextTab;
1894	(* if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
1895	NextTab := TabToPageID(tabPage.TabIndex)
1896	else
1897	NextTab := User.InitialTab;
1898	if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1899	if User.IsReportsOnly then // Reports Only tab.
1900	NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
1901	if not TabExists(NextTab) then NextTab := CT_COVER;
1902	if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1903	if NextTab = CT_ORDERS then
1904	if frmOrders <> nil then with frmOrders do
1905	begin
1906	if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
1907	PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
1908	end;*)
1909	if not AllowContextChangeAll(Reason) then Exit;
1910
1911	// update status text here
1912	stsArea.Panels.Items[1].Text := '';
1913	if (not User.IsReportsOnly) then
1914	begin
1915	if not FRefreshing then
1916	begin
1917	Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
1918	if Notifications.Active then
1919	begin
1920	if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
1921	begin
1922	Notifications.Prior;
1923	Exit;
1924	end;
1925	end;
1926	if Notifications.Active then Notifications.Prior;
1927	end;
1928	end;
1929
1930	if FNoPatientSelected then
1931	SaveDFN := ''
1932	else
1933	SaveDFN := Patient.DFN;
1934
1935	OldRemindersStarted := RemindersStarted;
1936	RemindersStarted := FALSE;
1937	try
1938	if FRefreshing then
1939	begin
1940	UpdatePtInfoOnRefresh;
1941	ok := TRUE;
1942	end
1943	else
1944	begin
1945	ok := FALSE;
1946	if (not User.IsReportsOnly) then
1947	begin
1948	if FCCOWInstalled and (ctxContextor.State = csParticipating) then
1949	begin
1950	UpdateCCOWContext;
1951	if not FCCOWError then
1952	begin
1953	FCCOWIconName := 'BMP_CCOW_LINKED';
1954	pnlCCOW.Hint := TX_CCOW_LINKED;
1955	imgCCOW.Picture.Bitmap.LoadFromResourceName(hInstance, FCCOWIconName);
1956	end;
1957	end
1958	else
1959	begin
1960	FCCOWIconName := 'BMP_CCOW_BROKEN';
1961	pnlCCOW.Hint := TX_CCOW_BROKEN;
1962	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
1963	end;
1964	if (Patient.DFN = '') or (Sender = mnuFileOpen) or (Sender = mnuFileNext) or (Sender = mnuViewDemo) then
1965	SelectPatient(SHOW_NOTIFICATIONS, Font.Size, PtSelCancelled);
1966	if PtSelCancelled then exit;
1967	ShowEverything;
1968	DisplayEncounterText;
1969	FPrevInPatient := Patient.Inpatient;
1970	if Notifications.Active then
1971	begin
1972	// display 'next notification' button
1973	FNextButtonActive := True;
1974	with stsArea.Panels[2] do
1975	begin
1976	//Text := 'Next ->';
1977	Bevel := pbRaised;
1978	end;
1979	mnuFileNext.Enabled := True;
1980	mnuFileNextClick(Self);
1981	end
1982	else
1983	begin
1984	// hide the 'next notification' button
1985	FNextButtonActive := False;
1986	with stsArea.Panels[2] do
1987	begin
1988	//Text := '';
1989	Bevel := pbLowered;
1990	end;
1991	mnuFileNext.Enabled := False;
1992	mnuFileNotifRemove.Enabled := False;
1993	if Patient.DFN <> SaveDFN then
1994	ok := TRUE;
1995	end
1996	end
1997	else
1998	begin
1999	Notifications.Clear;
2000	SelectPatient(False, Font.Size, PtSelCancelled); // Call Pt. Sel. w/o notifications.
2001	if PtSelCancelled then exit;
2002	ShowEverything;
2003	DisplayEncounterText;
2004	FPrevInPatient := Patient.Inpatient;
2005	ok := TRUE;
2006	end;
2007	end;
2008	if ok then
2009	begin
2010	if FCCOWInstalled and (ctxContextor.State = csParticipating) and (not FRefreshing) then
2011	begin
2012	if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
2013	begin
2014	SetupPatient;
2015	tabPage.TabIndex := PageIDToTab(NextTab);
2016	tabPageChange(tabPage);
2017	end
2018	else
2019	begin
2020	case CCOWResponse of
2021	urCancel: UpdateCCOWContext;
2022	urBreak:
2023	begin
2024	// do not revert to old DFN if context was manually broken by user - v26 (RV)
2025	if (ctxContextor.State = csParticipating) then Patient.DFN := SaveDFN;
2026	SetupPatient;
2027	tabPage.TabIndex := PageIDToTab(NextTab);
2028	tabPageChange(tabPage);
2029	end;
2030	else
2031	begin
2032	SetupPatient;
2033	tabPage.TabIndex := PageIDToTab(NextTab);
2034	tabPageChange(tabPage);
2035	end;
2036	end;
2037	end;
2038	end
2039	else
2040	begin
2041	SetupPatient;
2042	tabPage.TabIndex := PageIDToTab(NextTab);
2043	tabPageChange(tabPage);
2044	end;
2045	end;
2046	finally
2047	if (not FRefreshing) and (Patient.DFN = SaveDFN) then
2048	RemindersStarted := OldRemindersStarted;
2049	FFirstLoad := False;
2050	end;
2051	{Begin BillingAware}
2052	if BILLING_AWARE then frmFrame.SetBADxList; //end IsBillingAware
2053	{End BillingAware}
2054	//frmCover.UpdateVAAButton; //VAA CQ7525 CQ#7933 - moved to SetupPatient, before event hook execution (RV)
2055	end;
2056
2057	procedure TfrmFrame.DetermineNextTab;
2058	begin
2059	if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
2060	begin
2061	if (tabPage.TabIndex < 0) then
2062	NextTab := LastTab
2063	else
2064	NextTab := TabToPageID(tabPage.TabIndex);
2065	end
2066	else
2067	NextTab := User.InitialTab;
2068	if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
2069	if User.IsReportsOnly then // Reports Only tab.
2070	NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
2071	if not TabExists(NextTab) then NextTab := CT_COVER;
2072	if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
2073	if NextTab = CT_ORDERS then
2074	if frmOrders <> nil then with frmOrders do
2075	begin
2076	if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
2077	PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
2078	end;
2079	end;
2080
2081	procedure TfrmFrame.mnuFileEncounterClick(Sender: TObject);
2082	{ displays encounter window and updates encounter display in case encounter was updated }
2083	begin
2084	UpdateEncounter(NPF_ALL); {KCM}
2085	DisplayEncounterText;
2086	end;
2087
2088	procedure TfrmFrame.mnuFileReviewClick(Sender: TObject);
2089	{ displays the Review Changes window (which resets the Encounter object) }
2090	var
2091	EventChanges: boolean;
2092	NameNeedLook: string;
2093	begin
2094	EventChanges := False;
2095	NameNeedLook := '';
2096	UpdatePtInfoOnRefresh;
2097	if Changes.Count > 0 then
2098	begin
2099	if (frmOrders <> nil) and (frmOrders.TheCurrentView <> nil) and ( frmOrders.TheCurrentView.EventDelay.EventIFN>0) then
2100	begin
2101	EventChanges := True;
2102	NameNeedLook := frmOrders.TheCurrentView.ViewName;
2103	frmOrders.PtEvtCompleted(frmOrders.TheCurrentView.EventDelay.PtEventIFN, frmOrders.TheCurrentView.EventDelay.EventName);
2104	end;
2105	ReviewChanges(TimedOut, EventChanges);
2106	if TabToPageID(tabPage.TabIndex)= CT_MEDS then
2107	begin
2108	frmOrders.InitOrderSheets2(NameNeedLook);
2109	end;
2110	end
2111	//else InfoBox('No new changes to review/sign.', 'Review Changes', MB_OK); <-- original line. //kt 7/17/2007
2112	else InfoBox(DKLangConstW('fFrame_No_new_changes_to_reviewxsignx'), DKLangConstW('fFrame_Review_Changes'), MB_OK); //kt added 7/17/2007
2113	end;
2114
2115	procedure TfrmFrame.mnuFileExitClick(Sender: TObject);
2116	{ see the CloseQuery event }
2117	var
2118	i: smallint;
2119	begin
2120	try
2121	if BILLING_AWARE then
2122	begin
2123	if Assigned(tempDxList) then
2124	for i := 0 to pred(UBAGlobals.tempDxList.Count) do
2125	TObject(UBAGlobals.tempDxList[i]).Free;
2126
2127	UBAGlobals.tempDxList.Clear;
2128	Application.ProcessMessages;
2129	end; //end IsBillingAware
2130	except
2131	on EAccessViolation do
2132	begin
2133	// {$ifdef debug}ShowMessage('Access Violation in procedure TfrmFrame.mnuFileExitClick()');{$endif} <-- original line. //kt 7/17/2007
2134	{$ifdef debug}ShowMessage(DKLangConstW('fFrame_Access_Violation_in_procedure_TfrmFramexmnuFileExitClickxx'));{$endif} //kt added 7/17/2007
2135	raise;
2136	end;
2137	on E: Exception do
2138	begin
2139	// {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmFrame.mnuFileExitClick()');{$endif} <-- original line. //kt 7/17/2007
2140	{$ifdef debug}ShowMessage(DKLangConstW('fFrame_Unhandled_exception_in_procedure_TfrmFramexmnuFileExitClickxx'));{$endif} //kt added 7/17/2007
2141	raise;
2142	end;
2143	end;
2144
2145	Close;
2146	end;
2147
2148	{ View Menu Events ------------------------------------------------------------------------- }
2149
2150	procedure TfrmFrame.mnuViewPostingsClick(Sender: TObject);
2151	begin
2152	end;
2153
2154	{ Tool Menu Events ------------------------------------------------------------------------- }
2155
2156	function TfrmFrame.ExpandCommand(x: string): string;
2157	{ look for 'macros' on the command line and expand them using current context }
2158
2159	procedure Substitute(const Key, Data: string);
2160	var
2161	Stop, Start: Integer;
2162	begin
2163	Stop := Pos(Key, x) - 1;
2164	Start := Stop + Length(Key) + 1;
2165	x := Copy(x, 1, Stop) + Data + Copy(x, Start, Length(x));
2166	end;
2167
2168	begin
2169	if Pos('%MREF', x) > 0 then Substitute('%MREF',
2170	'^TMP(''ORWCHART'',' + MScalar('$J') + ',''' + DottedIPStr + ''',' + IntToHex(Handle, 8) + ')');
2171	if Pos('%SRV', x) > 0 then Substitute('%SRV', RPCBrokerV.Server);
2172	if Pos('%PORT', x) > 0 then Substitute('%PORT', IntToStr(RPCBrokerV.ListenerPort));
2173	if Pos('%DFN', x) > 0 then Substitute('%DFN', Patient.DFN); //DFN
2174	if Pos('%DUZ', x) > 0 then Substitute('%DUZ', IntToStr(User.DUZ));
2175	Result := x;
2176	end;
2177
2178	procedure TfrmFrame.ToolClick(Sender: TObject);
2179	{ executes the program associated with an item on the Tools menu, the command line is stored
2180	in the item's hint property }
2181	//const
2182	//TXT_ECS_NOTFOUND = 'The ECS application is not found at the default directory,' + #13 + 'would you like manually search it?'; <-- original line. //kt 7/17/2007
2183	//TC_ECS_NOTFOUND = 'Application Not Found'; <-- original line. //kt 7/17/2007
2184	var
2185	x, AFile, Param, MenuCommand, ECSAppend, CapNm, curPath : string;
2186	IsECSInterface: boolean;
2187
2188	TXT_ECS_NOTFOUND : string;
2189	TC_ECS_NOTFOUND : string;
2190
2191	function TakeOutAmps(AString: string): string;
2192	var
2193	S1,S2: string;
2194	begin
2195	if Pos('&',AString)=0 then
2196	begin
2197	Result := AString;
2198	Exit;
2199	end;
2200	S1 := Piece(AString,'&',1);
2201	S2 := Piece(AString,'&',2);
2202	Result := S1 + S2;
2203	end;
2204
2205	function ExcuteEC(AFile,APara: string): boolean;
2206	begin
2207	if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL) > 32 ) then Result := True
2208	else
2209	begin
2210	if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
2211	begin
2212	if OROpenDlg.Execute then
2213	begin
2214	AFile := OROpenDlg.FileName;
2215	if Pos('ecs gui.exe',lowerCase(AFile))<1 then
2216	begin
2217	// ShowMessage('This is not a valid ECS application.'); <-- original line. //kt 7/17/2007
2218	ShowMessage(DKLangConstW('fFrame_This_is_not_a_valid_ECS_applicationx')); //kt added 7/17/2007
2219	Result := True;
2220	end else
2221	begin
2222	if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL)<32) then Result := False
2223	else Result := True;
2224	end;
2225	end
2226	else Result := True;
2227	end else Result := True;
2228	end;
2229	end;
2230
2231	function ExcuteECS(AFile, APara: string; var currPath: string): boolean;
2232	var
2233	commandline,RPCHandle: string;
2234	StartupInfo: TStartupInfo;
2235	ProcessInfo: TProcessInformation;
2236	begin
2237	FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
2238	with StartupInfo do
2239	begin
2240	cb := SizeOf(TStartupInfo);
2241	dwFlags := STARTF_USESHOWWINDOW;
2242	wShowWindow := SW_SHOWNORMAL;
2243	end;
2244	commandline := AFile + Param;
2245	RPCHandle := GetAppHandle(RPCBrokerV);
2246	commandline := commandline + ' H=' + RPCHandle;
2247	if CreateProcess(nil, PChar(commandline), nil, nil, False,
2248	NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then Result := True
2249	else
2250	begin
2251	if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
2252	begin
2253	if OROpenDlg.Execute then
2254	begin
2255	AFile := OROpenDlg.FileName;
2256	if Pos('ecs gui.exe',lowerCase(AFile))<1 then
2257	begin
2258	// ShowMessage('This is not a valid ECS application.'); <-- original line. //kt 7/17/2007
2259	ShowMessage(DKLangConstW('fFrame_This_is_not_a_valid_ECS_applicationx')); //kt added 7/17/2007
2260	Result := True;
2261	end else
2262	begin
2263	// SaveUserPath('Event Capture Interface='+AFile, currPath); <-- original line. //kt 7/17/2007
2264	SaveUserPath(DKLangConstW('fFrame_Event_Capture_Interface')+'='+AFile, currPath); //kt added 7/17/2007
2265	FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
2266	with StartupInfo do
2267	begin
2268	cb := SizeOf(TStartupInfo);
2269	dwFlags := STARTF_USESHOWWINDOW;
2270	wShowWindow := SW_SHOWNORMAL;
2271	end;
2272	commandline := AFile + Param;
2273	RPCHandle := GetAppHandle(RPCBrokerV);
2274	commandline := commandline + ' H=' + RPCHandle;
2275	if not CreateProcess(nil, PChar(commandline), nil, nil, False,
2276	NORMAL_PRIORITY_CLASS, nil, nil,StartupInfo,ProcessInfo) then Result := False
2277	else Result := True;
2278	end;
2279	end
2280	else Result := True;
2281	end else Result := True;
2282	end;
2283	end;
2284
2285	begin
2286	TXT_ECS_NOTFOUND := DKLangConstW('fFrame_The_ECS_application_is_not_found_at_the_default_directoryx') + #13 + DKLangConstW('fFrame_would_you_like_manually_search_itx'); //kt added 7/17/2007
2287	TC_ECS_NOTFOUND := DKLangConstW('fFrame_Application_Not_Found'); //kt added 7/17/2007
2288
2289	MenuCommand := '';
2290	ECSAppend := '';
2291	IsECSInterface := False;
2292	curPath := '';
2293	CapNm := LowerCase(TMenuItem(Sender).Caption);
2294	CapNm := TakeOutAmps(CapNm);
2295	if AnsiCompareText('event capture interface',CapNm)=0 then
2296	begin
2297	IsECSInterface := True;
2298	if FECSAuthUser then UpdateECSParameter(ECSAppend)
2299	else begin
2300	// ShowMessage('You don''t have permission to use ECS.'); <-- original line. //kt 7/17/2007
2301	ShowMessage(DKLangConstW('fFrame_You_donxxt_have_permission_to_use_ECSx')); //kt added 7/17/2007
2302	exit;
2303	end;
2304	end;
2305	MenuCommand := TMenuItem(Sender).Hint + ECSAppend;
2306	x := ExpandCommand(MenuCommand);
2307	if CharAt(x, 1) = '"' then
2308	begin
2309	x := Copy(x, 2, Length(x));
2310	AFile := Copy(x, 1, Pos('"',x)-1);
2311	Param := Copy(x, Pos('"',x)+1, Length(x));
2312	end else
2313	begin
2314	AFile := Piece(x, ' ', 1);
2315	Param := Copy(x, Length(AFile)+1, Length(x));
2316	end;
2317	if IsECSInterface then
2318	begin
2319	if not ExcuteECS(AFile,Param,curPath) then
2320	ExcuteECS(AFile,Param,curPath);
2321	if Length(curPath)>0 then
2322	TMenuItem(Sender).Hint := curPath;
2323	end
2324	else if (Pos('ecs',LowerCase(AFile))>0) and (not IsECSInterface) then
2325	begin
2326	if not ExcuteEC(AFile,Param) then
2327	ExcuteEC(AFile,Param);
2328	end else
2329	begin
2330	ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL);
2331	end;
2332	end;
2333
2334	{ Help Menu Events ------------------------------------------------------------------------- }
2335
2336	procedure TfrmFrame.mnuHelpBrokerClick(Sender: TObject);
2337	{ used for debugging - shows last n broker calls }
2338	begin
2339	ShowBroker;
2340	end;
2341
2342	procedure TfrmFrame.mnuHelpListsClick(Sender: TObject);
2343	{ used for debugging - shows internal contents of TORListBox }
2344	begin
2345	if Screen.ActiveControl is TListBox
2346	then DebugListItems(TListBox(Screen.ActiveControl))
2347	// else InfoBox('Focus control is not a listbox', 'ListBox Data', MB_OK); <-- original line. //kt 7/17/2007
2348	else InfoBox(DKLangConstW('fFrame_Focus_control_is_not_a_listbox'), DKLangConstW('fFrame_ListBox_Data'), MB_OK); //kt added 7/17/2007
2349	end;
2350
2351	procedure TfrmFrame.mnuHelpSymbolsClick(Sender: TObject);
2352	{ used for debugging - shows current symbol table }
2353	begin
2354	DebugShowServer;
2355	end;
2356
2357	procedure TfrmFrame.mnuHelpAboutClick(Sender: TObject);
2358	{ displays the about screen }
2359	begin
2360	ShowAbout;
2361	end;
2362
2363	{ Status Bar Methods }
2364
2365	procedure TfrmFrame.UMStatusText(var Message: TMessage);
2366	{ displays status bar text (using the pointer to a text buffer passed in LParam) }
2367	begin
2368	stsArea.Panels.Items[0].Text := StrPas(PChar(Message.LParam));
2369	stsArea.Refresh;
2370	end;
2371
2372	procedure TfrmFrame.stsAreaMouseDown(Sender: TObject; Button: TMouseButton;
2373	Shift: TShiftState; X, Y: Integer);
2374	begin
2375	if (FNextButtonActive) and (X > FNextButtonL) and (X < FNextButtonR) then
2376	begin
2377	stsArea.Panels[2].Bevel := pbLowered;
2378	popAlerts.AutoPopup := TRUE;
2379	end;
2380	end;
2381
2382	procedure TfrmFrame.stsAreaMouseUp(Sender: TObject; Button: TMouseButton;
2383	Shift: TShiftState; X, Y: Integer);
2384	begin
2385	if FNextButtonActive then
2386	begin
2387	stsArea.Panels[2].Bevel := pbRaised;
2388	popAlerts.AutoPopup := FALSE;
2389	if (X > FNextButtonL) and (X < FNextButtonR) then
2390	if Button = mbLeft then mnuFileNextClick(Self);
2391	end;
2392	end;
2393
2394	procedure TfrmFrame.stsAreaDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
2395	const Rect: TRect);
2396	begin
2397	if FNextButtonActive then with StatusBar.Canvas do
2398	begin
2399	Draw(Rect.Left + 2, Rect.Top, FNextButtonBitmap); { draw bitmap }
2400	TextOut(Rect.Left + 20, Rect.Top + 2, 'Next'); { draw text to the right of the bitmap }
2401	end;
2402	end;
2403
2404	{ Toolbar Methods (make panels act like buttons) ------------------------------------------- }
2405
2406	procedure TfrmFrame.pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
2407	Shift: TShiftState; X, Y: Integer);
2408	{ emulate a button press in the patient identification panel }
2409	begin
2410	if pnlPatient.BevelOuter = bvLowered then exit;
2411	pnlPatient.BevelOuter := bvLowered;
2412	with lblPtName do SetBounds(Left+2, Top+2, Width, Height);
2413	with lblPtSSN do SetBounds(Left+2, Top+2, Width, Height);
2414	with lblPtAge do SetBounds(Left+2, Top+2, Width, Height);
2415	end;
2416
2417	procedure TfrmFrame.pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
2418	Shift: TShiftState; X, Y: Integer);
2419	{ emulate the button raising in the patient identification panel & call Patient Inquiry }
2420	begin
2421	if pnlPatient.BevelOuter = bvRaised then exit;
2422	pnlPatient.BevelOuter := bvRaised;
2423	with lblPtName do SetBounds(Left-2, Top-2, Width, Height);
2424	with lblPtSSN do SetBounds(Left-2, Top-2, Width, Height);
2425	with lblPtAge do SetBounds(Left-2, Top-2, Width, Height);
2426	end;
2427
2428	procedure TfrmFrame.pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
2429	Shift: TShiftState; X, Y: Integer);
2430	{ emulate a button press in the encounter panel }
2431	begin
2432	if User.IsReportsOnly then
2433	exit;
2434	pnlVisit.BevelOuter := bvLowered;
2435	//with lblStLocation do SetBounds(Left+2, Top+2, Width, Height);
2436	with lblPtLocation do SetBounds(Left+2, Top+2, Width, Height);
2437	with lblPtProvider do SetBounds(Left+2, Top+2, Width, Height);
2438	end;
2439
2440	procedure TfrmFrame.pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
2441	Shift: TShiftState; X, Y: Integer);
2442	{ emulate a button raising in the encounter panel and call Update Provider/Location }
2443	begin
2444	if User.IsReportsOnly then
2445	exit;
2446	pnlVisit.BevelOuter := bvRaised;
2447	//with lblStLocation do SetBounds(Left-2, Top-2, Width, Height);
2448	with lblPtLocation do SetBounds(Left-2, Top-2, Width, Height);
2449	with lblPtProvider do SetBounds(Left-2, Top-2, Width, Height);
2450	end;
2451
2452	procedure TfrmFrame.pnlPrimaryCareMouseDown(Sender: TObject;
2453	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2454	begin
2455	pnlPrimaryCare.BevelOuter := bvLowered;
2456	with lblPtCare do SetBounds(Left+2, Top+2, Width, Height);
2457	with lblPtAttending do SetBounds(Left+2, Top+2, Width, Height);
2458	end;
2459
2460	procedure TfrmFrame.pnlPrimaryCareMouseUp(Sender: TObject;
2461	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2462	begin
2463	pnlPrimaryCare.BevelOuter := bvRaised;
2464	with lblPtCare do SetBounds(Left-2, Top-2, Width, Height);
2465	with lblPtAttending do SetBounds(Left-2, Top-2, Width, Height);
2466	end;
2467
2468	procedure TfrmFrame.pnlPostingsMouseDown(Sender: TObject;
2469	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2470	{ emulate a button press in the postings panel }
2471	begin
2472	pnlPostings.BevelOuter := bvLowered;
2473	with lblPtPostings do SetBounds(Left+2, Top+2, Width, Height);
2474	with lblPtCWAD do SetBounds(Left+2, Top+2, Width, Height);
2475	end;
2476
2477	procedure TfrmFrame.pnlPostingsMouseUp(Sender: TObject;
2478	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2479	{ emulate a button raising in the posting panel and call Postings }
2480	begin
2481	pnlPostings.BevelOuter := bvRaised;
2482	with lblPtPostings do SetBounds(Left-2, Top-2, Width, Height);
2483	with lblPtCWAD do SetBounds(Left-2, Top-2, Width, Height);
2484	end;
2485
2486	{ Resize and Font-Change procedures -------------------------------------------------------- }
2487
2488	procedure TfrmFrame.LoadSizesForUser;
2489	var
2490	s1, s2, s3, s4, Dummy: integer;
2491
2492	panelBottom, panelMedIn : integer;
2493
2494	begin
2495	ChangeFont(UserFontSize);
2496	SetUserBounds(TControl(frmFrame));
2497	SetUserWidths(TControl(frmProblems.pnlLeft));
2498	//SetUserWidths(TControl(frmMeds.pnlLeft));
2499	SetUserWidths(TControl(frmOrders.pnlLeft));
2500	SetUserWidths(TControl(frmNotes.pnlLeft));
2501	SetUserWidths(TControl(frmConsults.pnlLeft));
2502	SetUserWidths(TControl(frmDCSumm.pnlLeft));
2503	if Assigned(frmSurgery) then SetUserWidths(TControl(frmSurgery.pnlLeft));
2504	SetUserWidths(TControl(frmLabs.pnlLeft));
2505	SetUserWidths(TControl(frmReports.pnlLeft));
2506	SetUserColumns(TControl(frmOrders.hdrOrders));
2507	SetUserColumns(TControl(frmMeds.hdrMedsIn)); // still need conversion
2508	SetUserColumns(TControl(frmMeds.hdrMedsOut));
2509	SetUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight);
2510	SetUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight);
2511	SetUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, Dummy ,Dummy);
2512	SetUserBounds2(DrawerSplitters,s1, s2, s3, Dummy);
2513	if Assigned(frmSurgery) then frmSurgery.Drawers.LastOpenSize := Dummy; //CQ7315
2514	frmNotes.Drawers.LastOpenSize := s1;
2515	frmConsults.Drawers.LastOpenSize := s2;
2516	frmDCSumm.Drawers.LastOpenSize := s3;
2517
2518	with frmMeds do
2519	begin
2520	SetUserBounds2(frmMeds.Name+'Split', panelBottom, panelMedIn, Dummy, Dummy);
2521	if (panelBottom > frmMeds.Height-50) then panelBottom := frmMeds.Height-50;
2522	if (panelMedIn > panelBottom-50) then panelMedIn := panelBottom-50;
2523	frmMeds.pnlBottom.Height := panelBottom;
2524	frmMeds.pnlMedIn.Height := panelMedIn;
2525	//Meds Tab Non-VA meds columns
2526	SetUserColumns(TControl(hdrMedsNonVA)); //CQ7314
2527	end;
2528
2529	frmCover.DisableAlign;
2530	try
2531	SetUserBounds2(CoverSplitters1, s1, s2, s3, s4);
2532	if s1 > 0 then
2533	frmCover.pnl_1.Width := LowerOf( frmCover.pnl_not3.ClientWidth - 5, s1);
2534	if s2 > 0 then
2535	frmCover.pnl_3.Width := LowerOf( frmCover.pnlTop.ClientWidth - 5, s2);
2536	if s3 > 0 then
2537	frmCover.pnlTop.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s3);
2538	if s4 > 0 then
2539	frmCover.pnl_4.Width := LowerOf( frmCover.pnlMiddle.ClientWidth - 5, s4);
2540
2541	SetUserBounds2(CoverSplitters2, s1, s2, s3, Dummy);
2542	if s1 > 0 then
2543	frmCover.pnlBottom.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s1);
2544	if s2 > 0 then
2545	frmCover.pnl_6.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s2);
2546	if s3 > 0 then
2547	frmCover.pnl_8.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s3);
2548
2549	finally
2550	frmCover.EnableAlign;
2551	end;
2552	if ParamSearch('rez') = '640' then SetBounds(Left, Top, 648, 488); // for testing
2553	end;
2554
2555	procedure TfrmFrame.SaveSizesForUser;
2556	var
2557	SizeList: TStringList;
2558	SurgTempHt: integer;
2559	begin
2560	SaveUserFontSize(MainFontSize);
2561	SizeList := TStringList.Create;
2562	try
2563	with SizeList do
2564	begin
2565	Add(StrUserBounds(frmFrame));
2566	Add(StrUserWidth(frmProblems.pnlLeft));
2567	//Add(StrUserWidth(frmMeds.pnlLeft));
2568	Add(StrUserWidth(frmOrders.pnlLeft));
2569	Add(StrUserWidth(frmNotes.pnlLeft));
2570	Add(StrUserWidth(frmConsults.pnlLeft));
2571	Add(StrUserWidth(frmDCSumm.pnlLeft));
2572	if Assigned(frmSurgery) then Add(StrUserWidth(frmSurgery.pnlLeft));
2573	Add(StrUserWidth(frmLabs.pnlLeft));
2574	Add(StrUserWidth(frmReports.pnlLeft));
2575	Add(StrUserColumns(frmOrders.hdrOrders));
2576	Add(StrUserColumns(frmMeds.hdrMedsIn));
2577	Add(StrUserColumns(frmMeds.hdrMedsOut));
2578	Add(StrUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight));
2579	Add(StrUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight));
2580	Add(StrUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, 0 ,0));
2581
2582	//v26.47 - RV - access violation if Surgery Tab not enabled. Set to designer height as default.
2583	if Assigned(frmSurgery) then SurgTempHt := frmSurgery.Drawers.pnlTemplates.Height else SurgTempHt := 85;
2584	Add(StrUserBounds2(DrawerSplitters, frmNotes.Drawers.LastOpenSize,
2585	frmConsults.Drawers.LastOpenSize,
2586	frmDCSumm.Drawers.LastOpenSize,
2587	SurgTempHt)); // last parameter = CQ7315
2588
2589	Add(StrUserBounds2(CoverSplitters1,
2590	frmCover.pnl_1.Width,
2591	frmCover.pnl_3.Width,
2592	frmCover.pnlTop.Height,
2593	frmCover.pnl_4.Width));
2594	Add(StrUserBounds2(CoverSplitters2,
2595	frmCover.pnlBottom.Height,
2596	frmCover.pnl_6.Width,
2597	frmCover.pnl_8.Width,
2598	0));
2599
2600	//Meds Tab Splitters
2601	Add(StrUserBounds2(frmMeds.Name+'Split',frmMeds.pnlBottom.Height,frmMeds.pnlMedIn.Height,0,0));
2602
2603	//Meds Tab Non-VA meds columns
2604	Add(StrUserColumns(fMeds.frmMeds.hdrMedsNonVA)); //CQ7314
2605
2606	//Orders Tab columns
2607	Add(StrUserColumns(fOrders.frmOrders.hdrOrders)); //CQ6328
2608
2609	if EnduringPtSelSplitterPos <> 0 then
2610	Add(StrUserBounds2('frmPtSel.sptVert', EnduringPtSelSplitterPos, 0, 0, 0));
2611	end;
2612	//Add sizes for forms that used SaveUserBounds() to save thier positions
2613	SizeHolder.AddSizesToStrList(SizeList);
2614	//Send the SizeList to the Database
2615	SaveUserSizes(SizeList);
2616	finally
2617	SizeList.Free;
2618	end;
2619	end;
2620
2621	procedure TfrmFrame.FormResize(Sender: TObject);
2622	{ need to resize tab forms specifically since they don't inherit resize event (because they
2623	are derived from TForm itself) }
2624	var i,index : integer; //kt
2625	begin
2626	if FTerminate or FClosing then Exit;
2627	if csDestroying in ComponentState then Exit;
2628	MoveWindow(frmCover.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2629	MoveWindow(frmProblems.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2630	MoveWindow(frmMeds.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2631	MoveWindow(frmOrders.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2632	MoveWindow(frmNotes.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2633	MoveWindow(frmConsults.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2634	MoveWindow(frmDCSumm.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2635	if Assigned(frmSurgery) then MoveWindow(frmSurgery.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2636	MoveWindow(frmLabs.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2637	MoveWindow(frmReports.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2638	for i := CT_WEBTAB1 to CT_LAST_WEBTAB do begin //kt added block.
2639	index := i-CT_WEBTAB1;
2640	if frmWebTabs[index]=nil then continue;
2641	tempFrmWebTab := TfrmWebTab(frmWebTabs[index]);
2642	if tempFrmWebTab <> nil then begin
2643	MoveWindow(tempFrmWebTab.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True); //kt
2644	end;
2645	end;
2646	//kt MoveWindow(frmWebTab1.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True); //kt
2647	with stsArea do
2648	begin
2649	Panels[1].Width := stsArea.Width - FFixedStatusWidth;
2650	FNextButtonL := Panels[0].Width + Panels[1].Width;
2651	FNextButtonR := FNextButtonL + Panels[2].Width;
2652	end;
2653	lstCIRNLocations.Left := FNextButtonL - ScrollBarWidth - 100;
2654	lstCIRNLocations.Width := ClientWidth - lstCIRNLocations.Left;
2655	Self.Repaint;
2656	end;
2657
2658	procedure TfrmFrame.ChangeFont(NewFontSize: Integer);
2659	{ Makes changes in all components whenever the font size is changed. This is hardcoded and
2660	based on MS Sans Serif for now, as only the font size may be selected. Courier New is used
2661	wherever non-proportional fonts are required. }
2662	const
2663	TAB_VOFFSET = 7;
2664	var
2665	OldFont: TFont;
2666	begin
2667	// Ho ho! ResizeAnchoredFormToFont(self) doesn't work here because the
2668	// Form size is aliased with MainFormSize.
2669	OldFont := TFont.Create;
2670	try
2671	DisableAlign;
2672	try
2673	OldFont.Assign(Font);
2674	with Self do Font.Size := NewFontSize;
2675	with lblPtName do Font.Size := NewFontSize; // must change BOLDED labels by hand
2676	with lblPtSSN do Font.Size := NewFontSize;
2677	with lblPtAge do Font.Size := NewFontSize;
2678	with lblPtLocation do Font.Size := NewFontSize;
2679	with lblPtProvider do Font.Size := NewFontSize;
2680	with lblPtPostings do Font.Size := NewFontSize;
2681	with lblPtCare do Font.Size := NewFontSize;
2682	with lblPtAttending do Font.Size := NewFontSize;
2683	with lblFlag do Font.Size := NewFontSize;
2684	with lblPtCWAD do Font.Size := NewFontSize;
2685	with lblCIRN do Font.Size := NewFontSize;
2686	with lblCIRNData do Font.Size := NewFontSize;
2687	with lstCIRNLocations do Font.Size := NewFontSize;
2688	with tabPage do Font.Size := NewFontSize;
2689	with laMHV do Font.Size := NewFontSize; //VAA
2690	with laVAA2 do Font.Size := NewFontSize; //VAA
2691
2692	tabPage.Height := MainFontHeight + TAB_VOFFSET; // resize tab selector
2693	FitToolbar; // resize toolbar
2694	stsArea.Font.Size := NewFontSize;
2695	stsArea.Height := MainFontHeight + TAB_VOFFSET;
2696	stsArea.Panels[0].Width := ResizeWidth( OldFont, Font, stsArea.Panels[0].Width);
2697	stsArea.Panels[2].Width := ResizeWidth( OldFont, Font, stsArea.Panels[2].Width);
2698
2699	//VAA CQ8271
2700	if ((fCover.PtIsVAA and fCover.PtIsMHV)) then
2701	begin
2702	laMHV.Height := (pnlToolBar.Height div 2) -1;
2703	with laVAA2 do
2704	begin
2705	Top := laMHV.Top + laMHV.Height;
2706	Height := (pnlToolBar.Height div 2) -1;
2707	end;
2708	end;
2709	//end VAA
2710
2711	RefreshFixedStatusWidth;
2712	FormResize( self );
2713	finally
2714	EnableAlign;
2715	end;
2716	finally
2717	OldFont.Free;
2718	end;
2719
2720	//remove CWAD color if using high-contrast colors
2721	if ColorToRGB(clWindowText) <> ColorToRGB(clBlack) then
2722	begin
2723	lblPtCWAD.Font.Color := clWindowText;
2724	lblFlag.Font.Color := clWindowText;
2725	end;
2726
2727	case (NewFontSize) of
2728	8: mnu8pt.Checked := true;
2729	10: mnu10pt1.Checked := true;
2730	12: mnu12pt1.Checked := true;
2731	14: mnu14pt1.Checked := true;
2732	18: mnu18pt1.Checked := true;
2733	24: mnu24pt1.Checked := true;
2734	end;
2735
2736	//Now that the form elements are resized, the pages will know what size to take.
2737	frmCover.SetFontSize(NewFontSize); // child pages lack a ParentFont property
2738	frmProblems.SetFontSize(NewFontSize);
2739	frmMeds.SetFontSize(NewFontSize);
2740	frmOrders.SetFontSize(NewFontSize);
2741	frmNotes.SetFontSize(NewFontSize);
2742	frmConsults.SetFontSize(NewFontSize);
2743	frmDCSumm.SetFontSize(NewFontSize);
2744	if Assigned(frmSurgery) then frmSurgery.SetFontSize(NewFontSize);
2745	frmLabs.SetFontSize(NewFontSize);
2746	frmReports.SetFontSize(NewFontSize);
2747	TfrmIconLegend.SetFontSize(NewFontSize);
2748	uOrders.SetFontSize(NewFontSize);
2749	if Assigned(frmRemDlg) then frmRemDlg.SetFontSize;
2750	if Assigned(frmReminderTree) then frmReminderTree.SetFontSize(NewFontSize);
2751	if Assigned(frmImages) then frmImages.SetFontSize(NewFontSize); //kt
2752	if GraphFloat <> nil then ResizeAnchoredFormToFont(GraphFloat);
2753	end;
2754
2755	procedure TfrmFrame.FitToolBar;
2756	{ resizes and repositions the panels & labels used in the toolbar }
2757	const
2758	PATIENT_WIDTH = 29;
2759	VISIT_WIDTH = 36;
2760	POSTING_WIDTH = 11.5;
2761	FLAG_WIDTH = 5;
2762	CIRN_WIDTH = 7;
2763	MHV_WIDTH = 6;
2764	LINES_HIGH = 2;
2765	M_HORIZ = 4;
2766	M_MIDDLE = 2;
2767	M_NVERT = 4;
2768	M_WVERT = 6;
2769	TINY_MARGIN = 2;
2770	//var
2771	//WidthNeeded: integer;
2772	begin
2773	pnlToolbar.Height := (LINES_HIGH * lblPtName.Height) + M_HORIZ + M_MIDDLE + M_HORIZ;
2774	pnlPatient.Width := HigherOf(PATIENT_WIDTH * MainFontWidth, lblPtName.Width + (M_WVERT * 2));
2775	lblPtSSN.Top := M_HORIZ + lblPtName.Height + M_MIDDLE;
2776	lblPtAge.Top := lblPtSSN.Top;
2777	lblPtAge.Left := pnlPatient.Width - lblPtAge.Width - M_WVERT;
2778	pnlVisit.Width := HigherOf(LowerOf(VISIT_WIDTH * MainFontWidth,
2779	HigherOf(lblPtProvider.Width + (M_WVERT * 2),
2780	lblPtLocation.Width + (M_WVERT * 2))),
2781	PATIENT_WIDTH * MainFontWidth);
2782	lblPtProvider.Top := lblPtSSN.Top;
2783	lblPtAttending.Top := lblPtSSN.Top;
2784	lblCIRNData.Top := lblPtSSN.Top;
2785	pnlPostings.Width := Round(POSTING_WIDTH * MainFontWidth);
2786	pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
2787	pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
2788	pnlCIRN.Width := Round(CIRN_WIDTH * MainFontWidth) + M_WVERT;
2789	paVAA.Width := Round(MHV_WIDTH * MainFontWidth) + M_WVERT;
2790	with lblPtPostings do
2791	SetBounds(M_WVERT, M_HORIZ, pnlPostings.Width-M_WVERT-M_WVERT, lblPtName.Height);
2792	with lblPtCWAD do
2793	SetBounds(M_WVERT, lblPtSSN.Top, lblPtPostings.Width, lblPtName.Height);
2794	//Low resolution handling: First, try to fit everything on by shrinking fields
2795	if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
2796	begin
2797	lblPtAge.Left := lblPtAge.Left - (lblPtName.Left - TINY_MARGIN);
2798	lblPtName.Left := TINY_MARGIN;
2799	lblPTSSN.Left := TINY_MARGIN;
2800	pnlPatient.Width := HigherOf( lblPtName.Left + lblPtName.Width, lblPtAge.Left + lblPtAge.Width)+ TINY_MARGIN;
2801	lblPtLocation.Left := TINY_MARGIN;
2802	lblPtProvider.Left := TINY_MARGIN;
2803	pnlVisit.Width := HigherOf( lblPtLocation.Left + lblPtLocation.Width, lblPtProvider.Left + lblPtProvider.Width)+ TINY_MARGIN;
2804	end;
2805	//If that is not enough, add scroll bars to form
2806	{if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
2807	begin
2808	WidthNeeded := HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN - pnlPrimaryCare.Width;
2809	HorzScrollBar.Range := ClientWidth + WidthNeeded;
2810	Width := Width + WidthNeeded;
2811	end
2812	else } // commented out - BA
2813	HorzScrollBar.Range := 0;
2814	end;
2815
2816	{ Temporary Calls -------------------------------------------------------------------------- }
2817
2818	procedure TfrmFrame.ToggleMenuItemChecked(Sender: TObject);
2819	begin
2820	with (Sender as TMenuItem) do
2821	begin
2822	if not Checked then
2823	Checked := true
2824	else
2825	Checked := false;
2826	end;
2827	end;
2828
2829	procedure TfrmFrame.mnuFontSizeClick(Sender: TObject);
2830	begin
2831	if (frmRemDlg <> nil) then
2832	// ShowMessage('Please close the reminder dialog before changing font sizes.') <-- original line. //kt 7/17/2007
2833	ShowMessage(DKLangConstW('fFrame_Please_close_the_reminder_dialog_before_changing_font_sizesx')) //kt added 7/17/2007
2834	else
2835	if (dlgProbs <> nil) then
2836	// ShowMessage('Font size cannot be changed while adding or editing a problem.') <-- original line. //kt 7/17/2007
2837	ShowMessage(DKLangConstW('fFrame_Font_size_cannot_be_changed_while_adding_or_editing_a_problemx')) //kt added 7/17/2007
2838	else
2839	begin
2840	with (Sender as TMenuItem) do
2841	begin
2842	ToggleMenuItemChecked(Sender);
2843	fMeds.oldFont := MainFontSize; //CQ9182
2844	ChangeFont(Tag);
2845	end;
2846	end;
2847	end;
2848
2849	procedure TfrmFrame.mnuEditClick(Sender: TObject);
2850	var
2851	IsReadOnly: Boolean;
2852	begin
2853	FEditCtrl := nil;
2854	if Screen.ActiveControl is TCustomEdit then FEditCtrl := TCustomEdit(Screen.ActiveControl);
2855	if FEditCtrl <> nil then
2856	begin
2857	if FEditCtrl is TMemo then IsReadOnly := TMemo(FEditCtrl).ReadOnly
2858	else if FEditCtrl is TEdit then IsReadOnly := TEdit(FEditCtrl).ReadOnly
2859	else if FEditCtrl is TRichEdit then IsReadOnly := TRichEdit(FEditCtrl).ReadOnly
2860	else IsReadOnly := True;
2861	mnuEditUndo.Enabled := FEditCtrl.Perform(EM_CANUNDO, 0, 0) <> 0;
2862	mnuEditCut.Enabled := FEditCtrl.SelLength > 0;
2863	mnuEditCopy.Enabled := mnuEditCut.Enabled;
2864	mnuEditPaste.Enabled := (IsReadOnly = False) and Clipboard.HasFormat(CF_TEXT);
2865	end else
2866	begin
2867	mnuEditUndo.Enabled := False;
2868	mnuEditCut.Enabled := False;
2869	mnuEditCopy.Enabled := False;
2870	mnuEditPaste.Enabled := False;
2871	end;
2872	end;
2873
2874	procedure TfrmFrame.mnuEditUndoClick(Sender: TObject);
2875	begin
2876	FEditCtrl.Perform(EM_UNDO, 0, 0);
2877	end;
2878
2879	procedure TfrmFrame.mnuEditCutClick(Sender: TObject);
2880	begin
2881	FEditCtrl.CutToClipboard;
2882	end;
2883
2884	procedure TfrmFrame.mnuEditCopyClick(Sender: TObject);
2885	begin
2886	FEditCtrl.CopyToClipboard;
2887	end;
2888
2889	procedure TfrmFrame.mnuEditPasteClick(Sender: TObject);
2890	begin
2891	FEditCtrl.SelText := Clipboard.AsText;
2892	//FEditCtrl.PasteFromClipboard; // use AsText to prevent formatting from being pasted
2893	end;
2894
2895	procedure TfrmFrame.mnuFilePrintClick(Sender: TObject);
2896	begin
2897	case mnuFilePrint.Tag of
2898	CT_NOTES: frmNotes.RequestPrint;
2899	CT_CONSULTS: frmConsults.RequestPrint;
2900	CT_DCSUMM: frmDCSumm.RequestPrint;
2901	CT_REPORTS: frmReports.RequestPrint;
2902	CT_LABS: frmLabs.RequestPrint;
2903	CT_ORDERS: frmOrders.RequestPrint;
2904	CT_PROBLEMS: frmProblems.RequestPrint;
2905	CT_SURGERY: if Assigned(frmSurgery) then frmSurgery.RequestPrint;
2906	CT_WEBTAB1..CT_LAST_WEBTAB: begin
2907	tempFrmWebTab := TfrmWebTab(frmWebTabs[mnuFilePrint.Tag-CT_WEBTAB1]);
2908	if tempFrmWebTab <> nil then tempFrmWebTab.RequestPrint;
2909	end;
2910	end;
2911	end;
2912
2913	function TfrmFrame.FormHelp(Command: Word; Data: Integer;
2914	var CallHelp: Boolean): Boolean;
2915	var
2916	ActiveForm: TForm;
2917	begin
2918	inherited;
2919	if Screen.ActiveForm <> nil then
2920	begin
2921	if Screen.ActiveForm.ActiveControl <> nil then
2922	begin
2923	if Screen.ActiveForm.ActiveControl is TForm then
2924	ActiveForm := TForm(Screen.ActiveForm.ActiveControl)
2925	else if Screen.ActiveForm.ActiveControl.Owner is TForm then
2926	ActiveForm := TForm(Screen.ActiveForm.ActiveControl.Owner)
2927	else
2928	ActiveForm := Screen.ActiveForm;
2929	end
2930	else
2931	ActiveForm := Screen.ActiveForm;
2932	HelpFile := ActiveForm.HelpFile;
2933	end ;
2934	Result := True;
2935	end;
2936
2937	procedure TfrmFrame.WMSysCommand(var Message: TMessage);
2938	begin
2939	case TabToPageID(tabPage.TabIndex) of
2940	CT_NOTES:
2941	if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2942	with Message do
2943	begin
2944	SendMessage(frmNotes.Handle, Msg, WParam, LParam);
2945	Result := 0;
2946	end
2947	else
2948	inherited;
2949	CT_DCSUMM:
2950	if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboAttending') then
2951	with Message do
2952	begin
2953	SendMessage(frmDCSumm.Handle, Msg, WParam, lParam);
2954	Result := 0;
2955	end
2956	else
2957	inherited;
2958	CT_CONSULTS:
2959	if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2960	with Message do
2961	begin
2962	SendMessage(frmConsults.Handle, Msg, WParam, lParam);
2963	Result := 0;
2964	end
2965	else
2966	inherited;
2967	else
2968	inherited;
2969	end;
2970	if Message.WParam = SC_MAXIMIZE then
2971	begin
2972	// form becomes maximized;
2973	frmOrders.mnuOptimizeFieldsClick(self);
2974	frmProblems.mnuOptimizeFieldsClick(self);
2975	frmMeds.mnuOptimizeFieldsClick(self);
2976	end
2977	else if Message.WParam = SC_MINIMIZE then
2978	begin
2979	// form becomes maximized;
2980	end
2981	else if Message.WParam = SC_RESTORE then
2982	begin
2983	// form is restored (from maximized);
2984	frmOrders.mnuOptimizeFieldsClick(self);
2985	frmProblems.mnuOptimizeFieldsClick(self);
2986	frmMeds.mnuOptimizeFieldsClick(self);
2987	end;
2988	end;
2989
2990	procedure TfrmFrame.RemindersChanged(Sender: TObject);
2991	var
2992	ImgName: string;
2993	begin
2994	pnlReminders.tag := HAVE_REMINDERS;
2995	//pnlReminders.Hint := 'Click to display reminders'; <-- original line. //kt 7/17/2007
2996	pnlReminders.Hint := DKLangConstW('fFrame_Click_to_display_reminders'); //kt added 7/17/2007
2997	case GetReminderStatus of
2998	rsUnknown:
2999	begin
3000	ImgName := 'BMP_REMINDERS_UNKNOWN';
3001	// pnlReminders.Caption := 'Reminders'; <-- original line. //kt 7/17/2007
3002	pnlReminders.Caption := DKLangConstW('fFrame_Reminders'); //kt added 7/17/2007
3003	end;
3004	rsDue:
3005	begin
3006	ImgName := 'BMP_REMINDERS_DUE';
3007	// pnlReminders.Caption := 'Due Reminders'; <-- original line. //kt 7/17/2007
3008	pnlReminders.Caption := DKLangConstW('fFrame_Due_Reminders'); //kt added 7/17/2007
3009	end;
3010	rsApplicable:
3011	begin
3012	ImgName := 'BMP_REMINDERS_APPLICABLE';
3013	// pnlReminders.Caption := 'Applicable Reminders'; <-- original line. //kt 7/17/2007
3014	pnlReminders.Caption := DKLangConstW('fFrame_Applicable_Reminders'); //kt added 7/17/2007
3015	end;
3016	rsNotApplicable:
3017	begin
3018	ImgName := 'BMP_REMINDERS_OTHER';
3019	// pnlReminders.Caption := 'Other Reminders'; <-- original line. //kt 7/17/2007
3020	pnlReminders.Caption := DKLangConstW('fFrame_Other_Reminders'); //kt added 7/17/2007
3021	end;
3022	else
3023	begin
3024	ImgName := 'BMP_REMINDERS_NONE';
3025	// pnlReminders.Hint := 'There are currently no reminders available'; <-- original line. //kt 7/17/2007
3026	pnlReminders.Hint := DKLangConstW('fFrame_There_are_currently_no_reminders_available'); //kt added 7/17/2007
3027	pnlReminders.Caption := pnlReminders.Hint;
3028	pnlReminders.tag := NO_REMINDERS;
3029	end;
3030	end;
3031	if(RemindersEvaluatingInBackground) then
3032	begin
3033	if(anmtRemSearch.ResName = '') then
3034	begin
3035	TORExposedAnimate(anmtRemSearch).OnMouseDown := pnlRemindersMouseDown;
3036	TORExposedAnimate(anmtRemSearch).OnMouseUp := pnlRemindersMouseUp;
3037	anmtRemSearch.ResHandle := 0;
3038	anmtRemSearch.ResName := 'REMSEARCHAVI';
3039	end;
3040	imgReminder.Visible := FALSE;
3041	anmtRemSearch.Active := TRUE;
3042	anmtRemSearch.Visible := TRUE;
3043	if(pnlReminders.Hint <> '') then
3044	pnlReminders.Hint := CRLF + pnlReminders.Hint + '.';
3045	// pnlReminders.Hint := 'Evaluating Reminders... ' + pnlReminders.Hint; <-- original line. //kt 7/17/2007
3046	pnlReminders.Hint := DKLangConstW('fFrame_Evaluating_Remindersxxx') + pnlReminders.Hint; //kt added 7/17/2007
3047	pnlReminders.Caption := pnlReminders.Hint;
3048	end
3049	else
3050	begin
3051	anmtRemSearch.Visible := FALSE;
3052	imgReminder.Visible := TRUE;
3053	imgReminder.Picture.Bitmap.LoadFromResourceName(hInstance, ImgName);
3054	anmtRemSearch.Active := FALSE;
3055	end;
3056	mnuViewReminders.Enabled := (pnlReminders.tag = HAVE_REMINDERS);
3057	end;
3058
3059	procedure TfrmFrame.pnlRemindersMouseDown(Sender: TObject;
3060	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3061	begin
3062	if(not InitialRemindersLoaded) then
3063	StartupReminders;
3064	if(pnlReminders.tag = HAVE_REMINDERS) then
3065	pnlReminders.BevelOuter := bvLowered;
3066	end;
3067
3068	procedure TfrmFrame.pnlRemindersMouseUp(Sender: TObject;
3069	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3070	begin
3071	pnlReminders.BevelOuter := bvRaised;
3072	if(pnlReminders.tag = HAVE_REMINDERS) then
3073	ViewInfo(mnuViewReminders);
3074	end;
3075
3076	//--------------------- CIRN-related procedures --------------------------------
3077
3078	procedure TfrmFrame.SetUpCIRN;
3079	var
3080	i: integer;
3081	aAutoQuery: string;
3082	ASite: TRemoteSite;
3083	begin
3084	with RemoteSites do
3085	if UseVistaWeb then
3086	begin
3087	ChangePatient(Patient.DFN);
3088	lblCIRN.Caption := 'Remote'; //VistaWeb On
3089	lblCIRNData.Caption := 'Data*';
3090	pnlCIRN.Caption := 'Remote Data';
3091	lblCIRN.Width := 43;
3092	lblCIRNData.Width := 43;
3093	lblCIRNData.Alignment := taCenter;
3094	lblCIRN.Alignment := taCenter;
3095	lblCIRN.Enabled := True;
3096	lblCIRNData.Enabled := True;
3097	lblCIRNAvail.Enabled := True;
3098	pnlCIRN.TabStop := True;
3099	if RemoteDataExists and (RemoteSites.Count > 0) then
3100	begin
3101	lblCIRN.Enabled := True;
3102	lblCIRNData.Enabled := True;
3103	lblCIRNAvail.Enabled := True;
3104	pnlCIRN.TabStop := True;
3105	if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
3106	begin
3107	lblCIRN.Font.Color := clBlue;
3108	lblCIRNData.Font.Color := clBlue;
3109	lblCIRNAvail.Font.Color := clBlue;
3110	lstCIRNLocations.Font.Color := clBlue;
3111	lblCIRN.Caption := 'Remote';
3112	lblCIRNData.Caption := 'Data*';
3113	lblCIRNAvail.Caption := 'Available';
3114	pnlCIRN.Caption := 'Remote Data Available';
3115	end
3116	else
3117	begin
3118	lblCIRN.Font.Color := clWindowText;
3119	lblCIRNData.Font.Color := clWindowText;
3120	lblCIRNAvail.Font.Color := clWindowText;
3121	lstCIRNLocations.Font.Color := clWindowText;
3122	end;
3123	end
3124	else
3125	begin
3126	lblCIRN.Font.Color := clWindowText;
3127	lblCIRNData.Font.Color := clWindowText;
3128	lblCIRNAvail.Font.Color := clWindowText;
3129	lblCIRN.Enabled := False;
3130	lblCIRNData.Enabled := False;
3131	lblCIRNAvail.Enabled := False;
3132	pnlCIRN.TabStop := False;
3133	pnlCIRN.Hint := NoDataReason;
3134	end;
3135	// pnlCIRN.Hint := 'Click to open VistaWeb'; <-- original line. //kt 7/17/2007
3136	pnlCIRN.Hint := DKLangConstW('fFrame_Click_to_open_VistaWeb'); //kt added 7/17/2007
3137	end
3138	else
3139	begin
3140	ChangePatient(Patient.DFN);
3141	lblCIRN.Caption := ' Remote';
3142	lblCIRNData.Caption := 'Data';
3143	pnlCIRN.Caption := 'Remote Data';
3144	lblCIRNAvail.Caption := '';
3145	lblCIRN.Width := 43;
3146	lblCIRNData.Width := 43;
3147	lblCIRNData.Alignment := taCenter;
3148	lblCIRN.Alignment := taCenter;
3149	if RemoteDataExists and (RemoteSites.Count > 0) then
3150	begin
3151	lblCIRN.Enabled := True;
3152	lblCIRNData.Enabled := True;
3153	lblCIRNAvail.Enabled := True;
3154	pnlCIRN.TabStop := True;
3155	if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
3156	begin
3157	lblCIRN.Font.Color := clBlue;
3158	lblCIRNData.Font.Color := clBlue;
3159	lblCIRNAvail.Font.Color := clBlue;
3160	lstCIRNLocations.Font.Color := clBlue;
3161	lblCIRN.Caption := 'Remote';
3162	lblCIRNData.Caption := 'Data';
3163	lblCIRNAvail.Caption := 'Available';
3164	pnlCIRN.Caption := 'Remote Data Available';
3165	end
3166	else
3167	begin
3168	lblCIRN.Font.Color := clWindowText;
3169	lblCIRNData.Font.Color := clWindowText;
3170	lblCIRNAvail.Font.Color := clWindowText;
3171	lstCIRNLocations.Font.Color := clWindowText;
3172	lblCIRNAvail.Color := clWindowText;
3173	end;
3174	// pnlCIRN.Hint := 'Click to display other facilities having data for this patient.'; <-- original line. //kt 7/17/2007
3175	pnlCIRN.Hint := DKLangConstW('fFrame_Click_to_display_other_facilities_having_data_for_this_patientx'); //kt added 7/17/2007
3176	// lstCIRNLocations.Items.Add('-1' + U + 'Use VistaWeb from now on'); <-- original line. //kt 7/17/2007
3177	lstCIRNLocations.Items.Add('-1' + U + DKLangConstW('fFrame_Use_VistaWeb_from_now_on')); //kt added 7/17/2007
3178	if RemoteSites.Count > 0 then
3179	// lstCIRNLocations.Items.Add('0' + U + 'All Available Sites'); <-- original line. //kt 7/17/2007
3180	lstCIRNLocations.Items.Add('0' + U + DKLangConstW('fFrame_All_Available_Sites')); //kt added 7/17/2007
3181	for i := 0 to RemoteSites.Count - 1 do
3182	begin
3183	ASite := TRemoteSite(SiteList[i]);
3184	lstCIRNLocations.Items.Add(ASite.SiteID + U + ASite.SiteName + U +
3185	FormatFMDateTime('mmm dd yyyy hh:nn', ASite.LastDate));
3186	end;
3187	end
3188	else
3189	begin
3190	lblCIRN.Font.Color := clWindowText;
3191	lblCIRNData.Font.Color := clWindowText;
3192	lblCIRNAvail.Font.Color := clWindowText;
3193	lblCIRN.Enabled := False;
3194	lblCIRNData.Enabled := False;
3195	lblCIRNAvail.Enabled := False;
3196	pnlCIRN.TabStop := False;
3197	pnlCIRN.Hint := NoDataReason;
3198	end;
3199	aAutoQuery := AutoRDV; //Check to see if Remote Queries should be used for all available sites
3200	if (aAutoQuery = '1') and (lstCIRNLocations.Count > 0) then
3201	begin
3202	lstCIRNLocations.ItemIndex := 1;
3203	lstCIRNLocations.Checked[1] := true;
3204	lstCIRNLocationsClick(self);
3205	end;
3206	end;
3207	end;
3208
3209	procedure TfrmFrame.pnlCIRNClick(Sender: TObject);
3210	//var
3211	// aAddress: string;
3212	begin
3213	{if UseVistaWeb then
3214	begin
3215	pnlCIRN.BevelOuter := bvRaised;
3216	pnlCIRN.Hint := 'Click to open VistaWeb';
3217	lblCIRN.Width := 43;
3218	lblCIRNData.Width := 43;
3219	lblCIRNData.Alignment := taCenter;
3220	lblCIRN.Alignment := taCenter;
3221	lstCIRNLocations.Visible := false;
3222	lstCIRNLocations.SendToBack;
3223	aAddress := GetVistaWebAddress(Patient.DFN);
3224	ShellExecute(Handle, 'open', PChar(aAddress), PChar(''), '', SW_NORMAL);
3225	Exit;
3226	end;
3227	if not RemoteSites.RemoteDataExists then Exit;
3228	if (not lstCIRNLocations.Visible) then
3229	begin
3230	pnlCIRN.BevelOuter := bvLowered;
3231	lstCIRNLocations.Visible := True;
3232	lstCIRNLocations.BringToFront;
3233	lstCIRNLocations.SetFocus;
3234	pnlCIRN.Hint := 'Click to close list.';
3235	end
3236	else
3237	begin
3238	pnlCIRN.BevelOuter := bvRaised;
3239	lstCIRNLocations.Visible := False;
3240	lstCIRNLocations.SendToBack;
3241	pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
3242	end }
3243	ViewInfo(mnuViewRemoteData);
3244	end;
3245
3246	procedure TfrmFrame.lstCIRNLocationsClick(Sender: TObject);
3247	const
3248	DGSR_FAIL = -1;
3249	DGSR_NONE = 0;
3250	DGSR_SHOW = 1;
3251	DGSR_ASK = 2;
3252	DGSR_DENY = 3;
3253	var
3254	iIndex,j,iAll,iCur: integer;
3255	aMsg,s: string;
3256	AccessStatus: integer;
3257	begin
3258	iAll := 1;
3259	AccessStatus := 0;
3260	iIndex := lstCIRNLocations.ItemIndex;
3261	if iIndex = 0 then
3262	if (piece(lstCIRNLocations.Items[0],'^',1) = '-1') and (lstCIRNLocations.Checked[iIndex] = true) then
3263	begin
3264	// if MessageDlg('Are you sure you want to make VistaWeb your default for viewing Remote Data?', <-- original line. //kt 7/17/2007
3265	if MessageDlg(DKLangConstW('fFrame_Are_you_sure_you_want_to_make_VistaWeb_your_default_for_viewing_Remote_Datax'), //kt added 7/17/2007
3266	mtConfirmation, [mbYes, mbNo], 0) = mrYes then
3267	begin
3268	ChangeVistaWebParam('1');
3269	lblCIRN.Caption := 'Remote'; //VistaWeb On
3270	lblCIRNData.Caption := 'Data*';
3271	pnlCIRN.Caption := 'Remote Data';
3272	lblCIRNAvail.Caption := '';
3273	lblCIRN.Width := 43;
3274	lblCIRNData.Width := 43;
3275	lblCIRNData.Alignment := taCenter;
3276	lblCIRN.Alignment := taCenter;
3277	with RemoteSites do if RemoteDataExists and (RemoteSites.Count > 0) then
3278	begin
3279	lblCIRN.Enabled := True;
3280	lblCIRNData.Enabled := True;
3281	pnlCIRN.TabStop := True;
3282	if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
3283	begin
3284	lblCIRN.Font.Color := clBlue;
3285	lblCIRNData.Font.Color := clBlue;
3286	lstCIRNLocations.Font.Color := clBlue;
3287	lblCIRN.Caption := 'Remote';
3288	lblCIRNData.Caption := 'Data*';
3289	lblCIRNAvail.Caption := 'Available';
3290	pnlCIRN.Caption := 'Remote Data Available';
3291	end
3292	else
3293	begin
3294	lblCIRN.Font.Color := clWindowText;
3295	lblCIRNData.Font.Color := clWindowText;
3296	lstCIRNLocations.Font.Color := clWindowText;
3297	lblCIRNAvail.Font.Color := clWindowText;
3298	end;
3299	end;
3300	pnlCIRNClick(self);
3301	Exit;
3302	end
3303	else
3304	lstCIRNLocations.Checked[iIndex] := false;
3305	end
3306	else
3307	begin
3308	ChangeVistaWebParam('0');
3309	lblCIRN.Caption := 'Remote';
3310	lblCIRNData.Caption := 'Data';
3311	pnlCIRN.Caption := 'Remote Data';
3312	lblCIRN.Width := 43;
3313	lblCIRNData.Width := 43;
3314	lblCIRNData.Alignment := taCenter;
3315	lblCIRN.Alignment := taCenter;
3316	pnlCIRNClick(self);
3317	Exit;
3318	end;
3319	if not CheckHL7TCPLink then
3320	begin
3321	// InfoBox('Local HL7 TCP Link is down.' + CRLF + 'Unable to retrieve remote data.', TC_DGSR_ERR, MB_OK); <-- original line. //kt 7/17/2007
3322	InfoBox(DKLangConstW('fFrame_Local_HL7_TCP_Link_is_downx') + CRLF + DKLangConstW('fFrame_Unable_to_retrieve_remote_datax'), TC_DGSR_ERR, MB_OK); //kt added 7/17/2007
3323	lstCIRNLocations.Checked[iIndex] := false;
3324	Exit;
3325	end;
3326	if lstCIRNLocations.Items.Count > 1 then
3327	if piece(lstCIRNLocations.Items[1],'^',1) = '0' then
3328	iAll := 2;
3329	with frmReports do
3330	if piece(uRemoteType,'^',2) = 'V' then
3331	begin
3332	lvReports.Items.BeginUpdate;
3333	lvReports.Items.Clear;
3334	lvReports.Columns.Clear;
3335	lvReports.Items.EndUpdate;
3336	end;
3337	uReportInstruction := '';
3338	frmReports.TabControl1.Tabs.Clear;
3339	frmLabs.TabControl1.Tabs.Clear;
3340	frmReports.TabControl1.Tabs.AddObject('Local',nil);
3341	frmLabs.TabControl1.Tabs.AddObject('Local',nil);
3342	//StatusText('Checking Remote Sites...'); <-- original line. //kt 7/17/2007
3343	StatusText(DKLangConstW('fFrame_Checking_Remote_Sitesxxx')); //kt added 7/17/2007
3344	if piece(lstCIRNLocations.Items[iIndex],'^',1) = '0' then // All sites have been clicked
3345	if lstCIRNLocations.Checked[iIndex] = false then // All selection is being turned off
3346	begin
3347	with RemoteSites.SiteList do
3348	for j := 0 to Count - 1 do
3349	if lstCIRNLocations.Checked[j+2] = true then
3350	begin
3351	lstCIRNLocations.Checked[j+2] := false;
3352	TRemoteSite(RemoteSites.SiteList[j]).Selected := false;
3353	TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3354	TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3355	end;
3356	end
3357	else
3358	begin
3359	with RemoteSites.SiteList do
3360	for j := 0 to Count - 1 do
3361	begin
3362	Screen.Cursor := crAppStart; //kt crHourGlass;
3363	{CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[j]).SiteID,
3364	AccessStatus);}
3365	Screen.Cursor := crDefault;
3366	// aMsg := aMsg + ' at site: ' + TRemoteSite(Items[j]).SiteName; <-- original line. //kt 7/17/2007
3367	aMsg := aMsg + DKLangConstW('fFrame_at_sitex') + TRemoteSite(Items[j]).SiteName; //kt added 7/17/2007
3368	s := lstCIRNLocations.Items[j+2];
3369	lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3);
3370	case AccessStatus of
3371	DGSR_FAIL: begin
3372	// if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility <-- original line. //kt 7/17/2007
3373	if piece(aMsg,':',1) = DKLangConstW('fFrame_RPC_name_not_found_at_site') then //Allow for backward compatibility //kt added 7/17/2007
3374	begin
3375	lstCIRNLocations.Checked[j+2] := true;
3376	TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3377	TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3378	TRemoteSite(Items[j]).Selected := true;
3379	end
3380	else
3381	begin
3382	InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
3383	lstCIRNLocations.Checked[j+2] := false;
3384	lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
3385	TRemoteSite(Items[j]).Selected := false;
3386	Continue;
3387	end;
3388	end;
3389	DGSR_NONE: begin
3390	lstCIRNLocations.Checked[j+2] := true;
3391	TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3392	TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3393	TRemoteSite(Items[j]).Selected := true;
3394	end;
3395	DGSR_SHOW: begin
3396	InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
3397	lstCIRNLocations.Checked[j+2] := true;
3398	TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3399	TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3400	TRemoteSite(Items[j]).Selected := true;
3401	end;
3402	DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
3403	MB_DEFBUTTON2) = IDYES then
3404	begin
3405	lstCIRNLocations.Checked[j+2] := true;
3406	TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3407	TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3408	TRemoteSite(Items[j]).Selected := true;
3409	end
3410	else
3411	begin
3412	lstCIRNLocations.Checked[j+2] := false;
3413	lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
3414	TRemoteSite(Items[j]).Selected := false;
3415	Continue;
3416	end;
3417	else begin
3418	InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
3419	lstCIRNLocations.Checked[j+2] := false;
3420	lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
3421	TRemoteSite(Items[j]).Selected := false;
3422	Continue;
3423	end;
3424	end;
3425	end;
3426	end
3427	else
3428	begin
3429	if iIndex > 0 then
3430	begin
3431	iCur := iIndex - iAll;
3432	TRemoteSite(RemoteSites.SiteList[iCur]).Selected :=
3433	lstCIRNLocations.Checked[iIndex];
3434	if lstCIRNLocations.Checked[iIndex] = true then
3435	with RemoteSites.SiteList do
3436	begin
3437	Screen.Cursor := crAppStart; //kt crHourGlass;
3438	{CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[iCur]).SiteID,
3439	AccessStatus);}
3440	Screen.Cursor := crDefault;
3441	// aMsg := aMsg + ' at site: ' + TRemoteSite(Items[iCur]).SiteName; <-- original line. //kt 7/17/2007
3442	aMsg := aMsg + DKLangConstW('fFrame_at_sitex') + TRemoteSite(Items[iCur]).SiteName; //kt added 7/17/2007
3443	s := lstCIRNLocations.Items[iIndex];
3444	lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3);
3445	case AccessStatus of
3446	DGSR_FAIL: begin
3447	// if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility <-- original line. //kt 7/17/2007
3448	if piece(aMsg,':',1) = DKLangConstW('fFrame_RPC_name_not_found_at_site') then //Allow for backward compatibility //kt added 7/17/2007
3449	begin
3450	lstCIRNLocations.Checked[iIndex] := true;
3451	TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3452	TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3453	TRemoteSite(Items[iCur]).Selected := true;
3454	end
3455	else
3456	begin
3457	InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
3458	lstCIRNLocations.Checked[iIndex] := false;
3459	lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
3460	TRemoteSite(Items[iCur]).Selected := false;
3461	end;
3462	end;
3463	DGSR_NONE: begin
3464	lstCIRNLocations.Checked[iIndex] := true;
3465	TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3466	TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3467	TRemoteSite(Items[iCur]).Selected := true;
3468	end;
3469	DGSR_SHOW: begin
3470	InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
3471	lstCIRNLocations.Checked[iIndex] := true;
3472	TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3473	TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3474	TRemoteSite(Items[iCur]).Selected := true;
3475	end;
3476	DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
3477	MB_DEFBUTTON2) = IDYES then
3478	begin
3479	lstCIRNLocations.Checked[iIndex] := true;
3480	TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3481	TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3482	TRemoteSite(Items[iCur]).Selected := true;
3483	end
3484	else
3485	begin
3486	lstCIRNLocations.Checked[iIndex] := false;
3487	lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
3488	end;
3489	else begin
3490	InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
3491	lstCIRNLocations.Checked[iIndex] := false;
3492	lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
3493	TRemoteSite(Items[iCur]).Selected := false;
3494	end;
3495	end;
3496	with frmReports do
3497	if piece(uRemoteType,'^',1) = '1' then
3498	if not(piece(uRemoteType,'^',2) = 'V') then
3499	begin
3500	TabControl1.Visible := true;
3501	pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3502	end;
3503	with frmLabs do
3504	if lstReports.ItemIndex > -1 then
3505	if piece(lstReports.Items[lstReports.ItemIndex],'^',3) = '1' then
3506	if not(piece(lstReports.Items[lstReports.ItemIndex],'^',5) = 'V') then
3507	TabControl1.Visible := true;
3508	end;
3509	end;
3510	end;
3511	with RemoteSites.SiteList do
3512	for j := 0 to Count - 1 do
3513	if TRemoteSite(Items[j]).Selected then
3514	begin
3515	frmReports.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3516	TRemoteSite(Items[j]));
3517	frmLabs.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3518	TRemoteSite(Items[j]));
3519	end;
3520	//frmLabs.TabControl1.OnChange(nil);
3521	//frmReports.TabControl1.OnChange(nil);
3522	if frmReports.tvReports.SelectionCount > 0 then frmReports.tvReportsClick(self);
3523	if frmLabs.lstReports.ItemIndex > -1 then frmLabs.ExtlstReportsClick(self, true);
3524	StatusText('');
3525	end;
3526
3527	procedure TfrmFrame.popCIRNCloseClick(Sender: TObject);
3528	begin
3529	lstCIRNLocations.Visible := False;
3530	lstCirnLocations.SendToBack;
3531	pnlCIRN.BevelOuter := bvRaised;
3532	end;
3533
3534	procedure TfrmFrame.popCIRNSelectAllClick(Sender: TObject);
3535
3536	begin
3537	lstCIRNLocations.ItemIndex := 0;
3538	lstCIRNLocations.Checked[0] := true;
3539	lstCIRNLocations.OnClick(Self);
3540	end;
3541
3542	procedure TfrmFrame.popCIRNSelectNoneClick(Sender: TObject);
3543
3544	begin
3545	lstCIRNLocations.ItemIndex := 0;
3546	lstCIRNLocations.Checked[0] := false;
3547	lstCIRNLocations.OnClick(Self);
3548	end;
3549
3550	procedure TfrmFrame.mnuFilePrintSetupClick(Sender: TObject);
3551	var
3552	CurrPrt: string;
3553	begin
3554	CurrPrt := SelectDevice(Self, Encounter.Location, True,'');
3555	User.CurrentPrinter := Piece(CurrPrt, U, 1);
3556	end;
3557
3558	procedure TfrmFrame.lstCIRNLocationsChange(Sender: TObject);
3559	begin
3560	if lstCIRNLocations.ItemIndex > 0 then
3561	if (lstCIRNLocations.Selected[lstCIRNLocations.ItemIndex] = true) and (uUpdateStat = false) then
3562	if not (piece(lstCIRNLocations.Items[1],'^',1) = '0') then
3563	lstCIRNLocations.OnClick(nil);
3564	end;
3565
3566	procedure TfrmFrame.LabInfo1Click(Sender: TObject);
3567	begin
3568	ExecuteLabInfo;
3569	end;
3570
3571	procedure TfrmFrame.mnuFileNotifRemoveClick(Sender: TObject);
3572	//const
3573	//TC_REMOVE_ALERT = 'Remove Current Alert'; <-- original line. //kt 7/17/2007
3574	//TX_REMOVE_ALERT1 = 'This action will delete the alert you are currently processing; the alert will ' + CRLF + <-- original line. //kt 7/17/2007
3575	// 'disappear automatically when all orders have been acted on, but this action may' + CRLF + <-- original line. //kt 7/17/2007
3576	// 'be used to remove the alert if some orders are to be left unchanged.' + CRLF + CRLF + <-- original line. //kt 7/17/2007
3577	// 'Your '; <-- original line. //kt 7/17/2007
3578	//TX_REMOVE_ALERT2 = ' alert for '; <-- original line. //kt 7/17/2007
3579	//TX_REMOVE_ALERT3 = ' will be deleted!' + CRLF + CRLF + 'Are you sure?'; <-- original line. //kt 7/17/2007
3580	var
3581	AlertMsg, AlertType: string;
3582	TC_REMOVE_ALERT : string;
3583	TX_REMOVE_ALERT1 : string;
3584	TX_REMOVE_ALERT2 : string;
3585	TX_REMOVE_ALERT3 : string;
3586
3587	procedure StopProcessingNotifs;
3588	begin
3589	Notifications.Clear;
3590	FNextButtonActive := False;
3591	stsArea.Panels[2].Bevel := pbLowered;
3592	mnuFileNext.Enabled := False;
3593	mnuFileNotifRemove.Enabled := False;
3594	end;
3595
3596	begin
3597	TC_REMOVE_ALERT := DKLangConstW('fFrame_Remove_Current_Alert'); //kt added 7/17/2007
3598	TX_REMOVE_ALERT1 := DKLangConstW('fFrame_This_action_will_delete_the_alert_you_are_currently_processingx_the_alert_will') + CRLF + //kt added 7/17/2007
3599	DKLangConstW('fFrame_disappear_automatically_when_all_orders_have_been_acted_onx_but_this_action_may') + CRLF + //kt added 7/17/2007
3600	DKLangConstW('fFrame_be_used_to_remove_the_alert_if_some_orders_are_to_be_left_unchangedx') + CRLF + CRLF + //kt added 7/17/2007
3601	DKLangConstW('fFrame_Your'); //kt added 7/17/2007
3602	TX_REMOVE_ALERT2 := DKLangConstW('fFrame_alert_for'); //kt added 7/17/2007
3603	TX_REMOVE_ALERT3 := DKLangConstW('fFrame_will_be_deletedx') + CRLF + CRLF + DKLangConstW('fFrame_Are_you_surex'); //kt added 7/17/2007
3604
3605	if not Notifications.Active then Exit;
3606	case Notifications.Followup of
3607	// NF_MEDICATIONS_EXPIRING_INPT : AlertType := 'Expiring Medications'; <-- original line. //kt 7/17/2007
3608	NF_MEDICATIONS_EXPIRING_INPT : AlertType := DKLangConstW('fFrame_Expiring_Medications'); //kt added 7/17/2007
3609	// NF_MEDICATIONS_EXPIRING_OUTPT : AlertType := 'Expiring Medications'; <-- original line. //kt 7/17/2007
3610	NF_MEDICATIONS_EXPIRING_OUTPT : AlertType := DKLangConstW('fFrame_Expiring_Medications'); //kt added 7/17/2007
3611	// NF_ORDER_REQUIRES_ELEC_SIGNATURE: AlertType := 'Unsigned Orders'; <-- original line. //kt 7/17/2007
3612	NF_ORDER_REQUIRES_ELEC_SIGNATURE: AlertType := DKLangConstW('fFrame_Unsigned_Orders'); //kt added 7/17/2007
3613	// NF_FLAGGED_ORDERS : AlertType := 'Flagged Orders (for clarification)'; <-- original line. //kt 7/17/2007
3614	NF_FLAGGED_ORDERS : AlertType := DKLangConstW('fFrame_Flagged_Orders_xfor_clarificationx'); //kt added 7/17/2007
3615	// NF_UNVERIFIED_MEDICATION_ORDER : AlertType := 'Unverified Medication Order'; <-- original line. //kt 7/17/2007
3616	NF_UNVERIFIED_MEDICATION_ORDER : AlertType := DKLangConstW('fFrame_Unverified_Medication_Order'); //kt added 7/17/2007
3617	// NF_UNVERIFIED_ORDER : AlertType := 'Unverified Order'; <-- original line. //kt 7/17/2007
3618	NF_UNVERIFIED_ORDER : AlertType := DKLangConstW('fFrame_Unverified_Order'); //kt added 7/17/2007
3619	// NF_FLAGGED_OI_EXP_INPT : AlertType := 'Flagged Orderable Item (INPT)'; <-- original line. //kt 7/17/2007
3620	NF_FLAGGED_OI_EXP_INPT : AlertType := DKLangConstW('fFrame_Flagged_Orderable_Item_xINPTx'); //kt added 7/17/2007
3621	// NF_FLAGGED_OI_EXP_OUTPT : AlertType := 'Flagged Orderable Item (OUTPT)'; <-- original line. //kt 7/17/2007
3622	NF_FLAGGED_OI_EXP_OUTPT : AlertType := DKLangConstW('fFrame_Flagged_Orderable_Item_xOUTPTx'); //kt added 7/17/2007
3623	else
3624	Exit;
3625	end;
3626	AlertMsg := TX_REMOVE_ALERT1 + AlertType + TX_REMOVE_ALERT2 + Patient.Name + TX_REMOVE_ALERT3;
3627	if InfoBox(AlertMsg, TC_REMOVE_ALERT, MB_YESNO) = ID_YES then
3628	begin
3629	Notifications.DeleteForCurrentUser;
3630	Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
3631	if Notifications.Active then
3632	begin
3633	if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
3634	begin
3635	Notifications.Prior;
3636	mnuFileNextClick(Self);
3637	end
3638	else
3639	StopProcessingNotifs;
3640	end
3641	else
3642	StopProcessingNotifs;
3643	end;
3644	end;
3645
3646	procedure TfrmFrame.mnuToolsOptionsClick(Sender: TObject);
3647	// personal preferences - changes may need to be applied to chart
3648	var
3649	i: integer;
3650	begin
3651	i := 0;
3652	DialogOptions(i);
3653	end;
3654
3655	procedure TfrmFrame.LoadUserPreferences;
3656	begin
3657	LoadSizesForUser;
3658	// LoadUserVitalPreferences;
3659	GetUserTemplateDefaults(TRUE);
3660	end;
3661
3662	procedure TfrmFrame.SaveUserPreferences;
3663	begin
3664	SaveSizesForUser; // position & size settings
3665	// SaveUserVitalPreferences; // save Vitals metric setting
3666	SaveUserTemplateDefaults;
3667	end;
3668
3669	procedure TfrmFrame.mnuFileRefreshClick(Sender: TObject);
3670	begin
3671	FRefreshing := TRUE;
3672	try
3673	mnuFileOpenClick(Self);
3674	finally
3675	FRefreshing := FALSE;
3676	end;
3677	end;
3678
3679	procedure TfrmFrame.AppActivated(Sender: TObject);
3680	begin
3681	if assigned(FOldActivate) then
3682	FOldActivate(Sender);
3683	SetActiveWindow(Application.Handle);
3684	end;
3685
3686	// close Treatment Factor hint window if alt-tab pressed.
3687	procedure TfrmFrame.AppDeActivated(Sender: TObject);
3688	begin
3689	if FRVTFhintWindowActive then
3690	begin
3691	FRVTFHintWindow.ReleaseHandle;
3692	FRVTFHintWindowActive := False;
3693	end
3694	else
3695	if FOSTFHintWndActive then
3696	begin
3697	FOSTFhintWindow.ReleaseHandle;
3698	FOSTFHintWndActive := False ;
3699	end;
3700	if FHintWinActive then // graphing - hints on values
3701	begin
3702	FHintWin.ReleaseHandle;
3703	FHintWinActive := false;
3704	end;
3705	end;
3706
3707	(*procedure TfrmFrame.CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
3708	begin
3709	AnInstance := TPage.Create(Self);
3710	TPage(AnInstance).Parent := pnlPage;
3711	TPage(AnInstance).Show;
3712	uTabList.Add(IntToStr(ATabID));
3713	tabPage.Tabs.Add(ALabel);
3714	end;*)
3715
3716	procedure TfrmFrame.CreateTab(ATabID: integer; ALabel: string);
3717	var TempFrmWebTab : TfrmWebTab; //kt added
3718	begin
3719	// old comment - try making owner self (instead of application) to see if solves TMenuItem.Insert bug
3720	case ATabID of
3721	CT_PROBLEMS : begin
3722	frmProblems := TfrmProblems.Create(Self);
3723	frmProblems.Parent := pnlPage;
3724	end;
3725	CT_MEDS : begin
3726	frmMeds := TfrmMeds.Create(Self);
3727	frmMeds.Parent := pnlPage;
3728	frmMeds.InitfMedsSize;
3729	end;
3730	CT_ORDERS : begin
3731	frmOrders := TfrmOrders.Create(Self);
3732	frmOrders.Parent := pnlPage;
3733	end;
3734	CT_HP : begin
3735	// not yet
3736	end;
3737	CT_NOTES : begin
3738	frmNotes := TfrmNotes.Create(Self);
3739	frmNotes.Parent := pnlPage;
3740	end;
3741	CT_CONSULTS : begin
3742	frmConsults := TfrmConsults.Create(Self);
3743	frmConsults.Parent := pnlPage;
3744	end;
3745	CT_DCSUMM : begin
3746	frmDCSumm := TfrmDCSumm.Create(Self);
3747	frmDCSumm.Parent := pnlPage;
3748	end;
3749	CT_LABS : begin
3750	frmLabs := TfrmLabs.Create(Self);
3751	frmLabs.Parent := pnlPage;
3752	end;
3753	CT_REPORTS : begin
3754	frmReports := TfrmReports.Create(Self);
3755	frmReports.Parent := pnlPage;
3756	end;
3757	CT_SURGERY : begin
3758	frmSurgery := TfrmSurgery.Create(Self);
3759	frmSurgery.Parent := pnlPage;
3760	end;
3761	CT_COVER : begin
3762	frmCover := TfrmCover.Create(Self);
3763	frmCover.Parent := pnlPage;
3764	end;
3765	CT_WEBTAB1..CT_LAST_WEBTAB : begin //kt added 6/6/08
3766	TempFrmWebTab := TfrmWebTab.Create(Self); //kt 6/6/08
3767	TempFrmWebTab.WebBrowser.Navigate('about:blank');
3768	TempFrmWebTab.Parent := pnlPage; //kt 6/6/08
3769	frmWebTabs[ATabID-CT_WEBTAB1] := TempFrmWebTab
3770	end; //kt 6/6/08
3771
3772	{ //kt replace later
3773	CT_IMAGES : begin //kt 8/19/05
3774	frmImages := TfrmImages.Create(Self); //kt 8/19/05
3775	frmImages.Parent := pnlPage; //kt 8/19/05
3776	end; //kt 8/19/05
3777	} //kt
3778	else
3779	Exit;
3780	end;
3781	if ATabID = CT_COVER then
3782	begin
3783	uTabList.Insert(0, IntToStr(ATabID));
3784	tabPage.Tabs.Insert(0, ALabel);
3785	tabPage.TabIndex := 0;
3786	end
3787	else
3788	begin
3789	uTabList.Add(IntToStr(ATabID));
3790	tabPage.Tabs.Add(ALabel);
3791	end;
3792	if uTabColorsList.IndexOf(ALabel) < 0 then //kt added 8/8/08
3793	uTabColorsList.Add(ALabel); //will put colors in later... //kt
3794	end;
3795
3796	procedure TfrmFrame.LoadTabColors(INIFile : TIniFile; ColorsList : TStringList);
3797	//kt added 8/8/08 Entire function
3798	var i : integer;
3799	sValue : string;
3800	value : longword;
3801	begin
3802	value :=0;
3803	for i := 0 to ColorsList.Count-1 do begin
3804	sValue := INIFile.ReadString('TAB_COLORS',ColorsList.Strings[i],IntToStr($00FFFF));
3805	try
3806	value := StrToInt(sValue)
3807	except
3808	on EConvertError do value := $00FFFF;
3809	end;
3810	ColorsList.Objects[i] := pointer(value);
3811	end;
3812	end;
3813
3814	procedure TfrmFrame.SaveTabColors(INIFile : TIniFile; ColorsList : TStringList);
3815	//kt added 8/8/08 Entire function
3816	var i : integer;
3817	begin
3818	for i := 0 to ColorsList.Count-1 do begin
3819	INIFile.WriteInteger('TAB_COLORS',ColorsList.Strings[i],longword(ColorsList.Objects[i]));
3820	end;
3821	end;
3822
3823	procedure TfrmFrame.ShowHideChartTabMenus(AMenuItem: TMenuItem);
3824	var
3825	i: integer;
3826	begin
3827	for i := 0 to AMenuItem.Count - 1 do
3828	AMenuItem.Items[i].Visible := TabExists(AMenuItem.Items[i].Tag);
3829	end;
3830
3831	function TfrmFrame.TabExists(ATabID: integer): boolean;
3832	begin
3833	Result := (uTabList.IndexOf(IntToStr(ATabID)) > -1)
3834	end;
3835
3836	procedure TfrmFrame.ReportsOnlyDisplay;
3837	begin
3838
3839	// Configure "Edit" menu:
3840	menuHideAllBut(mnuEdit, mnuEditPref); // Hide everything under Edit menu except Preferences.
3841	menuHideAllBut(mnuEditPref, Prefs1); // Hide everything under Preferences menu except Fonts.
3842
3843	// Remaining pull-down menus:
3844	mnuView.visible := false;
3845	mnuFileRefresh.visible := false;
3846	mnuFileEncounter.visible := false;
3847	mnuFileReview.visible := false;
3848	mnuFileNext.visible := false;
3849	mnuFileNotifRemove.visible := false;
3850	mnuHelpBroker.visible := false;
3851	mnuHelpLists.visible := false;
3852	mnuHelpSymbols.visible := false;
3853
3854	// Top panel components:
3855	//pnlVisit.visible := false;
3856	//pnlVisit.hint := 'Provider/Location'; <-- original line. //kt 7/17/2007
3857	pnlVisit.hint := DKLangConstW('fFrame_ProviderxLocation'); //kt added 7/17/2007
3858	pnlVisit.onMouseDown := nil;
3859	pnlVisit.onMouseUp := nil;
3860	//pnlPrimaryCare.visible := false;
3861	//pnlPostings.visible := false;
3862	//lblPtCWAD.visible := false;
3863	//lblPtPostings.visible := false;
3864	//pnlReminders.visible := false;
3865	//anmtRemSearch.visible := false;
3866
3867	// Forms for other tabs:
3868	frmCover.visible := false;
3869	frmProblems.visible := false;
3870	frmMeds.visible := false;
3871	frmOrders.visible := false;
3872	frmNotes.visible := false;
3873	frmConsults.visible := false;
3874	frmDCSumm.visible := false;
3875	if Assigned(frmSurgery) then
3876	frmSurgery.visible := false;
3877	frmLabs.visible := false;
3878
3879	// Other tabs (so to speak):
3880	tabPage.tabs.clear;
3881	tabPage.tabs.add('Reports');
3882
3883	end;
3884
3885	procedure TfrmFrame.UpdatePtInfoOnRefresh;
3886	var
3887	tmpDFN: string;
3888	begin
3889	tmpDFN := Patient.DFN;
3890	Patient.Clear;
3891	Patient.DFN := tmpDFN;
3892	uCore.TempEncounterLoc := 0; //hds7591 Clinic/Ward movement.
3893	uCore.TempEncounterLocName := ''; //hds7591 Clinic/Ward movement.
3894
3895	if (FPrevInPatient and Patient.Inpatient) then //transfering inside hospital
3896	Encounter.Location := Patient.Location
3897	else if (FPrevInPatient and (not Patient.Inpatient)) then //patient was discharged
3898	begin
3899	Encounter.Inpatient := False;
3900	Encounter.Location := 0;
3901	FPrevInPatient := False;
3902	end
3903	else if ((not FPrevInPatient) and Patient.Inpatient) then //patient was admitted
3904	begin
3905	Encounter.Inpatient := True;
3906	uCore.TempEncounterLoc := Encounter.Location; //hds7591 Clinic/Ward movement.
3907	uCore.TempEncounterLocName := Encounter.LocationName; //hds7591 Clinic/Ward movement.
3908	Encounter.Location := Patient.Location;
3909	Encounter.DateTime := Patient.AdmitTime;
3910	Encounter.VisitCategory := 'H';
3911	FPrevInPatient := True;
3912	end;
3913	//if User.IsProvider then Encounter.Provider := ;
3914	DisplayEncounterText;
3915	end;
3916
3917	procedure TfrmFrame.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
3918	var
3919	NewTabIndex: integer;
3920	begin
3921	//CQ2844: Toggle Remote Data button using Alt+R
3922	case Key of
3923	82,114: if (ssAlt in Shift) then
3924	frmFrame.pnlCIRNClick(Sender);
3925	end;
3926
3927	if (Key = VK_TAB) then begin
3928	if (ssCtrl in Shift) then begin
3929	if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
3930	NewTabIndex := tabPage.TabIndex;
3931	if ssShift in Shift then
3932	dec(NewTabIndex)
3933	else
3934	inc(NewTabIndex);
3935	if NewTabIndex >= tabPage.Tabs.Count then
3936	dec(NewTabIndex,tabPage.Tabs.Count)
3937	else if NewTabIndex < 0 then
3938	inc(NewTabIndex,tabPage.Tabs.Count);
3939	tabPage.TabIndex := NewTabIndex;
3940	tabPageChange(tabPage);
3941	Key := 0;
3942	end;
3943	end;
3944	end;
3945	end;
3946
3947	procedure TfrmFrame.FormActivate(Sender: TObject);
3948	begin
3949	if Assigned(FLastPage) then
3950	FLastPage.FocusFirstControl;
3951	end;
3952
3953	procedure TfrmFrame.pnlPrimaryCareEnter(Sender: TObject);
3954	begin
3955	with Sender as TPanel do
3956	if (ControlCount > 0) and (Controls[0] is TSpeedButton) and (TSpeedButton(Controls[0]).Down)
3957	then
3958	BevelInner := bvLowered
3959	else
3960	BevelInner := bvRaised;
3961	end;
3962
3963	procedure TfrmFrame.pnlPrimaryCareExit(Sender: TObject);
3964	var
3965	ShiftIsDown,TabIsDown : boolean;
3966	begin
3967	with Sender as TPanel do begin
3968	BevelInner := bvNone;
3969	//Make the lstCIRNLocations act as if between pnlCIRN & pnlReminders
3970	//in the Tab Order
3971	if (lstCIRNLocations.CanFocus) then
3972	begin
3973	ShiftIsDown := Boolean(Hi(GetKeyState(VK_SHIFT)));
3974	TabIsDown := Boolean(Hi(GetKeyState(VK_TAB)));
3975	if TabIsDown then
3976	if (ShiftIsDown) and (Name = 'pnlReminders') then
3977	lstCIRNLocations.SetFocus
3978	else if Not (ShiftIsDown) and (Name = 'pnlCIRN') then
3979	lstCIRNLocations.SetFocus;
3980	end;
3981	end;
3982	end;
3983
3984	procedure TfrmFrame.pnlPatientClick(Sender: TObject);
3985	begin
3986	ViewInfo(mnuViewDemo);
3987	end;
3988
3989	procedure TfrmFrame.pnlVisitClick(Sender: TObject);
3990	begin
3991	//if (not User.IsReportsOnly) then // Reports Only tab.
3992	// mnuFileEncounterClick(Self);
3993	ViewInfo(mnuViewVisits);
3994	end;
3995
3996	procedure TfrmFrame.pnlPrimaryCareClick(Sender: TObject);
3997	begin
3998	//ReportBox(DetailPrimaryCare(Patient.DFN), 'Primary Care', True);
3999	ViewInfo(mnuViewPrimaryCare);
4000	end;
4001
4002	procedure TfrmFrame.pnlRemindersClick(Sender: TObject);
4003	begin
4004	if(pnlReminders.tag = HAVE_REMINDERS) then
4005	ViewInfo(mnuViewReminders);
4006
4007	end;
4008
4009	procedure TfrmFrame.pnlPostingsClick(Sender: TObject);
4010	begin
4011	ViewInfo(mnuViewPostings);
4012	end;
4013
4014	//=========================== CCOW main changes ========================
4015
4016	procedure TfrmFrame.HandleCCOWError(AMessage: string);
4017	begin
4018	{$ifdef DEBUG}
4019	ShowMessage(AMessage);
4020	{$endif}
4021	InfoBox(TX_CCOW_ERROR, TC_CCOW_ERROR, MB_ICONERROR or MB_OK);
4022	FCCOWInstalled := False;
4023	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_BROKEN');
4024	pnlCCOW.Hint := TX_CCOW_BROKEN;
4025	mnuFileResumeContext.Visible := True;
4026	mnuFileResumeContext.Enabled := False;
4027	mnuFileBreakContext.Visible := True;
4028	mnuFileBreakContext.Enabled := False;
4029	FCCOWError := True;
4030	end;
4031
4032	function TfrmFrame.AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean;
4033	var
4034	PtData : IContextItemCollection;
4035	PtDataItem2, PtDataItem3, PtDataItem4 : IContextItem;
4036	response : UserResponse;
4037	StationNumber: string;
4038	IsProdAcct: boolean;
4039	begin
4040	Result := False;
4041	response := 0;
4042	try
4043	// Start a context change transaction
4044	if FCCOWInstalled then
4045	begin
4046	FCCOWError := False;
4047	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
4048	pnlCCOW.Hint := TX_CCOW_CHANGING;
4049	try
4050	ctxContextor.StartContextChange();
4051	except
4052	on E: Exception do HandleCCOWError(E.Message);
4053	end;
4054	if FCCOWError then
4055	begin
4056	Result := False;
4057	Exit;
4058	end;
4059	// Set the new proposed context data.
4060	PtData := CoContextItemCollection.Create();
4061	StationNumber := User.StationNumber;
4062	IsProdAcct := User.IsProductionAccount;
4063
4064	{$IFDEF CCOWBROKER}
4065	//IsProdAcct := RPCBrokerV.Login.IsProduction; //not yet
4066	{$ENDIF}
4067
4068	PtDataItem2 := CoContextItem.Create();
4069	PtDataItem2.Set_Name('Patient.co.PatientName'); // Patient.Name
4070	PtDataItem2.Set_Value(Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^');
4071	PtData.Add(PtDataItem2);
4072
4073	PtDataItem3 := CoContextItem.Create();
4074	if not IsProdAcct then
4075	PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber + '_TEST') // Patient.DFN
4076	else
4077	PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber); // Patient.DFN
4078	PtDataItem3.Set_Value(Patient.DFN);
4079	PtData.Add(PtDataItem3);
4080
4081	if Patient.ICN <> '' then
4082	begin
4083	PtDataItem4 := CoContextItem.Create();
4084	if not IsProdAcct then
4085	PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber_TEST') // Patient.ICN
4086	else
4087	PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber'); // Patient.ICN
4088	PtDataItem4.Set_Value(Patient.ICN);
4089	PtData.Add(PtDataItem4);
4090	end;
4091
4092	// End the context change transaction.
4093	FCCOWError := False;
4094	try
4095	response := ctxContextor.EndContextChange(true, PtData);
4096	except
4097	on E: Exception do HandleCCOWError(E.Message);
4098	end;
4099	if FCCOWError then
4100	begin
4101	HideEverything;
4102	Result := False;
4103	Exit;
4104	end;
4105	end
4106	else
4107	//response := urBreak;
4108	begin
4109	Result := True;
4110	Exit;
4111	end;
4112
4113	CCOWResponse := response;
4114	if (response = UrCommit) then
4115	begin
4116	// New context is committed.
4117	//ShowMessage('Response was Commit');
4118	mnuFileResumeContext.Enabled := False;
4119	mnuFileBreakContext.Enabled := True;
4120	FCCOWIconName := 'BMP_CCOW_LINKED';
4121	pnlCCOW.Hint := TX_CCOW_LINKED;
4122	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4123	Result := True;
4124	end
4125	else if (response = UrCancel) then
4126	begin
4127	// Proposed context change is canceled. Return to the current context.
4128	PtData.RemoveAll;
4129	mnuFileResumeContext.Enabled := False;
4130	mnuFileBreakContext.Enabled := True;
4131	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4132	Result := False;
4133	end
4134	else if (response = UrBreak) then
4135	begin
4136	// The contextor has broken the link by suspending. This app should
4137	// update the Clinical Link icon, enable the Resume menu item, and
4138	// disable the Suspend menu item.
4139	PtData.RemoveAll;
4140	mnuFileResumeContext.Enabled := True;
4141	mnuFileBreakContext.Enabled := False;
4142	FCCOWIconName := 'BMP_CCOW_BROKEN';
4143	pnlCCOW.Hint := TX_CCOW_BROKEN;
4144	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4145	if Patient.Inpatient then
4146	begin
4147	Encounter.Inpatient := True;
4148	Encounter.Location := Patient.Location;
4149	Encounter.DateTime := Patient.AdmitTime;
4150	Encounter.VisitCategory := 'H';
4151	end;
4152	if User.IsProvider then Encounter.Provider := User.DUZ;
4153	SetupPatient;
4154	tabPage.TabIndex := PageIDToTab(User.InitialTab);
4155	tabPageChange(tabPage);
4156	Result := False;
4157	end;
4158	except
4159	on exc : EOleException do
4160	//ShowMessage('EOleException: ' + exc.Message + ' - ' + string(exc.ErrorCode) );
4161	ShowMessage('EOleException: ' + exc.Message);
4162	end;
4163	end;
4164
4165	procedure TfrmFrame.ctxContextorCanceled(Sender: TObject);
4166	begin
4167	// Application should maintain its state as the current (existing) context.
4168	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4169	end;
4170
4171	procedure TfrmFrame.ctxContextorPending(Sender: TObject;
4172	const aContextItemCollection: IDispatch);
4173	var
4174	Reason, HyperLinkReason: string;
4175	PtChanged: boolean;
4176	{$IFDEF CCOWBROKER}
4177	UserChanged: boolean;
4178	{$ENDIF}
4179	begin
4180	// If the app would lose data, or have other problems changing context at
4181	// this time, it should return a message using SetSurveyReponse. Note that the
4182	// user may decide to commit the context change anyway.
4183	//
4184	// if (cannot-change-context-without-a-problem) then
4185	// contextor.SetSurveyResponse('Conditional accept reason...');
4186	if FCCOWBusy then
4187	begin
4188	Sleep(10000);
4189	end;
4190
4191	FCCOWError := False;
4192	try
4193	CheckForDifferentPatient(aContextItemCollection, PtChanged);
4194	{$IFDEF CCOWBROKER}
4195	CheckForDifferentUser(aContextItemCollection, UserChanged);
4196	{$ENDIF}
4197	except
4198	on E: Exception do HandleCCOWError(E.Message);
4199	end;
4200	if FCCOWError then
4201	begin
4202	HideEverything;
4203	Exit;
4204	end;
4205
4206	{$IFDEF CCOWBROKER}
4207	if PtChanged or UserChanged then
4208	{$ELSE}
4209	if PtChanged then
4210	{$ENDIF}
4211	begin
4212	FCCOWContextChanging := True;
4213	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
4214	pnlCCOW.Hint := TX_CCOW_CHANGING;
4215	AllowContextChangeAll(Reason);
4216	end;
4217	CheckHyperlinkResponse(aContextItemCollection, HyperlinkReason);
4218	Reason := HyperlinkReason + Reason;
4219	if Pos('COM_OBJECT_ACTIVE', Reason) > 0 then
4220	Sleep(12000)
4221	else if Length(Reason) > 0 then
4222	ctxContextor.SetSurveyResponse(Reason);
4223	FCCOWContextChanging := False;
4224	end;
4225
4226	procedure TfrmFrame.ctxContextorCommitted(Sender: TObject);
4227	var
4228	Reason: string;
4229	PtChanged: boolean;
4230	i: integer;
4231	begin
4232	// Application should now access the new context and update its state.
4233	FCCOWError := False;
4234	try
4235	{$IFDEF CCOWBROKER}
4236	with RPCBrokerV do if (WasUserDefined and IsUserCleared and (ctxContextor.CurrentContext.Present(CCOW_USER_NAME) = nil)) then // RV 05/11/04
4237	begin
4238	Reason := 'COMMIT';
4239	if AllowContextChangeAll(Reason) then
4240	begin
4241	Close;
4242	Exit;
4243	end;
4244	end;
4245	{$ENDIF}
4246	CheckForDifferentPatient(ctxContextor.CurrentContext, PtChanged);
4247	except
4248	on E: Exception do HandleCCOWError(E.Message);
4249	end;
4250	if FCCOWError then
4251	begin
4252	HideEverything;
4253	Exit;
4254	end;
4255	if not PtChanged then exit;
4256	FCCOWDrivedChange := True;
4257	i := 0;
4258	while Length(Screen.Forms[i].Name) > 0 do
4259	begin
4260	if fsModal in Screen.Forms[i].FormState then
4261	begin
4262	Screen.Forms[i].ModalResult := mrCancel;
4263	i := i + 1;
4264	end else // the fsModal forms always sequenced prior to the none-fsModal forms
4265	Break;
4266	end;
4267	Reason := 'COMMIT';
4268	if AllowContextChangeAll(Reason) then UpdateCCOWContext;
4269	FCCOWIconName := 'BMP_CCOW_LINKED';
4270	pnlCCOW.Hint := TX_CCOW_LINKED;
4271	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4272	end;
4273
4274	//function TfrmFrame.FindBestCCOWDFN(var APatientName: string): string;
4275	function TfrmFrame.FindBestCCOWDFN: string;
4276	var
4277	data: IContextItemCollection;
4278	anItem: IContextItem;
4279	StationNumber, tempDFN: string;
4280	IsProdAcct: Boolean;
4281
4282	procedure FindNextBestDFN;
4283	begin
4284	StationNumber := User.StationNumber;
4285	if IsProdAcct then
4286	anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber)
4287	else
4288	anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber + '_TEST');
4289	if anItem <> nil then tempDFN := anItem.Get_Value();
4290	end;
4291
4292	begin
4293	if uCore.User = nil then
4294	begin
4295	Result := '';
4296	exit;
4297	end;
4298	IsProdAcct := User.IsProductionAccount;
4299	{$IFDEF CCOWBROKER}
4300	//IsProdAcct := RPCBrokerV.Login.IsProduction; //not yet
4301	{$ENDIF}
4302	// Get an item collection of the current context
4303	FCCOWError := False;
4304	try
4305	data := ctxContextor.CurrentContext;
4306	except
4307	on E: Exception do HandleCCOWError(E.Message);
4308	end;
4309	if FCCOWError then
4310	begin
4311	HideEverything;
4312	Exit;
4313	end;
4314	// Retrieve the ContextItem name and value as strings
4315	if IsProdAcct then
4316	anItem := data.Present('Patient.id.MRN.NationalIDNumber')
4317	else
4318	anItem := data.Present('Patient.id.MRN.NationalIDNumber_TEST');
4319	if anItem <> nil then
4320	begin
4321	tempDFN := GetDFNFromICN(anItem.Get_Value()); // "Public" RPC call
4322	if tempDFN = '-1' then FindNextBestDFN;
4323	end
4324	else
4325	FindNextBestDFN;
4326	Result := tempDFN;
4327	(* anItem := data.Present('Patient.co.PatientName');
4328	if anItem <> nil then APatientName := anItem.Get_Value();*)
4329	data := nil;
4330	anItem := nil;
4331	end;
4332
4333	procedure TfrmFrame.UpdateCCOWContext;
4334	var
4335	PtDFN(, PtName): string;
4336	begin
4337	if not FCCOWInstalled then exit;
4338	//PtDFN := FindBestCCOWDFN(PtName);
4339	PtDFN := FindBestCCOWDFN;
4340	if StrToInt64Def(PtDFN, 0) > 0 then
4341	begin
4342	// Select new patient based on context value
4343	if Patient.DFN = PtDFN then exit;
4344	Patient.DFN := PtDFN;
4345	//if (Patient.Name = '-1') or (PtName <> Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^') then
4346	if (Patient.Name = '-1') then
4347	begin
4348	HideEverything;
4349	exit;
4350	end
4351	else
4352	ShowEverything;
4353	Encounter.Clear;
4354	if Patient.Inpatient then
4355	begin
4356	Encounter.Inpatient := True;
4357	Encounter.Location := Patient.Location;
4358	Encounter.DateTime := Patient.AdmitTime;
4359	Encounter.VisitCategory := 'H';
4360	end;
4361	if User.IsProvider then Encounter.Provider := User.DUZ;
4362	if not FFirstLoad then SetupPatient;
4363	frmCover.UpdateVAAButton; //VAA
4364	DetermineNextTab;
4365	tabPage.TabIndex := PageIDToTab(NextTab);
4366	tabPageChange(tabPage);
4367	end
4368	else
4369	HideEverything;
4370	end;
4371
4372	procedure TfrmFrame.mnuFileBreakContextClick(Sender: TObject);
4373	begin
4374	FCCOWError := False;
4375	FCCOWIconName := 'BMP_CCOW_CHANGING';
4376	pnlCCOW.Hint := TX_CCOW_CHANGING;
4377	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4378	try
4379	ctxContextor.Suspend;
4380	except
4381	on E: Exception do HandleCCOWError(E.Message);
4382	end;
4383	if FCCOWError then exit;
4384	FCCOWIconName := 'BMP_CCOW_BROKEN';
4385	pnlCCOW.Hint := TX_CCOW_BROKEN;
4386	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4387	mnuFileResumeContext.Enabled := True;
4388	mnuFileBreakContext.Enabled := False;
4389	end;
4390
4391	procedure TfrmFrame.mnuFileResumeContextGetClick(Sender: TObject);
4392	var
4393	Reason: string;
4394	begin
4395	Reason := '';
4396	if not AllowContextChangeAll(Reason) then exit;
4397	FCCOWIconName := 'BMP_CCOW_CHANGING';
4398	pnlCCOW.Hint := TX_CCOW_CHANGING;
4399	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4400	FCCOWError := False;
4401	try
4402	ctxContextor.Resume;
4403	except
4404	on E: Exception do HandleCCOWError(E.Message);
4405	end;
4406	if FCCOWError then exit;
4407	UpdateCCOWContext;
4408	FCCOWIconName := 'BMP_CCOW_LINKED';
4409	pnlCCOW.Hint := TX_CCOW_LINKED;
4410	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4411	mnuFileResumeContext.Enabled := False;
4412	mnuFileBreakContext.Visible := True;
4413	mnuFileBreakContext.Enabled := True;
4414	end;
4415
4416	procedure TfrmFrame.mnuFileResumeContextSetClick(Sender: TObject);
4417	var
4418	CCOWResponse: UserResponse;
4419	Reason: string;
4420	begin
4421	Reason := '';
4422	if not AllowContextChangeAll(Reason) then exit;
4423	FCCOWIconName := 'BMP_CCOW_CHANGING';
4424	pnlCCOW.Hint := TX_CCOW_CHANGING;
4425	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4426	FCCOWError := False;
4427	try
4428	ctxContextor.Resume;
4429	except
4430	on E: Exception do HandleCCOWError(E.Message);
4431	end;
4432	if FCCOWError then exit;
4433	if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
4434	begin
4435	mnuFileResumeContext.Enabled := False;
4436	mnuFileBreakContext.Visible := True;
4437	mnuFileBreakContext.Enabled := True;
4438	FCCOWIconName := 'BMP_CCOW_LINKED';
4439	pnlCCOW.Hint := TX_CCOW_LINKED;
4440	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4441	end
4442	else
4443	begin
4444	mnuFileResumeContext.Enabled := True;
4445	mnuFileBreakContext.Enabled := False;
4446	FCCOWIconName := 'BMP_CCOW_BROKEN';
4447	pnlCCOW.Hint := TX_CCOW_BROKEN;
4448	imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
4449	try
4450	if ctxContextor.State in [csParticipating] then ctxContextor.Suspend;
4451	except
4452	on E: Exception do HandleCCOWError(E.Message);
4453	end;
4454	end;
4455	SetupPatient;
4456	tabPage.TabIndex := PageIDToTab(User.InitialTab);
4457	tabPageChange(tabPage);
4458	end;
4459
4460	procedure TfrmFrame.CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
4461	var
4462	data : IContextItemCollection;
4463	anItem: IContextItem;
4464	PtDFN, PtName: string;
4465	begin
4466	if uCore.Patient = nil then
4467	begin
4468	PtChanged := False;
4469	Exit;
4470	end;
4471	data := IContextItemCollection(aContextItemCollection) ;
4472	//PtDFN := FindBestCCOWDFN(PtName);
4473	PtDFN := FindBestCCOWDFN;
4474	// Retrieve the ContextItem name and value as strings
4475	anItem := data.Present('Patient.co.PatientName');
4476	if anItem <> nil then PtName := anItem.Get_Value();
4477	PtChanged := not ((PtDFN = Patient.DFN) and (PtName = Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^'));
4478	end;
4479
4480	{$IFDEF CCOWBROKER}
4481	procedure TfrmFrame.CheckForDifferentUser(aContextItemCollection: IDispatch; var UserChanged: boolean);
4482	var
4483	data : IContextItemCollection;
4484	begin
4485	if uCore.User = nil then
4486	begin
4487	UserChanged := False;
4488	Exit;
4489	end;
4490	data := IContextItemCollection(aContextItemCollection) ;
4491	UserChanged := RPCBrokerV.IsUserContextPending(data);
4492	end;
4493	{$ENDIF}
4494
4495	procedure TfrmFrame.CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
4496	var
4497	data : IContextItemCollection;
4498	anItem : IContextItem;
4499	itemvalue: string;
4500	PtSubject: string;
4501	begin
4502	data := IContextItemCollection(aContextItemCollection) ;
4503	anItem := data.Present('[hds_med_va.gov]request.id.name');
4504	// Retrieve the ContextItem name and value as strings
4505	if anItem <> nil then
4506	begin
4507	itemValue := anItem.Get_Value();
4508	if itemValue = 'GetWindowHandle' then
4509	begin
4510	PtSubject := 'patient.id.mrn.dfn_' + User.StationNumber;
4511	if not User.IsProductionAccount then PtSubject := PtSubject + '_test';
4512	if data.Present(PtSubject) <> nil then
4513	HyperlinkReason := '!@#$' + IntToStr(Self.Handle) + ':0:'
4514	else
4515	HyperlinkReason := '';
4516	end;
4517	end;
4518	end;
4519
4520	procedure TfrmFrame.HideEverything;
4521	begin
4522	FNoPatientSelected := TRUE;
4523	pnlNoPatientSelected.Visible := True;
4524	pnlNoPatientSelected.BringToFront;
4525	mnuFileReview.Enabled := False;
4526	mnuFilePrint.Enabled := False;
4527	mnuFilePrintSelectedItems.Enabled := False;
4528	mnuFileEncounter.Enabled := False;
4529	mnuFileNext.Enabled := False;
4530	mnuFileRefresh.Enabled := False;
4531	mnuFilePrintSetup.Enabled := False;
4532	mnuFilePrintSelectedItems.Enabled := False;
4533	mnuFileNotifRemove.Enabled := False;
4534	mnuFileResumeContext.Enabled := False;
4535	mnuFileBreakContext.Enabled := False;
4536	mnuEdit.Enabled := False;
4537	mnuView.Enabled := False;
4538	mnuTools.Enabled := False;
4539	end;
4540
4541	procedure TfrmFrame.ShowEverything;
4542	begin
4543	FNoPatientSelected := FALSE;
4544	pnlNoPatientSelected.Visible := False;
4545	pnlNoPatientSelected.SendToBack;
4546	mnuFileReview.Enabled := True;
4547	mnuFilePrint.Enabled := True;
4548	mnuFileEncounter.Enabled := True;
4549	mnuFileNext.Enabled := True;
4550	mnuFileRefresh.Enabled := True;
4551	mnuFilePrintSetup.Enabled := True;
4552	mnuFilePrintSelectedItems.Enabled := True;
4553	mnuFileNotifRemove.Enabled := True;
4554	if not FCCOWError then
4555	begin
4556	if FCCOWIconName= 'BMP_CCOW_BROKEN' then
4557	begin
4558	mnuFileResumeContext.Enabled := True;
4559	mnuFileBreakContext.Enabled := False;
4560	end else
4561	begin
4562	mnuFileResumeContext.Enabled := False;
4563	mnuFileBreakContext.Enabled := True;
4564	end;
4565	end;
4566	mnuEdit.Enabled := True;
4567	mnuView.Enabled := True;
4568	mnuTools.Enabled := True;
4569	end;
4570
4571
4572	procedure TfrmFrame.pnlFlagMouseDown(Sender: TObject; Button: TMouseButton;
4573	Shift: TShiftState; X, Y: Integer);
4574	begin
4575	pnlFlag.BevelOuter := bvLowered;
4576	end;
4577
4578	procedure TfrmFrame.pnlFlagMouseUp(Sender: TObject; Button: TMouseButton;
4579	Shift: TShiftState; X, Y: Integer);
4580	begin
4581	pnlFlag.BevelOuter := bvRaised;
4582	end;
4583
4584	procedure TfrmFrame.pnlFlagClick(Sender: TObject);
4585	begin
4586	//ShowFlags;
4587	ViewInfo(mnuViewFlags);
4588	end;
4589
4590	procedure TfrmFrame.mnuFilePrintSelectedItemsClick(Sender: TObject);
4591	begin
4592	case TabToPageID(tabPage.TabIndex) of
4593	CT_NOTES: frmNotes.LstNotesToPrint;
4594	CT_CONSULTS: frmConsults.LstConsultsToPrint;
4595	CT_DCSUMM: frmDCSumm.LstSummsToPrint;
4596	end; {case}
4597	end;
4598
4599	procedure TfrmFrame.mnuAlertRenewClick(Sender: TObject);
4600	var XQAID: string;
4601	begin
4602	XQAID := Piece(Notifications.RecordID, '^', 2);
4603	RenewAlert(XQAID);
4604	end;
4605
4606	procedure TfrmFrame.mnuAlertForwardClick(Sender: TObject);
4607	var
4608	XQAID, AlertMsg: string;
4609	begin
4610	XQAID := Piece(Notifications.RecordID,'^', 2);
4611	AlertMsg := Piece(Notifications.RecordID, '^', 1);
4612	RenewAlert(XQAID); // must renew/restore an alert before it can be forwarded
4613	ForwardAlertTo(XQAID + '^' + AlertMsg);
4614	end;
4615
4616	procedure TfrmFrame.mnuGECStatusClick(Sender: TObject);
4617	var
4618	ans, Result,str,str1,title: string;
4619	cnt,i: integer;
4620	fin: boolean;
4621
4622	begin
4623	Result := sCallV('ORQQPXRM GEC STATUS PROMPT', [Patient.DFN]);
4624	if Piece(Result,U,1) <> '0' then
4625	begin
4626	title := Piece(Result,U,2);
4627	if pos('~',Piece(Result,U,1))>0 then
4628	begin
4629	str:='';
4630	str1 := Piece(Result,U,1);
4631	cnt := DelimCount(str1, '~');
4632	for i:=1 to cnt+1 do
4633	begin
4634	if i = 1 then str := Piece(str1,'~',i);
4635	if i > 1 then str :=str+CRLF+Piece(str1,'~',i);
4636	end;
4637	end
4638	else str := Piece(Result,U,1);
4639	if Piece(Result,U,3)='1' then
4640	begin
4641	fin := (InfoBox(str,title, MB_YESNO or MB_DEFBUTTON2)=IDYES);
4642	if fin = true then ans := '1';
4643	if fin = false then ans := '0';
4644	CallV('ORQQPXRM GEC FINISHED?',[Patient.DFN,ans]);
4645	end
4646	else
4647	InfoBox(str,title, MB_OK);
4648	end;
4649	end;
4650
4651	procedure TfrmFrame.pnlFlagEnter(Sender: TObject);
4652	begin
4653	pnlFlag.BevelInner := bvRaised;
4654	pnlFlag.BevelOuter := bvNone;
4655	pnlFlag.BevelWidth := 4;
4656	end;
4657
4658	procedure TfrmFrame.pnlFlagExit(Sender: TObject);
4659	begin
4660	pnlFlag.BevelWidth := 2;
4661	pnlFlag.BevelInner := bvNone;
4662	pnlFlag.BevelOuter := bvRaised;
4663	end;
4664
4665	procedure TfrmFrame.tabPageMouseUp(Sender: TObject; Button: TMouseButton;
4666	Shift: TShiftState; X, Y: Integer);
4667	begin
4668	LastTab := TabToPageID((sender as TTabControl).TabIndex);
4669	end;
4670
4671	procedure TfrmFrame.lstCIRNLocationsExit(Sender: TObject);
4672	begin
4673	//Make the lstCIRNLocations act as if between pnlCIRN & pnlReminders
4674	//in the Tab Order
4675	if Boolean(Hi(GetKeyState(VK_TAB))) then
4676	if Boolean(Hi(GetKeyState(VK_SHIFT))) then
4677	pnlCIRN.SetFocus
4678	else
4679	pnlReminders.SetFocus;
4680	end;
4681
4682	procedure TfrmFrame.AppEventsActivate(Sender: TObject);
4683	begin
4684	FJustEnteredApp := True;
4685	end;
4686
4687	procedure TfrmFrame.ScreenActiveFormChange(Sender: TObject);
4688	begin
4689	if(assigned(FOldActiveFormChange)) then
4690	FOldActiveFormChange(Sender);
4691	//Focus the Form that Stays on Top after the Application Regains focus.
4692	if FJustEnteredApp then
4693	FocusApplicationTopForm;
4694	FJustEnteredApp := false;
4695	end;
4696
4697	procedure TfrmFrame.FocusApplicationTopForm;
4698	var
4699	I : integer;
4700	begin
4701	for I := (Screen.FormCount-1) downto 0 do //Set the last one opened last
4702	begin
4703	with Screen.Forms[I] do
4704	if (FormStyle = fsStayOnTop) and (Enabled) and (Visible) then
4705	SetFocus;
4706	end;
4707	end;
4708
4709	procedure TfrmFrame.AppEventsShortCut(var Msg: TWMKey;
4710	var Handled: Boolean);
4711	begin
4712	if ((Boolean(Hi(GetKeyState(VK_MENU{ALT})))) and (Msg.CharCode = VK_F1)) then
4713	begin
4714	FocusApplicationTopForm;
4715	Handled := True;
4716	end;
4717	end;
4718
4719	procedure TfrmFrame.mnuToolsGraphingClick(Sender: TObject);
4720	begin
4721	Screen.Cursor := crHourGlass;
4722	if GraphFloat = nil then // new graph
4723	begin
4724	GraphFloat := TfrmGraphs.Create(self);
4725	try
4726	with GraphFloat do
4727	begin
4728	if btnClose.Tag = 1 then
4729	Exit;
4730	Initialize;
4731	// Caption := 'CPRS Graphing - Patient: ' + MixedCase(Patient.Name); <-- original line. //kt 7/17/2007
4732	Caption := DKLangConstW('fFrame_CPRS_Graphing_x_Patientx') + MixedCase(Patient.Name); //kt added 7/17/2007
4733	BorderIcons := [biSystemMenu, biMaximize, biMinimize];
4734	BorderStyle := bsSizeable;
4735	BorderWidth := 1;
4736	// context sensitive type (tabPage.TabIndex) & [item]
4737	ResizeAnchoredFormToFont(GraphFloat);
4738	Show;
4739	end;
4740	finally
4741	if GraphFloat.btnClose.Tag = 1 then
4742	begin
4743	GraphFloatActive := false;
4744	GraphFloat.Free;
4745	GraphFloat := nil;
4746	end
4747	else
4748	GraphFloatActive := true;
4749	end;
4750	end
4751	else if GraphFloat.btnClose.Tag = 1 then
4752	Exit
4753	else if GraphFloatActive and (GraphFloat.lstTypes.Hint = Patient.DFN) then
4754	GraphFloat.BringToFront // graph is active, same patient
4755	else if GraphFloat.lstTypes.Hint = Patient.DFN then
4756	begin // graph is not active, same patient
4757	// context sensitive
4758	GraphFloat.Show;
4759	GraphFloatActive := true;
4760	end
4761	else
4762	//with GraphFloat do // new patient
4763	begin
4764	GraphFloat.InitialRetain;
4765	GraphFloatActive := false;
4766	GraphFloat.Free;
4767	GraphFloat := nil;
4768	mnuToolsGraphingClick(self); // delete and recurse
4769	{//FormCreate(self); //****************
4770	Initialize;
4771	DisplayData('top');
4772	DisplayData('bottom');
4773	lstCheck.Items.Clear;
4774	Caption := 'CPRS Graphing - Patient: ' + MixedCase(Patient.Name);
4775	// context sensitive
4776	Show;
4777	GraphFloatActive := true;}
4778	end;
4779	Screen.Cursor := crDefault;
4780	end;
4781
4782	procedure TfrmFrame.pnlCIRNMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
4783	begin
4784	pnlCIRN.BevelOuter := bvLowered;
4785	end;
4786
4787	procedure TfrmFrame.pnlCIRNMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
4788	begin
4789	pnlCIRN.BevelOuter := bvRaised;
4790	end;
4791
4792	procedure TfrmFrame.laMHVClick(Sender: TObject);
4793	begin
4794	//if laMHV.Caption = 'MHV' then
4795	// ShellExecute(Handle, 'open', PChar('http://www.myhealth.va.gov/'), '', '', SW_NORMAL);
4796	ViewInfo(mnuViewMyHealtheVet);
4797	end;
4798
4799	procedure TfrmFrame.laVAA2Click(Sender: TObject);
4800	{var
4801	InsuranceSubscriberName: string;
4802	ReportString: TStringList; //CQ7782 }
4803	begin
4804	{if fCover.VAAFlag[0] <> '0' then //'0' means subscriber not found
4805	begin
4806	InsuranceSubscriberName := fCover.VAAFlag[12];
4807	//CQ7782
4808	//ReportString := TStringList.Create;
4809	ReportString := VAAFlag;
4810	ReportString[0] := '';
4811	ReportBox(ReportString, InsuranceSubscriberName, True);
4812	//end CQ7782
4813	end;}
4814	ViewInfo(mnuInsurance);
4815	end;
4816
4817	procedure TfrmFrame.ViewInfo(Sender: TObject);
4818	var
4819	SelectNew: Boolean;
4820	InsuranceSubscriberName: string;
4821	ReportString: TStringList;
4822	aAddress: string;
4823	begin
4824	case (Sender as TMenuItem).Tag of
4825	1:begin { displays patient inquiry report (which optionally allows new patient to be selected) }
4826	StatusText(TX_PTINQ);
4827	PatientInquiry(SelectNew);
4828	if Assigned(FLastPage) then
4829	FLastPage.FocusFirstControl;
4830	StatusText('');
4831	if SelectNew then mnuFileOpenClick(mnuViewDemo);
4832	end;
4833	2:begin
4834	if (not User.IsReportsOnly) then // Reports Only tab.
4835	mnuFileEncounterClick(Self);
4836	end;
4837	3:begin
4838	// ReportBox(DetailPrimaryCare(Patient.DFN), 'Primary Care', True); <-- original line. //kt 7/17/2007
4839	ReportBox(DetailPrimaryCare(Patient.DFN), DKLangConstW('fFrame_Primary_Care'), True); //kt added 7/17/2007
4840	end;
4841	4:begin
4842	if laMHV.Caption = 'MHV' then
4843	ShellExecute(laMHV.Handle, 'open', PChar('http://www.myhealth.va.gov/'), '', '', SW_NORMAL);
4844	end;
4845	5:begin
4846	if fCover.VAAFlag[0] <> '0' then //'0' means subscriber not found
4847	begin
4848	InsuranceSubscriberName := fCover.VAAFlag[12];
4849	ReportString := VAAFlag;
4850	ReportString[0] := '';
4851	ReportBox(ReportString, InsuranceSubscriberName, True);
4852	end;
4853	end;
4854	6:begin
4855	ShowFlags;
4856	end;
4857	7:begin
4858	if UseVistaWeb then
4859	begin
4860	pnlCIRN.BevelOuter := bvRaised;
4861	// pnlCIRN.Hint := 'Click to open VistaWeb'; <-- original line. //kt 7/17/2007
4862	pnlCIRN.Hint := DKLangConstW('fFrame_Click_to_open_VistaWeb'); //kt added 7/17/2007
4863	lblCIRN.Width := 43;
4864	lblCIRNData.Width := 43;
4865	lblCIRNData.Alignment := taCenter;
4866	lblCIRN.Alignment := taCenter;
4867	lstCIRNLocations.Visible := false;
4868	lstCIRNLocations.SendToBack;
4869	aAddress := GetVistaWebAddress(Patient.DFN);
4870	ShellExecute(pnlCirn.Handle, 'open', PChar(aAddress), PChar(''), '', SW_NORMAL);
4871	Exit;
4872	end;
4873	if not RemoteSites.RemoteDataExists then Exit;
4874	if (not lstCIRNLocations.Visible) then
4875	begin
4876	pnlCIRN.BevelOuter := bvLowered;
4877	lstCIRNLocations.Visible := True;
4878	lstCIRNLocations.BringToFront;
4879	lstCIRNLocations.SetFocus;
4880	// pnlCIRN.Hint := 'Click to close list.'; <-- original line. //kt 7/17/2007
4881	pnlCIRN.Hint := DKLangConstW('fFrame_Click_to_close_listx'); //kt added 7/17/2007
4882	end
4883	else
4884	begin
4885	pnlCIRN.BevelOuter := bvRaised;
4886	lstCIRNLocations.Visible := False;
4887	lstCIRNLocations.SendToBack;
4888	// pnlCIRN.Hint := 'Click to display other facilities having data for this patient.'; <-- original line. //kt 7/17/2007
4889	pnlCIRN.Hint := DKLangConstW('fFrame_Click_to_display_other_facilities_having_data_for_this_patientx'); //kt added 7/17/2007
4890	end;
4891	end;
4892	8:begin
4893	ViewReminderTree;
4894	end;
4895	9:begin { displays the window that shows crisis notes, warnings, allergies, & advance directives }
4896	ShowCWAD;
4897	end;
4898	end;
4899	end;
4900
4901	procedure TfrmFrame.mnuViewInformationClick(Sender: TObject);
4902	begin
4903	mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
4904	mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
4905	mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
4906	mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
4907	mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
4908	mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
4909	mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
4910	mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
4911	mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
4912	end;
4913
4914	procedure TfrmFrame.CheckForTMGPatch;
4915	var //Added by ELH 6/20/08
4916	RPCResult : AnsiString;
4917	i : integer;
4918	begin
4919	RPCBrokerV.remoteprocedure := 'XWB IS RPC AVAILABLE';
4920	RPCBrokerV.Param[0].Value := 'TMG ADD PATIENT';
4921	RPCBrokerV.Param[0].ptype := literal;
4922	RPCBrokerV.Param[1].Value := 'R';
4923	RPCBrokerV.Param[1].ptype := literal;
4924	RPCResult := RPCBrokerV.StrCall; {returns 1 if available, 0 if not available}
4925	if strtoint(RPCResult) = 1 then begin
4926	boolTMGPatchInstalled := True;
4927	end else begin
4928	boolTMGPatchInstalled := False;
4929	end;
4930	end;
4931
4932	procedure TfrmFrame.EditDemographicsClick(Sender: TObject);
4933	//kt added Function 12/15/07, 6/6/08
4934	var EditResult: integer;
4935	begin
4936	EditResult := frmPtDemoEdit.ShowModal;
4937	if EditResult <> mrCancel then mnuFileRefreshClick(Sender);
4938	end;
4939
4940	procedure TfrmFrame.tabPageDrawTab(Control: TCustomTabControl; TabIndex: Integer;
4941	const Rect: TRect; Active: Boolean);
4942	var ALabel : string;
4943	colorIndex : Integer;
4944	color : TColor;
4945	begin
4946	ALabel := TTabControl(Control).Tabs[TabIndex];
4947	colorIndex := uTabColorsList.IndexOf(ALabel);
4948	if colorIndex < 0 then color := clYellow
4949	else color := TColor(uTabColorsList.Objects[colorIndex]);
4950	DrawTab(Control,TabIndex,Rect,color,Active);
4951	end;
4952
4953	procedure TfrmFrame.DrawTab(Control: TCustomTabControl; TabIndex: Integer;
4954	const Rect: TRect; Color : TColor; Active: Boolean);
4955	var
4956	oRect : TRect;
4957	sCaption,temp : String;
4958	iTop : Integer;
4959	iLeft : Integer;
4960	i : integer;
4961	TabControl : TTabControl;
4962	lf : TLogFont; //Windows native font structure
4963	tf : TFont;
4964	Degrees : integer;
4965	inactiveColor : TColor;
4966
4967	(*
4968	function DecRed(Color : TColor; Amount : byte) : TColor;
4969	var red : longWord;
4970	begin
4971	red := (Color and $0000FF);
4972	if red > Amount then red := red - Amount
4973	else red := 0;
4974	Result := (Color and $FFFF00) or red;
4975	end;
4976
4977	function DecGreen(Color : TColor; Amount : byte) : TColor;
4978	var green : longWord;
4979	begin
4980	green := (Color and $00FF00);
4981	green := green shr 8;
4982	if green > Amount then green := green - Amount
4983	else green := 0;
4984	green := green shl 8;
4985	Result := (Color and $FF00FF) or green;
4986	end;
4987
4988	function DecBlue(Color : TColor; Amount : byte) : TColor;
4989	var blue : longWord;
4990	begin
4991	blue := (Color and $FF0000);
4992	blue := blue shr 16;
4993	if blue > Amount then blue := blue - Amount
4994	else blue := 0;
4995	blue := blue shl 16;
4996	Result := (Color and $00FFFF) or blue;
4997	end;
4998
4999	function Darken(Color : TColor; Amount : byte) : TColor;
5000	begin
5001	result:= DecRed(Color, Amount);
5002	result := DecBlue(result,Amount);
5003	result := DecGreen(result,Amount);
5004	end;
5005	*)
5006
5007	var
5008	DecAmount : Byte;
5009
5010	begin
5011	oRect := Rect;
5012	//DecAmount := 50;
5013	//inactiveColor := Darken(Color,DecAmount);
5014	inactiveColor := Color;
5015
5016	TabControl := TTabControl(Control);
5017	if TabControl.Tabs.Count=0 then exit;
5018	sCaption := TabControl.Tabs.Strings[TabIndex];
5019	for i := 1 to length(temp) do begin
5020	if temp[i] <> '&' then sCaption := sCaption + temp[i];
5021	end;
5022
5023	Control.Canvas.Font.Name := 'Tahoma';
5024	if Active then Control.Canvas.Font.Style := Control.Canvas.Font.Style + [fsBold];
5025	if Active then Control.Canvas.Font.Color := clBlack
5026	else Control.Canvas.Font.Color := clWhite;
5027
5028	if (TabControl.TabPosition = tpLeft) or (TabControl.TabPosition = tpRight) then begin
5029
5030	if (TabControl.TabPosition = tpLeft) then begin
5031	iTop := Rect.Bottom-4;
5032	if Active then iTop := iTop - 2;
5033	iLeft := Rect.Left + 1;
5034	Degrees := 90;
5035	end else begin
5036	iTop := Rect.Top + 4;
5037	if Active then iTop := iTop + 2;
5038	iLeft := Rect.Right - 2;
5039	Degrees := 270;
5040	end;
5041	tf := TFont.Create;
5042	try
5043	tf.Assign(Control.Canvas.Font);
5044	GetObject(tf.Handle, sizeof(lf), @lf);
5045	lf.lfEscapement := 10 * Degrees; //degrees of desired rotation
5046	lf.lfHeight := Control.Canvas.Font.Height - 2;
5047	tf.Handle := CreateFontIndirect(lf);
5048	Control.Canvas.Font.Assign(tf);
5049	finally
5050	tf.Free;
5051	end;
5052
5053	end else begin
5054	iTop := Rect.Top + ((Rect.Bottom - Rect.Top - Control.Canvas.TextHeight(sCaption)) div 2) + 1;
5055	iLeft := Rect.Left + ((Rect.Right - Rect.Left - Control.Canvas.TextWidth (sCaption)) div 2) + 1;
5056	end;
5057
5058	if Active then begin
5059	//Control.Canvas.Brush.Color := TColor($0000FFFF); //Bright yellow
5060	Control.Canvas.Brush.Color := Color;
5061	Control.Canvas.FillRect(Rect);
5062	end else begin
5063	//Control.Canvas.Brush.Color := TColor($000079EFE8); //dull yellow
5064	Control.Canvas.Brush.Color := inactiveColor;
5065	Control.Canvas.FillRect(Rect);
5066	end;
5067	Control.Canvas.TextOut(iLeft,iTop,sCaption);
5068	end;
5069
5070
5071
5072
5073	initialization
5074
5075	finalization
5076
5077
5078	end.
5079
5080

Note: See TracBrowser for help on using the repository browser.

Download in other formats: