Context Navigation

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

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

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

Download in other formats: