Context Navigation

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

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

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

Download in other formats: