Context Navigation

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

Last change on this file since 489 was 489, checked in by Kevin Toppenberg, 16 years ago
Adding skin support
File size: 190.4 KB

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

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

Download in other formats: