Context Navigation

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

Last change on this file since 800 was 793, checked in by Kevin Toppenberg, 14 years ago
update
File size: 192.8 KB

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

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

Download in other formats: