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

Last change on this file since 495 was 490, checked in by Kevin Toppenberg, 16 years ago

new RPC broker

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