Context Navigation

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

Last change on this file since 697 was 694, checked in by Kevin Toppenberg, 15 years ago
Fixed HTML Template line feed issue
File size: 192.0 KB

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

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

Download in other formats: