Context Navigation

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

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

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

Download in other formats: