Context Navigation

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

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

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

Download in other formats: