source: cprs/branches/foia-cprs/CPRS-Chart/fFrame.pas@ 460

Last change on this file since 460 was 460, checked in by Kevin Toppenberg, 17 years ago

Uploading from OR_30_258
File size: 155.1 KB
Line 
1unit fFrame;
2{ This is the main form for the CPRS GUI. It provides a patient-encounter-user framework
3 which all the other forms of the GUI use. }
4
5{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
6{$WARN SYMBOL_PLATFORM OFF}
7{$DEFINE CCOWBROKER}
8
9{.$define debug}
10
11interface
12
13uses
14 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Tabs, ComCtrls,
15 ExtCtrls, Menus, StdCtrls, Buttons, ORFn, fPage, uConst, ORCtrls, Trpcb,
16 OleCtrls, VERGENCECONTEXTORLib_TLB, ComObj, AppEvnts;
17
18type
19 TfrmFrame = class(TForm)
20 pnlToolbar: TPanel;
21 stsArea: TStatusBar;
22 tabPage: TTabControl;
23 pnlPage: TPanel;
24 bvlPageTop: TBevel;
25 bvlToolTop: TBevel;
26 pnlPatient: TKeyClickPanel;
27 lblPtName: TStaticText;
28 lblPtSSN: TStaticText;
29 lblPtAge: TStaticText;
30 pnlVisit: TKeyClickPanel;
31 lblPtLocation: TStaticText;
32 lblPtProvider: TStaticText;
33 mnuFrame: TMainMenu;
34 mnuFile: TMenuItem;
35 mnuFileExit: TMenuItem;
36 mnuFileOpen: TMenuItem;
37 mnuFileReview: TMenuItem;
38 Z1: TMenuItem;
39 mnuFilePrint: TMenuItem;
40 mnuEdit: TMenuItem;
41 mnuEditUndo: TMenuItem;
42 Z3: TMenuItem;
43 mnuEditCut: TMenuItem;
44 mnuEditCopy: TMenuItem;
45 mnuEditPaste: TMenuItem;
46 Z4: TMenuItem;
47 mnuEditPref: TMenuItem;
48 Prefs1: TMenuItem;
49 mnu24pt1: TMenuItem;
50 mnu18pt1: TMenuItem;
51 mnu14pt1: TMenuItem;
52 mnu12pt1: TMenuItem;
53 mnu10pt1: TMenuItem;
54 mnu8pt: TMenuItem;
55 mnuHelp: TMenuItem;
56 mnuHelpContents: TMenuItem;
57 mnuHelpTutor: TMenuItem;
58 Z5: TMenuItem;
59 mnuHelpAbout: TMenuItem;
60 mnuTools: TMenuItem;
61 mnuView: TMenuItem;
62 mnuViewChart: TMenuItem;
63 mnuChartReports: TMenuItem;
64 mnuChartLabs: TMenuItem;
65 mnuChartDCSumm: TMenuItem;
66 mnuChartCslts: TMenuItem;
67 mnuChartNotes: TMenuItem;
68 mnuChartOrders: TMenuItem;
69 mnuChartMeds: TMenuItem;
70 mnuChartProbs: TMenuItem;
71 mnuChartCover: TMenuItem;
72 mnuHelpBroker: TMenuItem;
73 mnuFileEncounter: TMenuItem;
74 mnuViewDemo: TMenuItem;
75 mnuViewPostings: TMenuItem;
76 mnuHelpLists: TMenuItem;
77 Z6: TMenuItem;
78 mnuHelpSymbols: TMenuItem;
79 mnuFileNext: TMenuItem;
80 Z7: TMenuItem;
81 mnuFileRefresh: TMenuItem;
82 pnlPrimaryCare: TKeyClickPanel;
83 lblPtCare: TStaticText;
84 lblPtAttending: TStaticText;
85 pnlCIRN: TKeyClickPanel;
86 lblCIRN: TLabel;
87 lblCIRNData: TLabel;
88 pnlReminders: TKeyClickPanel;
89 imgReminder: TImage;
90 mnuViewReminders: TMenuItem;
91 anmtRemSearch: TAnimate;
92 lstCIRNLocations: TORListBox;
93 popCIRN: TPopupMenu;
94 popCIRNSelectAll: TMenuItem;
95 popCIRNSelectNone: TMenuItem;
96 popCIRNClose: TMenuItem;
97 mnuFilePrintSetup: TMenuItem;
98 LabInfo1: TMenuItem;
99 mnuFileNotifRemove: TMenuItem;
100 Z8: TMenuItem;
101 mnuToolsOptions: TMenuItem;
102 mnuChartSurgery: TMenuItem;
103 OROpenDlg: TOpenDialog;
104 mnuFileResumeContext: TMenuItem;
105 mnuFileResumeContextSet: TMenuItem;
106 Useexistingcontext1: TMenuItem;
107 mnuFileBreakContext: TMenuItem;
108 pnlCCOW: TPanel;
109 imgCCOW: TImage;
110 pnlPatientSelected: TPanel;
111 pnlNoPatientSelected: TPanel;
112 pnlFlag: TKeyClickPanel;
113 lblFlag: TLabel;
114 pnlPostings: TKeyClickPanel;
115 lblPtPostings: TStaticText;
116 lblPtCWAD: TStaticText;
117 mnuFilePrintSelectedItems: TMenuItem;
118 popAlerts: TPopupMenu;
119 mnuAlertContinue: TMenuItem;
120 mnuAlertForward: TMenuItem;
121 mnuAlertRenew: TMenuItem;
122 AppEvents: TApplicationEvents;
123 paVAA: TKeyClickPanel;
124 mnuToolsGraphing: TMenuItem;
125 laVAA2: TButton;
126 laMHV: TButton;
127 lblCIRNAvail: TLabel;
128 mnuViewInformation: TMenuItem;
129 mnuViewVisits: TMenuItem;
130 mnuViewPrimaryCare: TMenuItem;
131 mnuViewMyHealtheVet: TMenuItem;
132 mnuInsurance: TMenuItem;
133 mnuViewFlags: TMenuItem;
134 mnuViewRemoteData: TMenuItem;
135 procedure tabPageChange(Sender: TObject);
136 procedure FormCreate(Sender: TObject);
137 procedure FormResize(Sender: TObject);
138 procedure pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
139 Shift: TShiftState; X, Y: Integer);
140 procedure pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
141 Shift: TShiftState; X, Y: Integer);
142 procedure pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
143 Shift: TShiftState; X, Y: Integer);
144 procedure pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
145 Shift: TShiftState; X, Y: Integer);
146 procedure mnuFileExitClick(Sender: TObject);
147 procedure pnlPostingsMouseDown(Sender: TObject; Button: TMouseButton;
148 Shift: TShiftState; X, Y: Integer);
149 procedure pnlPostingsMouseUp(Sender: TObject; Button: TMouseButton;
150 Shift: TShiftState; X, Y: Integer);
151 procedure mnuFontSizeClick(Sender: TObject);
152 procedure mnuChartTabClick(Sender: TObject);
153 procedure FormDestroy(Sender: TObject);
154 procedure mnuFileOpenClick(Sender: TObject);
155 procedure mnuHelpBrokerClick(Sender: TObject);
156 procedure mnuFileEncounterClick(Sender: TObject);
157 procedure mnuViewPostingsClick(Sender: TObject);
158 procedure mnuHelpAboutClick(Sender: TObject);
159 procedure mnuFileReviewClick(Sender: TObject);
160 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
161 procedure mnuHelpListsClick(Sender: TObject);
162 procedure ToolClick(Sender: TObject);
163 procedure mnuEditClick(Sender: TObject);
164 procedure mnuEditUndoClick(Sender: TObject);
165 procedure mnuEditCutClick(Sender: TObject);
166 procedure mnuEditCopyClick(Sender: TObject);
167 procedure mnuEditPasteClick(Sender: TObject);
168 procedure mnuHelpSymbolsClick(Sender: TObject);
169 procedure FormClose(Sender: TObject; var Action: TCloseAction);
170 procedure mnuFilePrintClick(Sender: TObject);
171 procedure mnuGECStatusClick(Sender: TObject);
172 procedure mnuFileNextClick(Sender: TObject);
173 procedure stsAreaMouseDown(Sender: TObject; Button: TMouseButton;
174 Shift: TShiftState; X, Y: Integer);
175 procedure stsAreaMouseUp(Sender: TObject; Button: TMouseButton;
176 Shift: TShiftState; X, Y: Integer);
177 procedure stsAreaDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
178 const Rect: TRect);
179 procedure pnlPrimaryCareMouseDown(Sender: TObject;
180 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
181 procedure pnlPrimaryCareMouseUp(Sender: TObject; Button: TMouseButton;
182 Shift: TShiftState; X, Y: Integer);
183 function FormHelp(Command: Word; Data: Integer;
184 var CallHelp: Boolean): Boolean;
185 procedure pnlRemindersMouseDown(Sender: TObject; Button: TMouseButton;
186 Shift: TShiftState; X, Y: Integer);
187 procedure pnlRemindersMouseUp(Sender: TObject; Button: TMouseButton;
188 Shift: TShiftState; X, Y: Integer);
189 procedure pnlCIRNClick(Sender: TObject);
190 procedure lstCIRNLocationsClick(Sender: TObject);
191 procedure popCIRNCloseClick(Sender: TObject);
192 procedure popCIRNSelectAllClick(Sender: TObject);
193 procedure popCIRNSelectNoneClick(Sender: TObject);
194 procedure mnuFilePrintSetupClick(Sender: TObject);
195 procedure lstCIRNLocationsChange(Sender: TObject);
196 procedure LabInfo1Click(Sender: TObject);
197 procedure mnuFileNotifRemoveClick(Sender: TObject);
198 procedure mnuToolsOptionsClick(Sender: TObject);
199 procedure mnuFileRefreshClick(Sender: TObject);
200 procedure FormKeyDown(Sender: TObject; var Key: Word;
201 Shift: TShiftState);
202 procedure FormActivate(Sender: TObject);
203 procedure pnlPrimaryCareEnter(Sender: TObject);
204 procedure pnlPrimaryCareExit(Sender: TObject);
205 procedure pnlPatientClick(Sender: TObject);
206 procedure pnlVisitClick(Sender: TObject);
207 procedure pnlPrimaryCareClick(Sender: TObject);
208 procedure pnlRemindersClick(Sender: TObject);
209 procedure pnlPostingsClick(Sender: TObject);
210 procedure ctxContextorCanceled(Sender: TObject);
211 procedure ctxContextorCommitted(Sender: TObject);
212 procedure ctxContextorPending(Sender: TObject;
213 const aContextItemCollection: IDispatch);
214 procedure mnuFileBreakContextClick(Sender: TObject);
215 procedure mnuFileResumeContextGetClick(Sender: TObject);
216 procedure mnuFileResumeContextSetClick(Sender: TObject);
217 procedure pnlFlagMouseDown(Sender: TObject; Button: TMouseButton;
218 Shift: TShiftState; X, Y: Integer);
219 procedure pnlFlagMouseUp(Sender: TObject; Button: TMouseButton;
220 Shift: TShiftState; X, Y: Integer);
221 procedure pnlFlagClick(Sender: TObject);
222 procedure mnuFilePrintSelectedItemsClick(Sender: TObject);
223 procedure mnuAlertRenewClick(Sender: TObject);
224 procedure mnuAlertForwardClick(Sender: TObject);
225 procedure pnlFlagEnter(Sender: TObject);
226 procedure pnlFlagExit(Sender: TObject);
227 procedure tabPageMouseUp(Sender: TObject; Button: TMouseButton;
228 Shift: TShiftState; X, Y: Integer);
229 procedure lstCIRNLocationsExit(Sender: TObject);
230 procedure AppEventsActivate(Sender: TObject);
231 procedure ScreenActiveFormChange(Sender: TObject);
232 procedure AppEventsShortCut(var Msg: TWMKey; var Handled: Boolean);
233 procedure mnuToolsClick(Sender: TObject);
234 procedure mnuToolsGraphingClick(Sender: TObject);
235 procedure pnlCIRNMouseDown(Sender: TObject; Button: TMouseButton;
236 Shift: TShiftState; X, Y: Integer);
237 procedure pnlCIRNMouseUp(Sender: TObject; Button: TMouseButton;
238 Shift: TShiftState; X, Y: Integer);
239 procedure laMHVClick(Sender: TObject);
240 procedure laVAA2Click(Sender: TObject);
241 procedure ViewInfo(Sender: TObject);
242 procedure mnuViewInformationClick(Sender: TObject);
243 private
244 FJustEnteredApp : boolean;
245 FCCOWInstalled: boolean;
246 FCCOWContextChanging: boolean;
247 FCCOWIconName: string;
248 FCCOWDrivedChange: boolean;
249 FCCOWBusy: boolean;
250 FCCOWError: boolean;
251 FNoPatientSelected: boolean;
252 FRefreshing: boolean;
253 FClosing: boolean;
254 FContextChanging: Boolean;
255 FChangeSource: Integer;
256 FCreateProgress: Integer;
257 FEditCtrl: TCustomEdit;
258 FLastPage: TfrmPage;
259 FNextButtonL: Integer;
260 FNextButtonR: Integer;
261 FNextButtonActive: Boolean;
262 FNextButtonBitmap: TBitmap;
263 FTerminate: Boolean;
264 FTabChanged: TNotifyEvent;
265 FOldActivate: TNotifyEvent;
266 FOldActiveFormChange: TNotifyEvent;
267 FECSAuthUser: Boolean;
268 FFixedStatusWidth: integer;
269 FPrevInPatient: Boolean;
270 FFirstLoad: Boolean;
271 FFlagList: TStringList;
272 FPrevPtID: string;
273 FVitalsDLLActive: boolean;
274 FGraphFloatActive: boolean;
275 FGraphContext: string;
276 procedure RefreshFixedStatusWidth;
277 procedure FocusApplicationTopForm;
278 procedure AppActivated(Sender: TObject);
279 procedure AppDeActivated(Sender: TObject);
280 procedure AppException(Sender: TObject; E: Exception);
281 function AllowContextChangeAll(var Reason: string): Boolean;
282 procedure ClearPatient;
283 procedure ChangeFont(NewFontSize: Integer);
284 //procedure CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
285 procedure CreateTab(ATabID: integer; ALabel: string);
286 procedure DetermineNextTab;
287 function ExpandCommand(x: string): string;
288 procedure FitToolbar;
289 procedure LoadSizesForUser;
290 procedure SaveSizesForUser;
291 procedure LoadUserPreferences;
292 procedure SaveUserPreferences;
293 procedure SwitchToPage(NewForm: TfrmPage);
294 function TabToPageID(Tab: Integer): Integer;
295 function TimeoutCondition: boolean;
296 function GetTimedOut: boolean;
297 procedure TimeOutAction;
298 procedure SetUserTools;
299 procedure SetDebugMenu;
300 procedure SetupPatient(AFlaggedList : TStringList = nil);
301 //procedure SetUpCIRN;
302 procedure RemindersChanged(Sender: TObject);
303 procedure ReportsOnlyDisplay;
304 procedure UMInitiate(var Message: TMessage); message UM_INITIATE;
305 procedure UMNewOrder(var Message: TMessage); message UM_NEWORDER;
306 procedure UMStatusText(var Message: TMessage); message UM_STATUSTEXT;
307 procedure UMShowPage(var Message: TMessage); message UM_SHOWPAGE;
308 procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
309 procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
310 procedure UpdateECSParameter(var CmdParameter: string);
311 function ValidECSUser: boolean;
312 procedure StartCCOWContextor;
313 function AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean;
314 procedure UpdateCCOWContext;
315 procedure CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
316 procedure CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
317{$IFDEF CCOWBROKER}
318 procedure CheckForDifferentUser(aContextItemCollection: IDispatch; var UserChanged: boolean);
319{$ENDIF}
320 procedure HideEverything;
321 procedure ShowEverything;
322 //function FindBestCCOWDFN(var APatientName: string): string;
323 function FindBestCCOWDFN: string;
324 procedure HandleCCOWError(AMessage: string);
325 public
326 EnduringPtSelSplitterPos: integer;
327 procedure SetBADxList;
328
329 function PageIDToTab(PageID: Integer): Integer;
330 procedure ShowHideChartTabMenus(AMenuItem: TMenuItem);
331 procedure UpdatePtInfoOnRefresh;
332 function TabExists(ATabID: integer): boolean;
333 procedure DisplayEncounterText;
334 property ChangeSource: Integer read FChangeSource;
335 property CCOWContextChanging: Boolean read FCCOWContextChanging;
336 property CCOWDrivedChange: Boolean read FCCOWDrivedChange;
337 property CCOWBusy: Boolean read FCCOWBusy write FCCOWBusy;
338 property ContextChanging: Boolean read FContextChanging;
339 property TimedOut: Boolean read GetTimedOut;
340 property Closing: Boolean read FClosing;
341 property OnTabChanged: TNotifyEvent read FTabChanged write FTabChanged;
342 property VitalsDLLActive: boolean read FVitalsDLLActive write FVitalsDLLActive;
343 property GraphFloatActive: boolean read FGraphFloatActive write FGraphFloatActive;
344 property GraphContext: string read FGraphContext write FGraphContext;
345 procedure ToggleMenuItemChecked(Sender: TObject);
346 procedure SetUpCIRN;
347 end;
348
349var
350 frmFrame: TfrmFrame;
351 uTabList: TStringList;
352 uRemoteType : string;
353 FlaggedPTList: TStringList;
354 ctxContextor : TContextorControl;
355 NextTab, LastTab: Integer;
356 uToolsMaxed, uToolsWarned: boolean;
357
358const
359 PASSCODE = '_gghwn7pghCrOJvOV61PtPvgdeEU2u5cRsGvpkVDjKT_H7SdKE_hqFYWsUIVT1H7JwT6Yz8oCtd2u2PALqWxibNXx3Yo8GPcTYsNaxW' + 'ZFo8OgT11D5TIvpu3cDQuZd3Yh_nV9jhkvb0ZBGdO9n-uNXPPEK7xfYWCI2Wp3Dsu9YDSd_EM34nvrgy64cqu9_jFJKJnGiXY96Lf1ecLiv4LT9qtmJ-BawYt7O9JZGAswi344BmmCbNxfgvgf0gfGZea';
360
361implementation
362
363{$R *.DFM}
364{$R sBitmaps}
365{$R sRemSrch}
366
367uses
368 ORNet, rCore, fPtSelMsg, fPtSel, fCover, fProbs, fMeds, fOrders, rOrders, fNotes, fConsults, fDCSumm,
369 rMisc, Clipbrd, fLabs, fReports, rReports, fPtDemo, fEncnt, fPtCWAD, uCore, fAbout, fReview, fxBroker,
370 fxLists, fxServer, ORSystem, fRptBox, fSplash, rODAllergy, uInit, fLabTests, fLabInfo,
371 uReminders, fReminderTree, ORClasses, fDeviceSelect, fDrawers, fReminderDialog, ShellAPI, rVitals,
372 fOptions, fGraphs, rTemplates, fSurgery, rSurgery, uEventHooks, uSignItems, fDefaultEvent,rECS,
373 fIconLegend, uOrders, fPtSelOptns, DateUtils, uSpell, uOrPtf, fPatientFlagMulti,
374 fAlertForward, UBAGlobals, fBAOptionsDiagnoses, UBACore, fOrdersSign, uVitals, fOrdersRenew, uFormMonitor
375 {$IFDEF CCOWBROKER}
376 , CCOW_const
377 {$ENDIF}
378 ;
379
380var // RV 05/11/04
381 IsRunExecuted: Boolean = FALSE; // RV 05/11/04
382 GraphFloat: TfrmGraphs;
383
384const
385 // moved to uConst - RV v16
386(* CT_NOPAGE = -1; // chart tab - none selected
387 CT_UNKNOWN = 0; // chart tab - unknown (shouldn't happen)
388 CT_COVER = 1; // chart tab - cover sheet
389 CT_PROBLEMS = 2; // chart tab - problem list
390 CT_MEDS = 3; // chart tab - medications screen
391 CT_ORDERS = 4; // chart tab - doctor's orders
392 CT_HP = 5; // chart tab - history & physical
393 CT_NOTES = 6; // chart tab - progress notes
394 CT_CONSULTS = 7; // chart tab - consults
395 CT_DCSUMM = 8; // chart tab - discharge summaries
396 CT_LABS = 9; // chart tab - laboratory results
397 CT_REPORTS = 10; // chart tab - reports
398 CT_SURGERY = 11; // chart tab - surgery*)
399
400 FCP_UPDATE = 10; // form create about to check auto-update
401 FCP_SETHOOK = 20; // form create about to set timeout hooks
402 FCP_SERVER = 30; // form create about to connect to server
403 FCP_CHKVER = 40; // form create about to check version
404 FCP_OBJECTS = 50; // form create about to create core objects
405 FCP_FORMS = 60; // form create about to create child forms
406 FCP_PTSEL = 70; // form create about to select patient
407 FCP_FINISH = 99; // form create finished successfully
408
409 TX_IN_USE = 'VistA CPRS in use by: ';
410 TX_OPTION = 'OR CPRS GUI CHART';
411 TX_ECSOPT = 'EC GUI CONTEXT';
412 TX_PTINQ = 'Retrieving demographic information...';
413 TX_NOTIF_STOP = 'Stop processing notifications?';
414 TC_NOTIF_STOP = 'Currently Processing Notifications';
415 TX_UNK_NOTIF = 'Unable to process the follow up action for this notification';
416 TC_UNK_NOTIF = 'Follow Up Action Not Implemented';
417 TX_NO_SURG_NOTIF = 'This notification must be processed using the Surgery tab, ' + CRLF +
418 'which is not currently available to you.';
419 TC_NO_SURG_NOTIF = 'Surgery Tab Not Available';
420 TX_VER1 = 'This is version ';
421 TX_VER2 = ' of CPRSChart.exe.';
422 TX_VER3 = CRLF + 'The running server version is ';
423 TX_VER_REQ = ' version server is required.';
424 TX_VER_OLD = CRLF + 'It is strongly recommended that you upgrade.';
425 TX_VER_OLD2 = CRLF + 'The program cannot be run until the client is upgraded.';
426 TX_VER_NEW = CRLF + 'The program cannot be run until the server is upgraded.';
427 TC_VER = 'Server/Client Incompatibility';
428 TC_CLIERR = 'Client Specifications Mismatch';
429
430 SHOW_NOTIFICATIONS = True;
431
432 TC_DGSR_ERR = 'Remote Data Error';
433 TC_DGSR_SHOW = 'Restricted Remote Record';
434 TC_DGSR_DENY = 'Remote Access Denied';
435 TX_DGSR_YESNO = CRLF + 'Do you want to continue accessing this remote patient record?';
436
437 TX_CCOW_LINKED = 'Clinical Link On';
438 TX_CCOW_CHANGING = 'Clinical link changing';
439 TX_CCOW_BROKEN = 'Clinical link broken';
440 TX_CCOW_ERROR = 'CPRS was unable to communicate with the CCOW Context Vault' + CRLF +
441 'CCOW patient synchronization will be unavailable for the remainder of this session.';
442 TC_CCOW_ERROR = 'CCOW Error';
443
444function TfrmFrame.TimeoutCondition: boolean;
445begin
446 Result := (FCreateProgress < FCP_PTSEL);
447end;
448
449function TfrmFrame.GetTimedOut: boolean;
450begin
451 Result := uInit.TimedOut;
452end;
453
454procedure TfrmFrame.TimeOutAction;
455begin
456 if frmFrame.VitalsDLLActive then
457 CloseVitalsDLL()
458 else
459 Close;
460end;
461
462{ General Functions and Procedures }
463
464procedure TfrmFrame.AppException(Sender: TObject; E: Exception);
465var
466 AnAddr: Pointer;
467 ErrMsg: string;
468begin
469 Application.NormalizeTopMosts;
470 if (E is EIntError) then
471 begin
472 ErrMsg := E.Message + CRLF +
473 'CreateProgress: ' + IntToStr(FCreateProgress) + CRLF +
474 'RPC Info: ' + RPCLastCall;
475 if EExternal(E).ExceptionRecord <> nil then
476 begin
477 AnAddr := EExternal(E).ExceptionRecord^.ExceptionAddress;
478 ErrMsg := ErrMsg + CRLF + 'Address was ' + IntToStr(Integer(AnAddr));
479 end;
480 ShowMessage(ErrMsg);
481 end
482 else if (E is EBrokerError) then
483 begin
484 Application.ShowException(E);
485 FCreateProgress := FCP_FORMS;
486 Close;
487 end
488 else if (E is EOleException) then
489 begin
490 Application.ShowException(E);
491 FCreateProgress := FCP_FORMS;
492 Close;
493 end
494 else Application.ShowException(E);
495 Application.RestoreTopMosts;
496end;
497
498function TfrmFrame.AllowContextChangeAll(var Reason: string): Boolean;
499var
500 Silent: Boolean;
501begin
502 if pnlNoPatientSelected.Visible then
503 begin
504 Result := True;
505 exit;
506 end;
507 FContextChanging := True;
508 Result := True;
509 if COMObjectActive or SpellCheckInProgress or VitalsDLLActive then
510 begin
511 Reason := 'COM_OBJECT_ACTIVE';
512 Result:= False;
513 end;
514 if Result then Result := frmCover.AllowContextChange(Reason);
515 if Result then Result := frmProblems.AllowContextChange(Reason);
516 if Result then Result := frmMeds.AllowContextChange(Reason);
517 if Result then Result := frmOrders.AllowContextChange(Reason);
518 if Result then Result := frmNotes.AllowContextChange(Reason);
519 if Result then Result := frmConsults.AllowContextChange(Reason);
520 if Result then Result := frmDCSumm.AllowContextChange(Reason);
521 if Result then
522 if Assigned(frmSurgery) then Result := frmSurgery.AllowContextChange(Reason);;
523 if Result then Result := frmLabs.AllowContextChange(Reason);;
524 if Result then Result := frmReports.AllowContextChange(Reason);
525 if (not User.IsReportsOnly) then
526 if Result and Changes.RequireReview then //Result := ReviewChanges(TimedOut);
527 case BOOLCHAR[FCCOWContextChanging] of
528 '1': begin
529 if Changes.RequireReview then
530 begin
531 Reason := 'Items will be left unsigned.';
532 Result := False;
533 end
534 else
535 Result := True;
536 end;
537 '0': begin
538 Silent := (TimedOut) or (Reason = 'COMMIT');
539 Result := ReviewChanges(Silent);
540 end;
541 end;
542 FContextChanging := False;
543end;
544
545procedure TfrmFrame.ClearPatient;
546{ call all pages to make sure patient related information is cleared (when switching patients) }
547begin
548 if frmFrame.Timedout then Exit; // added to correct Access Violation when "Refresh Patient Information" selected
549 lblPtName.Caption := '';
550 lblPtSSN.Caption := '';
551 lblPtAge.Caption := '';
552 pnlPatient.Caption := '';
553 lblPtCWAD.Caption := '';
554 lblPtLocation.Caption := 'Visit Not Selected';
555 lblPtProvider.Caption := 'Current Provider Not Selected';
556 pnlVisit.Caption := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
557 lblPtCare.Caption := 'Primary Care Team Unassigned';
558 lblPtAttending.Caption := '';
559 pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption;
560 frmCover.ClearPtData;
561 frmProblems.ClearPtData;
562 frmMeds.ClearPtData;
563 frmOrders.ClearPtData;
564 frmNotes.ClearPtData;
565 frmConsults.ClearPtData;
566 frmDCSumm.ClearPtData;
567 if Assigned(frmSurgery) then frmSurgery.ClearPtData;
568 frmLabs.ClearPtData;
569 frmReports.ClearPtData;
570 tabPage.TabIndex := PageIDToTab(CT_NOPAGE); // to make sure DisplayPage gets called
571 tabPageChange(tabPage);
572 ClearReminderData;
573 SigItems.Clear;
574 lstCIRNLocations.Clear;
575 uRemoteType := '';
576 ClearFlag;
577 if Assigned(FlagList) then FlagList.Clear;
578 HasFlag := False;
579 HidePatientSelectMessages;
580 if (GraphFloat <> nil) and GraphFloatActive then
581 with GraphFloat do
582 begin
583 Initialize;
584 DisplayData('top');
585 DisplayData('bottom');
586 lstCheck.Items.Clear;
587 Caption := 'CPRS Graphing - Patient: ' + MixedCase(Patient.Name);
588 end;
589end;
590
591procedure TfrmFrame.DisplayEncounterText;
592{ updates the display in the header bar of encounter related information (location & provider) }
593begin
594 with Encounter do
595 begin
596 if Length(LocationText) > 0
597 then lblPtLocation.Caption := LocationText
598 else lblPtLocation.Caption := 'Visit Not Selected';
599 if Length(ProviderName) > 0
600 then lblPtProvider.Caption := 'Provider: ' + ProviderName
601 else lblPtProvider.Caption := 'Current Provider Not Selected';
602 end;
603 pnlVisit.Caption := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
604 FitToolBar;
605end;
606
607{ Form Events (Create, Destroy) ----------------------------------------------------------- }
608
609procedure TfrmFrame.RefreshFixedStatusWidth;
610begin
611 with stsArea do
612 FFixedStatusWidth := Panels[0].Width + Panels[2].Width + Panels[3].Width + Panels[4].Width;
613end;
614
615procedure TfrmFrame.FormCreate(Sender: TObject);
616{ connect to server, create tab pages, select a patient, & initialize core objects }
617var
618 ClientVer, ServerVer, ServerReq: string;
619begin
620 FJustEnteredApp := false;
621 SizeHolder := TSizeHolder.Create;
622 FOldActiveFormChange := Screen.OnActiveFormChange;
623 Screen.OnActiveFormChange := ScreenActiveFormChange;
624 if not (ParamSearch('CCOW')='DISABLE') then
625 try
626 StartCCOWContextor;
627 except
628 IsRunExecuted := False;
629 FCCOWInstalled := False;
630 pnlCCOW.Visible := False;
631 mnuFileResumeContext.Visible := False;
632 mnuFileBreakContext.Visible := False;
633 end
634 else
635 begin
636 IsRunExecuted := False;
637 FCCOWInstalled := False;
638 pnlCCOW.Visible := False;
639 mnuFileResumeContext.Visible := False;
640 mnuFileBreakContext.Visible := False;
641 end;
642 RefreshFixedStatusWidth;
643 FTerminate := False;
644 AutoUpdateCheck;
645
646 FFlagList := TStringList.Create;
647
648 // setup initial timeout here so can timeout logon
649 FCreateProgress := FCP_SETHOOK;
650 InitTimeOut(TimeoutCondition, TimeOutAction);
651
652 // connect to the server and create an option context
653 FCreateProgress := FCP_SERVER;
654
655{$IFDEF CCOWBROKER}
656 EnsureBroker;
657 if ctxContextor <> nil then
658 begin
659 if ParamSearch('CCOW') = 'PATIENTONLY' then
660 RPCBrokerV.Contextor := nil
661 else
662 RPCBrokerV.Contextor := ctxContextor;
663 end
664 else
665 RPCBrokerV.Contextor := nil;
666{$ENDIF}
667
668 if not ConnectToServer(TX_OPTION) then
669 begin
670 if Assigned(RPCBrokerV) then
671 InfoBox(RPCBrokerV.RPCBError, 'Error', MB_OK or MB_ICONERROR);
672 Close;
673 Exit;
674 end;
675
676 if ctxContextor <> nil then
677 begin
678 if not (ParamSearch('CCOW') = 'PATIENTONLY') then
679 ctxContextor.NotificationFilter := ctxContextor.NotificationFilter + ';User';
680 end;
681
682 FECSAuthUser := ValidECSUser;
683 uECSReport := TECSReport.Create;
684 uECSReport.ECSPermit := FECSAuthUser;
685 RPCBrokerV.CreateContext(TX_OPTION);
686 Application.OnException := AppException;
687 FOldActivate := Application.OnActivate;
688 Application.OnActivate := AppActivated;
689 Application.OnDeActivate := AppDeActivated;
690
691 // create initial core objects
692 FCreateProgress := FCP_OBJECTS;
693 User := TUser.Create;
694
695 // make sure we're using the matching server version
696 FCreateProgress := FCP_CHKVER;
697 ClientVer := ClientVersion(Application.ExeName);
698 ServerVer := ServerVersion(TX_OPTION, ClientVer);
699 if (ServerVer = '0.0.0.0') then
700 begin
701 InfoBox('Unable to determine current version of server.', TX_OPTION, MB_OK);
702 Close;
703 Exit;
704 end;
705 ServerReq := Piece(FileVersionValue(Application.ExeName, FILE_VER_INTERNALNAME), ' ', 1);
706 if (ClientVer <> ServerReq) then
707 begin
708 InfoBox('Client "version" does not match client "required" server.', TC_CLIERR, MB_OK);
709 Close;
710 Exit;
711 end;
712 if (CompareVersion(ServerVer, ServerReq) <> 0) then
713 begin
714 if (sCallV('ORWU DEFAULT DIVISION', [nil]) = '1') then
715 begin
716 if (InfoBox('Proceed with mismatched Client and Server versions?', TC_CLIERR, MB_YESNO) = ID_NO) then
717 begin
718 Close;
719 Exit;
720 end;
721 end
722 else
723 begin
724 if (CompareVersion(ServerVer, ServerReq) > 0) then // Server newer than Required
725 begin
726 // NEXT LINE COMMENTED OUT - CHANGED FOR VERSION 19.16, PATCH OR*3*155:
727 // if GetUserParam('ORWOR REQUIRE CURRENT CLIENT') = '1' then
728 if (true) then // "True" statement guarantees "required" current version client.
729 begin
730 InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD2, TC_VER, MB_OK);
731 Close;
732 Exit;
733 end;
734 end
735 else InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD, TC_VER, MB_OK);
736 end;
737 if (CompareVersion(ServerVer, ServerReq) < 0) then // Server older then Required
738 begin
739 InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_NEW, TC_VER, MB_OK);
740 Close;
741 Exit;
742 end;
743 end;
744
745 // Add future tabs here as they are created/implemented:
746 if (
747 (not User.HasCorTabs) and
748 (not User.HasRptTab)
749 )
750 then
751 begin
752 InfoBox('No valid tabs assigned', 'Tab Access Problem', MB_OK);
753 Close;
754 Exit;
755 end;
756
757 // create creating core objects
758 Patient := TPatient.Create;
759 Encounter := TEncounter.Create;
760 Changes := TChanges.Create;
761 Notifications := TNotifications.Create;
762 RemoteSites := TRemoteSiteList.Create;
763 RemoteReports := TRemoteReportList.Create;
764 uTabList := TStringList.Create;
765 FlaggedPTList := TStringList.Create;
766 HasFlag := False;
767 FlagList := TStringList.Create;
768 // set up structures specific to the user
769 Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')';
770 SetDebugMenu;
771 if InteractiveRemindersActive then
772 NotifyWhenRemindersChange(RemindersChanged);
773 // load all the tab pages
774 FCreateProgress := FCP_FORMS;
775 //CreateTab(TObject(frmProblems), TfrmProblems, CT_PROBLEMS, 'Problems');
776 CreateTab(CT_PROBLEMS, 'Problems');
777 CreateTab(CT_MEDS, 'Meds');
778 CreateTab(CT_ORDERS, 'Orders');
779 CreateTab(CT_NOTES, 'Notes');
780 CreateTab(CT_CONSULTS, 'Consults');
781 if ShowSurgeryTab then CreateTab(CT_SURGERY, 'Surgery');
782 CreateTab(CT_DCSUMM, 'D/C Summ');
783 CreateTab(CT_LABS, 'Labs');
784 CreateTab(CT_REPORTS, 'Reports');
785 CreateTab(CT_COVER, 'Cover Sheet');
786 ShowHideChartTabMenus(mnuViewChart);
787 // We defer calling LoadUserPreferences to UMInitiate, so that the font sizing
788 // routines recognize this as the application's main form (this hasn't been
789 // set yet).
790 FNextButtonBitmap := TBitmap.Create;
791 FNextButtonBitmap.LoadFromResourceName(hInstance, 'BMP_HANDRIGHT');
792 // set the timeout to DTIME now that there is a connection
793 UpdateTimeOutInterval(User.DTIME * 1000); // DTIME * 1000 mSec
794 // get a patient
795 HandleNeeded; // make sure handle is there for ORWPT SHARE call
796 FCreateProgress := FCP_PTSEL;
797 Enabled := False;
798 FFirstLoad := True; // First time to initialize the fFrame
799 FCreateProgress := FCP_FINISH;
800 pnlReminders.Visible := InteractiveRemindersActive;
801 GraphFloatActive := false;
802 GraphContext := '';
803 uRemoteType := '';
804 FPrevPtID := '';
805 SetUserTools;
806 EnduringPtSelSplitterPos := 0;
807 if User.IsReportsOnly then // Reports Only tab.
808 ReportsOnlyDisplay; // Calls procedure to hide all components/menus not needed.
809 InitialOrderVariables;
810 PostMessage(Handle, UM_INITIATE, 0, 0); // select patient after main form is created
811// mnuFileOpenClick(Self);
812// if Patient.DFN = '' then //*DFN*
813// begin
814// Close;
815// Exit;
816// end;
817// if WindowState = wsMinimized then WindowState := wsNormal;
818 SetFormMonitoring(true);
819end;
820
821procedure TfrmFrame.StartCCOWContextor;
822begin
823 try
824 ctxContextor := TContextorControl.Create(Self);
825 with ctxContextor do
826 begin
827 OnPending := ctxContextorPending;
828 OnCommitted := ctxContextorCommitted;
829 OnCanceled := ctxContextorCanceled;
830 end;
831 FCCOWBusy := False;
832 FCCOWInstalled := True;
833 FCCOWDrivedChange := False;
834 ctxContextor.Run('CPRSChart', '', TRUE, 'Patient');
835 IsRunExecuted := True;
836 except
837 on exc : EOleException do
838 begin
839 IsRunExecuted := False;
840 FreeAndNil(ctxContextor);
841 try
842 ctxContextor := TContextorControl.Create(Self);
843 with ctxContextor do
844 begin
845 OnPending := ctxContextorPending;
846 OnCommitted := ctxContextorCommitted;
847 OnCanceled := ctxContextorCanceled;
848 end;
849 FCCOWBusy := False;
850 FCCOWInstalled := True;
851 FCCOWDrivedChange := False;
852 ctxContextor.Run('CPRSChart' + '#', '', TRUE, 'Patient');
853 IsRunExecuted := True;
854 if ParamSearch('CCOW') = 'FORCE' then
855 begin
856 mnuFileResumeContext.Enabled := False;
857 mnuFileBreakContext.Visible := True;
858 mnuFileBreakContext.Enabled := True;
859 end
860 else
861 begin
862 ctxContextor.Suspend;
863 mnuFileResumeContext.Visible := True;
864 mnuFileBreakContext.Visible := True;
865 mnuFileBreakContext.Enabled := False;
866 end;
867 except
868 IsRunExecuted := False;
869 FCCOWInstalled := False;
870 FreeAndNil(ctxContextor);
871 pnlCCOW.Visible := False;
872 mnuFileResumeContext.Visible := False;
873 mnuFileBreakContext.Visible := False;
874 end;
875 end;
876 end
877end;
878
879procedure TfrmFrame.UMInitiate(var Message: TMessage);
880begin
881 NotifyOtherApps(NAE_OPEN, IntToStr(User.DUZ));
882 LoadUserPreferences;
883 GetBAStatus(User.DUZ,Patient.DFN);
884 mnuFileOpenClick(Self);
885 Enabled := True;
886 // If TimedOut, Close has already been called.
887 if not TimedOut and (Patient.DFN = '') then Close;
888end;
889
890procedure TfrmFrame.FormDestroy(Sender: TObject);
891{ free core objects used by CPRS }
892begin
893 Application.OnActivate := FOldActivate;
894 Screen.OnActiveFormChange := FOldActiveFormChange;
895 FNextButtonBitmap.Free;
896 uTabList.Free;
897 FlaggedPTList.Free;
898 RemoteSites.Free;
899 RemoteReports.Free;
900 Notifications.Free;
901 Changes.Free;
902 Encounter.Free;
903 Patient.Free;
904 User.Free;
905 SizeHolder.Free;
906 ctxContextor.Free;
907end;
908
909procedure TfrmFrame.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
910{ cancels close if the user cancels the ReviewChanges screen }
911var
912 Reason: string;
913begin
914 if (FCreateProgress < FCP_FINISH) then Exit;
915 if User.IsReportsOnly then // Reports Only tab.
916 exit;
917 if TimedOut then
918 begin
919 if Changes.RequireReview then ReviewChanges(TimedOut);
920 Exit;
921 end;
922 if not AllowContextChangeAll(Reason) then CanClose := False;
923end;
924
925procedure TfrmFrame.SetUserTools;
926var
927 ToolItems: TToolItemList;
928 i: Integer;
929 UserTool: TMenuItem;
930 MaxedOut: boolean;
931 // OptionsClick: TNotifyEvent;
932begin
933 if User.IsReportsOnly then // Reports Only tab.
934 begin
935 mnuTools.Clear; // Remove all current items.
936 UserTool := TMenuItem.Create(Self);
937 UserTool.Caption := 'Options...';
938 UserTool.Hint := 'Options';
939 UserTool.OnClick := mnuToolsOptionsClick;
940 mnuTools.Add(UserTool); // Add back the "Options" menu.
941 exit;
942 end;
943 if User.GECStatus then
944 begin
945 UserTool := TMenuItem.Create(self);
946 UserTool.Caption := 'GEC Referral Status Display';
947 UserTool.Hint := 'GEC Referral Status Display';
948 UserTool.OnClick := mnuGECStatusClick;
949 mnuTools.Add(UserTool); // Add back the "Options" menu.
950 //exit;
951 end;
952 GetToolMenu(ToolItems, MaxedOut); // For all other users, proceed normally with creation of Tools menu:
953 for i := Low(ToolItems) to High(ToolItems) do
954 begin
955 if (AnsiCompareText(ToolItems[i].Caption, 'Event Capture Interface') = 0 ) and
956 (not uECSReport.ECSPermit) then
957 begin
958 ToolItems[i].Caption := '';
959 ToolItems[i].Action := '';
960 Break;
961 end;
962 end;
963 if MaxedOut then
964 begin
965 uToolsMaxed := True;
966 uToolsWarned := False;
967 end;
968 for i := 0 to MAX_TOOLITEMS do with ToolItems[i] do if Length(Caption) > 0 then
969 begin
970 UserTool := TMenuItem.Create(Self);
971 UserTool.Caption := Caption;
972 UserTool.Hint := Action;
973 UserTool.OnClick := ToolClick;
974 mnuTools.Insert(i, UserTool);
975 end;
976end;
977
978procedure TfrmFrame.mnuToolsClick(Sender: TObject);
979const
980 TX_TOO_MANY_TOOLS = 'Some defined items may not be shown';
981 TC_TOO_MANY_TOOLS = 'Tool Menu Limit Exceeded';
982begin
983 if uToolsMaxed and (not uToolsWarned) then
984 begin
985 InfoBox(TX_TOO_MANY_TOOLS, TC_TOO_MANY_TOOLS, MB_ICONWARNING or MB_OK);
986 uToolsWarned := True;
987 end;
988end;
989
990procedure TfrmFrame.UpdateECSParameter(var CmdParameter: string); //ECS
991var
992 vstID,AccVer,Svr,SvrPort,VUser: string;
993begin
994 AccVer := '';
995 Svr := '';
996 SvrPort := '';
997 VUser := '';
998 if RPCBrokerV <> nil then
999 begin
1000 AccVer := RPCBrokerV.AccessVerifyCodes;
1001 Svr := RPCBrokerV.Server;
1002 SvrPort := IntToStr(RPCBrokerV.ListenerPort);
1003 VUser := RPCBrokerV.User.DUZ;
1004 end;
1005 vstID := GetVisitID;
1006 CmdParameter :=' Svr=' +Svr
1007 +' SvrPort='+SvrPort
1008 +' VUser='+ VUser
1009 +' PtIEN='+ Patient.DFN
1010 +' PdIEN='+IntToStr(Encounter.Provider)
1011 +' vstIEN='+vstID
1012 +' locIEN='+IntToStr(Encounter.Location)
1013 +' Date=0'
1014 +' Division='+GetDivisionID;
1015
1016end;
1017
1018function TfrmFrame.ValidECSUser: boolean; //ECS
1019var
1020 isTrue: boolean;
1021begin
1022 Result := True;
1023 with RPCBrokerV do
1024 begin
1025 ShowErrorMsgs := semQuiet;
1026 Connected := True;
1027 try
1028 isTrue := CreateContext(TX_ECSOPT);
1029 if not isTrue then
1030 Result := False;
1031 ShowErrorMsgs := semRaise;
1032 except
1033 on E: Exception do
1034 begin
1035 ShowErrorMsgs := semRaise;
1036 Result := False;
1037 end;
1038 end;
1039 end;
1040end;
1041
1042procedure TfrmFrame.FormClose(Sender: TObject; var Action: TCloseAction);
1043//var
1044// i: Integer;
1045// UserTool: TMenuItem;
1046begin
1047 FClosing := TRUE;
1048 SetFormMonitoring(false);
1049 if FCreateProgress < FCP_FINISH then FTerminate := True;
1050
1051 FlushNotifierBuffer;
1052 if FCreateProgress = FCP_FINISH then NotifyOtherApps(NAE_CLOSE, '');
1053 TerminateOtherAppNotification;
1054
1055 if GraphFloat <> nil then
1056 begin
1057 if frmFrame.GraphFloatActive then
1058 GraphFloat.Close;
1059 GraphFloat.Release;
1060 end;
1061
1062 // unhook the timeout hooks
1063 ShutDownTimeOut;
1064 // clearing changes will unlock notes
1065 if FCreateProgress = FCP_FINISH then Changes.Clear;
1066 // clear server side flag global tmp
1067 if FCreateProgress = FCP_FINISH then ClearFlag;
1068 // save user preferences
1069 if FCreateProgress = FCP_FINISH then SaveUserPreferences;
1070 // call close for each page in case there is any special processing
1071 if FCreateProgress > FCP_FORMS then
1072 begin
1073 mnuFrame.Merge(nil);
1074 frmCover.Close; //frmCover.Release;
1075 frmProblems.Close; //frmProblems.Release;
1076 frmMeds.Close; //frmMeds.Release;
1077 frmOrders.Close; //frmOrders.Release;
1078 frmNotes.Close; //frmNotes.Release;
1079 frmConsults.Close; //frmConsults.Release;
1080 frmDCSumm.Close; //frmDCSumm.Release;
1081 if Assigned(frmSurgery) then frmSurgery.Close; //frmSurgery.Release;
1082 frmLabs.Close; //frmLabs.Release;
1083 frmReports.Close; //frmReports.Release;
1084 end;
1085// with mnuTools do for i := Count - 1 downto 0 do
1086// begin
1087// UserTool := Items[i];
1088// if UserTool <> nil then
1089// begin
1090// Delete(i);
1091// UserTool.Free;
1092// end;
1093// end;
1094 //Application.ProcessMessages; // so everything finishes closing
1095 // if < FCP_FINISH we came here from inside FormCreate, so need to call terminate
1096 //if GraphFloat <> nil then GraphFloat.Release;
1097 if FCreateProgress < FCP_FINISH then Application.Terminate;
1098end;
1099
1100procedure TfrmFrame.SetDebugMenu;
1101var
1102 IsProgrammer: Boolean;
1103begin
1104 IsProgrammer := User.HasKey('XUPROGMODE');
1105 mnuHelpBroker.Visible := IsProgrammer;
1106 mnuHelpLists.Visible := IsProgrammer;
1107 mnuHelpSymbols.Visible := IsProgrammer;
1108 Z6.Visible := IsProgrammer;
1109end;
1110
1111{ Updates posted to MainForm --------------------------------------------------------------- }
1112
1113procedure TfrmFrame.UMNewOrder(var Message: TMessage);
1114{ post a notice of change in orders to all TPages, wParam=OrderAction, lParam=TOrder }
1115var
1116 OrderAct: string;
1117begin
1118 with Message do
1119 begin
1120 frmCover.NotifyOrder(WParam, TOrder(LParam));
1121 frmProblems.NotifyOrder(WParam, TOrder(LParam));
1122 frmMeds.NotifyOrder(WParam, TOrder(LParam));
1123 frmOrders.NotifyOrder(WParam, TOrder(LParam));
1124 frmNotes.NotifyOrder(WParam, TOrder(LParam));
1125 frmConsults.NotifyOrder(WParam, TOrder(LParam));
1126 frmDCSumm.NotifyOrder(WParam, TOrder(LParam));
1127 if Assigned(frmSurgery) then frmSurgery.NotifyOrder(WParam, TOrder(LParam));
1128 frmLabs.NotifyOrder(WParam, TOrder(LParam));
1129 frmReports.NotifyOrder(WParam, TOrder(LParam));
1130 lblPtCWAD.Caption := GetCWADInfo(Patient.DFN);
1131 if Length(lblPtCWAD.Caption) > 0
1132 then lblPtPostings.Caption := 'Postings'
1133 else lblPtPostings.Caption := 'No Postings';
1134 pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
1135 OrderAct := '';
1136 case WParam of
1137 ORDER_NEW: OrderAct := 'NW';
1138 ORDER_DC: OrderAct := 'DC';
1139 ORDER_RENEW: OrderAct := 'RN';
1140 ORDER_HOLD: OrderAct := 'HD';
1141 ORDER_EDIT: OrderAct := 'XX';
1142 ORDER_ACT: OrderAct := 'AC';
1143 end;
1144 if Length(OrderAct) > 0 then NotifyOtherApps(NAE_ORDER, OrderAct + U + TOrder(LParam).ID); // add FillerID
1145 end;
1146end;
1147
1148{ Tab Selection (navigate between pages) --------------------------------------------------- }
1149
1150procedure TfrmFrame.WMSetFocus(var Message: TMessage);
1151begin
1152 if (FLastPage <> nil) and (not TimedOut) and
1153 (not (csDestroying in FLastPage.ComponentState)) and FLastPage.Visible
1154 then FLastPage.FocusFirstControl;
1155end;
1156
1157procedure TfrmFrame.UMShowPage(var Message: TMessage);
1158{ shows a page when the UM_SHOWPAGE message is received }
1159begin
1160 if FCCOWDrivedChange then FCCOWDrivedChange := False;
1161 if FLastPage <> nil then FLastPage.DisplayPage;
1162 FChangeSource := CC_CLICK; // reset to click so we're only dealing with exceptions to click
1163 if assigned(FTabChanged) then
1164 FTabChanged(Self);
1165end;
1166
1167procedure TfrmFrame.SwitchToPage(NewForm: TfrmPage);
1168{ unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code }
1169begin
1170 if FLastPage = NewForm then
1171 begin
1172 if Notifications.Active then PostMessage(Handle, UM_SHOWPAGE, 0, 0);
1173 Exit;
1174 end;
1175 if (FLastPage <> nil) then
1176 begin
1177 mnuFrame.Unmerge(FLastPage.Menu);
1178 FLastPage.Hide;
1179 end;
1180 if Assigned(NewForm) then
1181 begin
1182 {if ((FLastPage = frmOrders) and (NewForm.Name <> frmMeds.Name))
1183 or ((FLastPage = frmMeds) and (NewForm.Name <> frmOrders.Name)) then
1184 begin
1185 if not CloseOrdering then
1186 Exit;
1187 end;}
1188 mnuFrame.Merge(NewForm.Menu);
1189 NewForm.Show;
1190 end;
1191 lstCIRNLocations.Visible := False;
1192 pnlCIRN.BevelOuter := bvRaised;
1193 lstCIRNLocations.SendToBack;
1194 mnuFilePrint.Enabled := False; // let individual page enable this
1195 mnuFilePrintSetup.Enabled := False; // let individual page enable this
1196 mnuFilePrintSelectedItems.Enabled := False;
1197 FLastPage := NewForm;
1198 if NewForm <> nil then
1199 begin
1200 if NewForm.Name = frmNotes.Name then frmNotes.Align := alClient
1201 else frmNotes.Align := alNone;
1202 if NewForm.Name = frmConsults.Name then frmConsults.Align := alClient
1203 else frmConsults.Align := alNone;
1204 if NewForm.Name = frmDCSumm.Name then frmDCSumm.Align := alClient
1205 else frmDCSumm.Align := alNone;
1206 if Assigned(frmSurgery) then
1207 if NewForm.Name = frmSurgery.Name then frmSurgery.Align := alclient
1208 else frmSurgery.Align := alNone;
1209 NewForm.BringToFront; // to cause tab switch to happen immediately
1210 NewForm.FocusFirstControl;
1211 Application.ProcessMessages;
1212 PostMessage(Handle, UM_SHOWPAGE, 0, 0); // this calls DisplayPage for the form
1213 end;
1214end;
1215
1216procedure TfrmFrame.mnuChartTabClick(Sender: TObject);
1217{ use the Tag property of the menu item to switch to proper page }
1218begin
1219 with Sender as TMenuItem do tabPage.TabIndex := PageIDToTab(Tag);
1220 LastTab := TabToPageID(tabPage.TabIndex) ;
1221 tabPageChange(tabPage);
1222end;
1223
1224procedure TfrmFrame.tabPageChange(Sender: TObject);
1225{ switches to form linked to NewTab }
1226begin
1227
1228 if (not User.IsReportsOnly) then
1229 begin
1230 case TabToPageID((sender as TTabControl).TabIndex) of
1231 CT_NOPAGE: SwitchToPage(nil);
1232 CT_COVER: SwitchToPage(frmCover);
1233 CT_PROBLEMS: SwitchToPage(frmProblems);
1234 CT_MEDS: SwitchToPage(frmMeds);
1235 CT_ORDERS: SwitchToPage(frmOrders);
1236 CT_NOTES: SwitchToPage(frmNotes);
1237 CT_CONSULTS: SwitchToPage(frmConsults);
1238 CT_DCSUMM: SwitchToPage(frmDCSumm);
1239 CT_SURGERY: SwitchToPage(frmSurgery);
1240 CT_LABS: SwitchToPage(frmLabs);
1241 CT_REPORTS: SwitchToPage(frmReports);
1242 end; {case}
1243 end
1244 else // Reports Only tab.
1245 SwitchToPage(frmReports);
1246
1247end;
1248
1249function TfrmFrame.PageIDToTab(PageID: Integer): Integer;
1250{ returns the tab index that corresponds to a given PageID }
1251VAR
1252 i: integer;
1253begin
1254 i := uTabList.IndexOf(IntToStr(PageID));
1255 Result := i;
1256 //Result := uTabList.IndexOf(IntToStr(PageID));
1257 (*
1258 Result := -1;
1259 case PageID of
1260 CT_NOPAGE: Result := -1;
1261 CT_COVER: Result := 0;
1262 CT_PROBLEMS: Result := 1;
1263 CT_MEDS: Result := 2;
1264 CT_ORDERS: Result := 3;
1265 {CT_HP: Result := 4;}
1266 CT_NOTES: Result := 4;
1267 CT_CONSULTS: Result := 5;
1268 CT_DCSUMM: Result := 6;
1269 CT_LABS: Result := 7;
1270 CT_REPORTS: Result := 8;
1271 end;*)
1272end;
1273
1274function TfrmFrame.TabToPageID(Tab: Integer): Integer;
1275{ returns the constant that identifies the page given a TabIndex }
1276begin
1277 if (Tab > -1) and (Tab < uTabList.Count) then
1278 Result := StrToIntDef(uTabList[Tab], CT_UNKNOWN)
1279 else
1280 Result := CT_NOPAGE;
1281(* case Tab of
1282 -1: Result := CT_NOPAGE;
1283 0: Result := CT_COVER;
1284 1: Result := CT_PROBLEMS;
1285 2: Result := CT_MEDS;
1286 3: Result := CT_ORDERS;
1287 {4: Result := CT_HP;}
1288 4: Result := CT_NOTES;
1289 5: Result := CT_CONSULTS;
1290 6: Result := CT_DCSUMM;
1291 7: Result := CT_LABS;
1292 8: Result := CT_REPORTS;
1293 end;*)
1294end;
1295
1296{ File Menu Events ------------------------------------------------------------------------- }
1297
1298procedure TfrmFrame.SetupPatient(AFlaggedList : TStringList);
1299var
1300 AMsg, SelectMsg: string;
1301begin
1302 with Patient do
1303 begin
1304 ClearPatient; // must be called to avoid leaving previous patient's information visible!
1305 Visible := True;
1306 Application.ProcessMessages;
1307 lblPtName.Caption := Name;
1308 lblPtSSN.Caption := SSN;
1309 lblPtAge.Caption := FormatFMDateTime('mmm dd,yyyy', DOB) + ' (' + IntToStr(Age) + ')';
1310 pnlPatient.Caption := lblPtName.Caption + ' ' + lblPtSSN.Caption + ' ' + lblPtAge.Caption;
1311 if Length(CWAD) > 0
1312 then lblPtPostings.Caption := 'Postings'
1313 else lblPtPostings.Caption := 'No Postings';
1314 lblPtCWAD.Caption := CWAD;
1315 pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
1316 if (Length(PrimaryTeam) > 0) or (Length(PrimaryProvider) > 0)
1317 then lblPtCare.Caption := PrimaryTeam + ' / ' + MixedCase(PrimaryProvider);
1318 if Length(Attending) > 0 then lblPtAttending.Caption := 'Attending: ' + MixedCase(Attending);
1319 pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption;
1320 SetUpCIRN;
1321 DisplayEncounterText;
1322 SetShareNode(DFN, Handle);
1323 with Patient do
1324 NotifyOtherApps(NAE_NEWPT, SSN + U + FloatToStr(DOB) + U + Name);
1325 SelectMsg := '';
1326 if MeansTestRequired(Patient.DFN, AMsg) then SelectMsg := AMsg;
1327 if HasLegacyData(Patient.DFN, AMsg) then SelectMsg := SelectMsg + CRLF + AMsg;
1328
1329 HasActiveFlg(FlagList, HasFlag, Patient.DFN);
1330 if HasFlag then
1331 begin
1332 pnlFlag.Enabled := True;
1333 lblFlag.Font.Color := clMaroon;
1334 lblFlag.Enabled := True;
1335 if (not FReFreshing) and (TriggerPRFPopUp(Patient.DFN)) then
1336 ShowFlags;
1337 end else
1338 begin
1339 pnlFlag.Enabled := False;
1340 lblFlag.Font.Color := clBtnFace;
1341 lblFlag.Enabled := False;
1342 end;
1343 FPrevPtID := patient.DFN;
1344 frmCover.UpdateVAAButton; //VAA CQ7525 (moved here in v26.30 (RV))
1345 ProcessPatientChangeEventHook;
1346 if Length(SelectMsg) > 0 then ShowPatientSelectMessages(SelectMsg);
1347 end;
1348end;
1349
1350procedure TfrmFrame.mnuFileNextClick(Sender: TObject);
1351var
1352 SaveDFN, NewDFN: string; // *DFN*
1353 NextIndex: Integer;
1354 Reason: string;
1355 CCOWResponse: UserResponse;
1356begin
1357 SaveDFN := Patient.DFN;
1358 Notifications.Next;
1359 if Notifications.Active then
1360 begin
1361 NewDFN := Notifications.DFN;
1362 //Patient.DFN := Notifications.DFN;
1363 //if SaveDFN <> Patient.DFN then
1364 if SaveDFN <> NewDFN then
1365 begin
1366 // newdfn does not have new patient.co information for CCOW call
1367 if (AllowContextChangeAll(Reason)) then
1368 begin
1369 RemindersStarted := FALSE;
1370 Patient.DFN := NewDFN;
1371 Encounter.Clear;
1372 Changes.Clear;
1373 if Assigned(FlagList) then
1374 begin
1375 FlagList.Clear;
1376 HasFlag := False;
1377 HasActiveFlg(FlagList, HasFlag, NewDFN);
1378 end;
1379 if (FCCOWInstalled and (ctxContextor.State = csSuspended)) or (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
1380 begin
1381 if Patient.Inpatient then
1382 begin
1383 Encounter.Inpatient := True;
1384 Encounter.Location := Patient.Location;
1385 Encounter.DateTime := Patient.AdmitTime;
1386 Encounter.VisitCategory := 'H';
1387 end;
1388 if User.IsProvider then Encounter.Provider := User.DUZ;
1389 SetupPatient(FlaggedPTList);
1390 if (FlaggedPTList.IndexOf(Patient.DFN) < 0) then
1391 FlaggedPTList.Add(Patient.DFN);
1392 end
1393 else
1394 begin
1395 Patient.DFN := SaveDFN;
1396 if Assigned(FlagList) then
1397 begin
1398 FlagList.Clear;
1399 HasFlag := False;
1400 HasActiveFlg(FlagList, HasFlag, NewDFN);
1401 end;
1402 Notifications.Prior;
1403 Exit;
1404 end;
1405 end else
1406 begin
1407 Patient.DFN := SaveDFN;
1408 Notifications.Prior;
1409 Exit;
1410 end;
1411 end;
1412 stsArea.Panels.Items[1].Text := Notifications.Text;
1413 FChangeSource := CC_NOTIFICATION;
1414 NextIndex := PageIDToTab(CT_COVER);
1415 tabPage.TabIndex := CT_NOPAGE;
1416 tabPageChange(tabPage);
1417 mnuFileNotifRemove.Enabled := Notifications.Followup in [NF_FLAGGED_ORDERS,
1418 NF_ORDER_REQUIRES_ELEC_SIGNATURE,
1419 NF_MEDICATIONS_EXPIRING_INPT,
1420 NF_MEDICATIONS_EXPIRING_OUTPT,
1421 NF_UNVERIFIED_MEDICATION_ORDER,
1422 NF_UNVERIFIED_ORDER,
1423 NF_FLAGGED_OI_EXP_INPT,
1424 NF_FLAGGED_OI_EXP_OUTPT];
1425 case Notifications.FollowUp of
1426 NF_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1427 NF_FLAGGED_ORDERS : NextIndex := PageIDToTab(CT_ORDERS);
1428 NF_ORDER_REQUIRES_ELEC_SIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
1429 NF_ABNORMAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1430 NF_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
1431 NF_CONSULT_REQUEST_RESOLUTION : NextIndex := PageIDToTab(CT_CONSULTS);
1432 NF_ABNORMAL_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
1433 NF_IMAGING_REQUEST_CANCEL_HELD : NextIndex := PageIDToTab(CT_ORDERS);
1434 NF_NEW_SERVICE_CONSULT_REQUEST : NextIndex := PageIDToTab(CT_CONSULTS);
1435 NF_CONSULT_REQUEST_CANCEL_HOLD : NextIndex := PageIDToTab(CT_CONSULTS);
1436 NF_SITE_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1437 NF_ORDERER_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1438 NF_ORDER_REQUIRES_COSIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
1439 NF_LAB_ORDER_CANCELED : NextIndex := PageIDToTab(CT_ORDERS);
1440 NF_STAT_RESULTS :
1441 if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'LRCH' then
1442 NextIndex := PageIDToTab(CT_LABS)
1443 else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'GMRC' then
1444 NextIndex := PageIDToTab(CT_CONSULTS)
1445 else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'RA' then
1446 NextIndex := PageIDToTab(CT_REPORTS);
1447 NF_DNR_EXPIRING : NextIndex := PageIDToTab(CT_ORDERS);
1448 NF_MEDICATIONS_EXPIRING_INPT : NextIndex := PageIDToTab(CT_ORDERS);
1449 NF_MEDICATIONS_EXPIRING_OUTPT : NextIndex := PageIDToTab(CT_ORDERS);
1450 NF_UNVERIFIED_MEDICATION_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1451 NF_NEW_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1452 NF_IMAGING_RESULTS_AMENDED : NextIndex := PageIDToTab(CT_REPORTS);
1453 NF_CRITICAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1454 NF_UNVERIFIED_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1455 NF_FLAGGED_OI_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1456 NF_FLAGGED_OI_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1457 NF_DC_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1458 NF_CONSULT_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_CONSULTS);
1459 NF_DCSUMM_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_DCSUMM);
1460 NF_NOTES_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_NOTES);
1461 NF_CONSULT_REQUEST_UPDATED : NextIndex := PageIDToTab(CT_CONSULTS);
1462 NF_FLAGGED_OI_EXP_INPT : NextIndex := PageIDToTab(CT_ORDERS);
1463 NF_FLAGGED_OI_EXP_OUTPT : NextIndex := PageIDToTab(CT_ORDERS);
1464 NF_CONSULT_PROC_INTERPRETATION : NextIndex := PageIDToTab(CT_CONSULTS);
1465 NF_IMAGING_REQUEST_CHANGED :
1466 begin
1467 ReportBox(GetNotificationFollowUpText(Patient.DFN, Notifications.FollowUp, Notifications.AlertData), Pieces(Piece(Notifications.RecordID, U, 1), ':', 2, 3), True);
1468 Notifications.Delete;
1469 end;
1470 NF_LAB_THRESHOLD_EXCEEDED : NextIndex := PageIDToTab(CT_LABS);
1471 NF_SURGERY_UNSIGNED_NOTE : if TabExists(CT_SURGERY) then
1472 NextIndex := PageIDToTab(CT_SURGERY)
1473 else
1474 InfoBox(TX_NO_SURG_NOTIF, TC_NO_SURG_NOTIF, MB_OK);
1475 //NextIndex := PageIDToTab(CT_NOTES);
1476 else InfoBox(TX_UNK_NOTIF, TC_UNK_NOTIF, MB_OK);
1477 end;
1478 tabPage.TabIndex := NextIndex;
1479 tabPageChange(tabPage);
1480 end
1481 else mnuFileOpenClick(mnuFileNext);
1482end;
1483
1484
1485procedure TfrmFrame.SetBADxList;
1486var
1487 i: smallint;
1488begin
1489 if not Assigned(UBAGlobals.tempDxList) then
1490 begin
1491 UBAGlobals.tempDxList := TList.Create;
1492 UBAGlobals.tempDxList.Count := 0;
1493 Application.ProcessMessages;
1494 end
1495 else
1496 begin
1497 //Kill the old Dx list
1498 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
1499 TObject(UBAGlobals.tempDxList[i]).Free;
1500
1501 UBAGlobals.tempDxList.Clear;
1502 Application.ProcessMessages;
1503
1504 //Create new Dx list for newly selected patient
1505 if not Assigned(UBAGlobals.tempDxList) then
1506 begin
1507 UBAGlobals.tempDxList := TList.Create;
1508 UBAGlobals.tempDxList.Count := 0;
1509 Application.ProcessMessages;
1510 end;
1511 end;
1512end;
1513
1514procedure TfrmFrame.mnuFileOpenClick(Sender: TObject);
1515{ select a new patient & update the header displays (patient id, encounter, postings) }
1516var
1517 SaveDFN, Reason: string;
1518 //NextTab: Integer; // moved up for visibility - v23.4 rV
1519 ok, OldRemindersStarted, PtSelCancelled: boolean;
1520 //i: smallint;
1521 CCOWResponse: UserResponse;
1522begin
1523 PtSelCancelled := FALSE;
1524 DetermineNextTab;
1525(* if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
1526 NextTab := TabToPageID(tabPage.TabIndex)
1527 else
1528 NextTab := User.InitialTab;
1529 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1530 if User.IsReportsOnly then // Reports Only tab.
1531 NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
1532 if not TabExists(NextTab) then NextTab := CT_COVER;
1533 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1534 if NextTab = CT_ORDERS then
1535 if frmOrders <> nil then with frmOrders do
1536 begin
1537 if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
1538 PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
1539 end;*)
1540 if not AllowContextChangeAll(Reason) then Exit;
1541
1542 // update status text here
1543 stsArea.Panels.Items[1].Text := '';
1544 if (not User.IsReportsOnly) then
1545 begin
1546 if not FRefreshing then
1547 begin
1548 Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
1549 if Notifications.Active then
1550 begin
1551 if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
1552 begin
1553 Notifications.Prior;
1554 Exit;
1555 end;
1556 end;
1557 if Notifications.Active then Notifications.Prior;
1558 end;
1559 end;
1560
1561 if FNoPatientSelected then
1562 SaveDFN := ''
1563 else
1564 SaveDFN := Patient.DFN;
1565
1566 OldRemindersStarted := RemindersStarted;
1567 RemindersStarted := FALSE;
1568 try
1569 if FRefreshing then
1570 begin
1571 UpdatePtInfoOnRefresh;
1572 ok := TRUE;
1573 end
1574 else
1575 begin
1576 ok := FALSE;
1577 if (not User.IsReportsOnly) then
1578 begin
1579 if FCCOWInstalled and (ctxContextor.State = csParticipating) then
1580 begin
1581 UpdateCCOWContext;
1582 if not FCCOWError then
1583 begin
1584 FCCOWIconName := 'BMP_CCOW_LINKED';
1585 pnlCCOW.Hint := TX_CCOW_LINKED;
1586 imgCCOW.Picture.Bitmap.LoadFromResourceName(hInstance, FCCOWIconName);
1587 end;
1588 end
1589 else
1590 begin
1591 FCCOWIconName := 'BMP_CCOW_BROKEN';
1592 pnlCCOW.Hint := TX_CCOW_BROKEN;
1593 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
1594 end;
1595 if (Patient.DFN = '') or (Sender = mnuFileOpen) or (Sender = mnuFileNext) or (Sender = mnuViewDemo) then
1596 SelectPatient(SHOW_NOTIFICATIONS, Font.Size, PtSelCancelled);
1597 if PtSelCancelled then exit;
1598 ShowEverything;
1599 DisplayEncounterText;
1600 FPrevInPatient := Patient.Inpatient;
1601 if Notifications.Active then
1602 begin
1603 // display 'next notification' button
1604 FNextButtonActive := True;
1605 with stsArea.Panels[2] do
1606 begin
1607 //Text := 'Next ->';
1608 Bevel := pbRaised;
1609 end;
1610 mnuFileNext.Enabled := True;
1611 mnuFileNextClick(Self);
1612 end
1613 else
1614 begin
1615 // hide the 'next notification' button
1616 FNextButtonActive := False;
1617 with stsArea.Panels[2] do
1618 begin
1619 //Text := '';
1620 Bevel := pbLowered;
1621 end;
1622 mnuFileNext.Enabled := False;
1623 mnuFileNotifRemove.Enabled := False;
1624 if Patient.DFN <> SaveDFN then
1625 ok := TRUE;
1626 end
1627 end
1628 else
1629 begin
1630 Notifications.Clear;
1631 SelectPatient(False, Font.Size, PtSelCancelled); // Call Pt. Sel. w/o notifications.
1632 if PtSelCancelled then exit;
1633 ShowEverything;
1634 DisplayEncounterText;
1635 FPrevInPatient := Patient.Inpatient;
1636 ok := TRUE;
1637 end;
1638 end;
1639 if ok then
1640 begin
1641 if FCCOWInstalled and (ctxContextor.State = csParticipating) and (not FRefreshing) then
1642 begin
1643 if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
1644 begin
1645 SetupPatient;
1646 tabPage.TabIndex := PageIDToTab(NextTab);
1647 tabPageChange(tabPage);
1648 end
1649 else
1650 begin
1651 case CCOWResponse of
1652 urCancel: UpdateCCOWContext;
1653 urBreak:
1654 begin
1655 // do not revert to old DFN if context was manually broken by user - v26 (RV)
1656 if (ctxContextor.State = csParticipating) then Patient.DFN := SaveDFN;
1657 SetupPatient;
1658 tabPage.TabIndex := PageIDToTab(NextTab);
1659 tabPageChange(tabPage);
1660 end;
1661 end;
1662 end;
1663 end
1664 else
1665 begin
1666 SetupPatient;
1667 tabPage.TabIndex := PageIDToTab(NextTab);
1668 tabPageChange(tabPage);
1669 end;
1670 end;
1671 finally
1672 if (not FRefreshing) and (Patient.DFN = SaveDFN) then
1673 RemindersStarted := OldRemindersStarted;
1674 FFirstLoad := False;
1675 end;
1676 {Begin BillingAware}
1677 if BILLING_AWARE then frmFrame.SetBADxList; //end IsBillingAware
1678 {End BillingAware}
1679 //frmCover.UpdateVAAButton; //VAA CQ7525 CQ#7933 - moved to SetupPatient, before event hook execution (RV)
1680end;
1681
1682procedure TfrmFrame.DetermineNextTab;
1683begin
1684 if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
1685 begin
1686 if (tabPage.TabIndex < 0) then
1687 NextTab := LastTab
1688 else
1689 NextTab := TabToPageID(tabPage.TabIndex);
1690 end
1691 else
1692 NextTab := User.InitialTab;
1693 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1694 if User.IsReportsOnly then // Reports Only tab.
1695 NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
1696 if not TabExists(NextTab) then NextTab := CT_COVER;
1697 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1698 if NextTab = CT_ORDERS then
1699 if frmOrders <> nil then with frmOrders do
1700 begin
1701 if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
1702 PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
1703 end;
1704end;
1705
1706procedure TfrmFrame.mnuFileEncounterClick(Sender: TObject);
1707{ displays encounter window and updates encounter display in case encounter was updated }
1708begin
1709 UpdateEncounter(NPF_ALL); {*KCM*}
1710 DisplayEncounterText;
1711end;
1712
1713procedure TfrmFrame.mnuFileReviewClick(Sender: TObject);
1714{ displays the Review Changes window (which resets the Encounter object) }
1715var
1716 EventChanges: boolean;
1717 NameNeedLook: string;
1718begin
1719 EventChanges := False;
1720 NameNeedLook := '';
1721 UpdatePtInfoOnRefresh;
1722 if Changes.Count > 0 then
1723 begin
1724 if (frmOrders <> nil) and (frmOrders.TheCurrentView <> nil) and ( frmOrders.TheCurrentView.EventDelay.EventIFN>0) then
1725 begin
1726 EventChanges := True;
1727 NameNeedLook := frmOrders.TheCurrentView.ViewName;
1728 frmOrders.PtEvtCompleted(frmOrders.TheCurrentView.EventDelay.PtEventIFN, frmOrders.TheCurrentView.EventDelay.EventName);
1729 end;
1730 ReviewChanges(TimedOut, EventChanges);
1731 if TabToPageID(tabPage.TabIndex)= CT_MEDS then
1732 begin
1733 frmOrders.InitOrderSheets2(NameNeedLook);
1734 end;
1735 end
1736 else InfoBox('No new changes to review/sign.', 'Review Changes', MB_OK);
1737end;
1738
1739procedure TfrmFrame.mnuFileExitClick(Sender: TObject);
1740{ see the CloseQuery event }
1741var
1742 i: smallint;
1743begin
1744 try
1745 if BILLING_AWARE then
1746 begin
1747 if Assigned(tempDxList) then
1748 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
1749 TObject(UBAGlobals.tempDxList[i]).Free;
1750
1751 UBAGlobals.tempDxList.Clear;
1752 Application.ProcessMessages;
1753 end; //end IsBillingAware
1754 except
1755 on EAccessViolation do
1756 begin
1757 {$ifdef debug}ShowMessage('Access Violation in procedure TfrmFrame.mnuFileExitClick()');{$endif}
1758 raise;
1759 end;
1760 on E: Exception do
1761 begin
1762 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmFrame.mnuFileExitClick()');{$endif}
1763 raise;
1764 end;
1765 end;
1766
1767 Close;
1768end;
1769
1770{ View Menu Events ------------------------------------------------------------------------- }
1771
1772procedure TfrmFrame.mnuViewPostingsClick(Sender: TObject);
1773begin
1774end;
1775
1776{ Tool Menu Events ------------------------------------------------------------------------- }
1777
1778function TfrmFrame.ExpandCommand(x: string): string;
1779{ look for 'macros' on the command line and expand them using current context }
1780
1781 procedure Substitute(const Key, Data: string);
1782 var
1783 Stop, Start: Integer;
1784 begin
1785 Stop := Pos(Key, x) - 1;
1786 Start := Stop + Length(Key) + 1;
1787 x := Copy(x, 1, Stop) + Data + Copy(x, Start, Length(x));
1788 end;
1789
1790begin
1791 if Pos('%MREF', x) > 0 then Substitute('%MREF',
1792 '^TMP(''ORWCHART'',' + MScalar('$J') + ',''' + DottedIPStr + ''',' + IntToHex(Handle, 8) + ')');
1793 if Pos('%SRV', x) > 0 then Substitute('%SRV', RPCBrokerV.Server);
1794 if Pos('%PORT', x) > 0 then Substitute('%PORT', IntToStr(RPCBrokerV.ListenerPort));
1795 if Pos('%DFN', x) > 0 then Substitute('%DFN', Patient.DFN); //*DFN*
1796 if Pos('%DUZ', x) > 0 then Substitute('%DUZ', IntToStr(User.DUZ));
1797 Result := x;
1798end;
1799
1800procedure TfrmFrame.ToolClick(Sender: TObject);
1801{ executes the program associated with an item on the Tools menu, the command line is stored
1802 in the item's hint property }
1803const
1804 TXT_ECS_NOTFOUND = 'The ECS application is not found at the default directory,' + #13 + 'would you like manually search it?';
1805 TC_ECS_NOTFOUND = 'Application Not Found';
1806var
1807 x, AFile, Param, MenuCommand, ECSAppend, CapNm, curPath : string;
1808 IsECSInterface: boolean;
1809
1810 function TakeOutAmps(AString: string): string;
1811 var
1812 S1,S2: string;
1813 begin
1814 if Pos('&',AString)=0 then
1815 begin
1816 Result := AString;
1817 Exit;
1818 end;
1819 S1 := Piece(AString,'&',1);
1820 S2 := Piece(AString,'&',2);
1821 Result := S1 + S2;
1822 end;
1823
1824 function ExcuteEC(AFile,APara: string): boolean;
1825 begin
1826 if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL) > 32 ) then Result := True
1827 else
1828 begin
1829 if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
1830 begin
1831 if OROpenDlg.Execute then
1832 begin
1833 AFile := OROpenDlg.FileName;
1834 if Pos('ecs gui.exe',lowerCase(AFile))<1 then
1835 begin
1836 ShowMessage('This is not a valid ECS application.');
1837 Result := True;
1838 end else
1839 begin
1840 if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL)<32) then Result := False
1841 else Result := True;
1842 end;
1843 end
1844 else Result := True;
1845 end else Result := True;
1846 end;
1847 end;
1848
1849 function ExcuteECS(AFile, APara: string; var currPath: string): boolean;
1850 var
1851 commandline,RPCHandle: string;
1852 StartupInfo: TStartupInfo;
1853 ProcessInfo: TProcessInformation;
1854 begin
1855 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
1856 with StartupInfo do
1857 begin
1858 cb := SizeOf(TStartupInfo);
1859 dwFlags := STARTF_USESHOWWINDOW;
1860 wShowWindow := SW_SHOWNORMAL;
1861 end;
1862 commandline := AFile + Param;
1863 RPCHandle := GetAppHandle(RPCBrokerV);
1864 commandline := commandline + ' H=' + RPCHandle;
1865 if CreateProcess(nil, PChar(commandline), nil, nil, False,
1866 NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then Result := True
1867 else
1868 begin
1869 if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
1870 begin
1871 if OROpenDlg.Execute then
1872 begin
1873 AFile := OROpenDlg.FileName;
1874 if Pos('ecs gui.exe',lowerCase(AFile))<1 then
1875 begin
1876 ShowMessage('This is not a valid ECS application.');
1877 Result := True;
1878 end else
1879 begin
1880 SaveUserPath('Event Capture Interface='+AFile, currPath);
1881 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
1882 with StartupInfo do
1883 begin
1884 cb := SizeOf(TStartupInfo);
1885 dwFlags := STARTF_USESHOWWINDOW;
1886 wShowWindow := SW_SHOWNORMAL;
1887 end;
1888 commandline := AFile + Param;
1889 RPCHandle := GetAppHandle(RPCBrokerV);
1890 commandline := commandline + ' H=' + RPCHandle;
1891 if not CreateProcess(nil, PChar(commandline), nil, nil, False,
1892 NORMAL_PRIORITY_CLASS, nil, nil,StartupInfo,ProcessInfo) then Result := False
1893 else Result := True;
1894 end;
1895 end
1896 else Result := True;
1897 end else Result := True;
1898 end;
1899 end;
1900
1901begin
1902 MenuCommand := '';
1903 ECSAppend := '';
1904 IsECSInterface := False;
1905 curPath := '';
1906 CapNm := LowerCase(TMenuItem(Sender).Caption);
1907 CapNm := TakeOutAmps(CapNm);
1908 if AnsiCompareText('event capture interface',CapNm)=0 then
1909 begin
1910 IsECSInterface := True;
1911 if FECSAuthUser then UpdateECSParameter(ECSAppend)
1912 else begin
1913 ShowMessage('You don''t have permission to use ECS.');
1914 exit;
1915 end;
1916 end;
1917 MenuCommand := TMenuItem(Sender).Hint + ECSAppend;
1918 x := ExpandCommand(MenuCommand);
1919 if CharAt(x, 1) = '"' then
1920 begin
1921 x := Copy(x, 2, Length(x));
1922 AFile := Copy(x, 1, Pos('"',x)-1);
1923 Param := Copy(x, Pos('"',x)+1, Length(x));
1924 end else
1925 begin
1926 AFile := Piece(x, ' ', 1);
1927 Param := Copy(x, Length(AFile)+1, Length(x));
1928 end;
1929 if IsECSInterface then
1930 begin
1931 if not ExcuteECS(AFile,Param,curPath) then
1932 ExcuteECS(AFile,Param,curPath);
1933 if Length(curPath)>0 then
1934 TMenuItem(Sender).Hint := curPath;
1935 end
1936 else if (Pos('ecs',LowerCase(AFile))>0) and (not IsECSInterface) then
1937 begin
1938 if not ExcuteEC(AFile,Param) then
1939 ExcuteEC(AFile,Param);
1940 end else
1941 begin
1942 ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL);
1943 end;
1944end;
1945
1946{ Help Menu Events ------------------------------------------------------------------------- }
1947
1948procedure TfrmFrame.mnuHelpBrokerClick(Sender: TObject);
1949{ used for debugging - shows last n broker calls }
1950begin
1951 ShowBroker;
1952end;
1953
1954procedure TfrmFrame.mnuHelpListsClick(Sender: TObject);
1955{ used for debugging - shows internal contents of TORListBox }
1956begin
1957 if Screen.ActiveControl is TListBox
1958 then DebugListItems(TListBox(Screen.ActiveControl))
1959 else InfoBox('Focus control is not a listbox', 'ListBox Data', MB_OK);
1960end;
1961
1962procedure TfrmFrame.mnuHelpSymbolsClick(Sender: TObject);
1963{ used for debugging - shows current symbol table }
1964begin
1965 DebugShowServer;
1966end;
1967
1968procedure TfrmFrame.mnuHelpAboutClick(Sender: TObject);
1969{ displays the about screen }
1970begin
1971 ShowAbout;
1972end;
1973
1974{ Status Bar Methods }
1975
1976procedure TfrmFrame.UMStatusText(var Message: TMessage);
1977{ displays status bar text (using the pointer to a text buffer passed in LParam) }
1978begin
1979 stsArea.Panels.Items[0].Text := StrPas(PChar(Message.LParam));
1980 stsArea.Refresh;
1981end;
1982
1983procedure TfrmFrame.stsAreaMouseDown(Sender: TObject; Button: TMouseButton;
1984 Shift: TShiftState; X, Y: Integer);
1985begin
1986 if (FNextButtonActive) and (X > FNextButtonL) and (X < FNextButtonR) then
1987 begin
1988 stsArea.Panels[2].Bevel := pbLowered;
1989 popAlerts.AutoPopup := TRUE;
1990 end;
1991end;
1992
1993procedure TfrmFrame.stsAreaMouseUp(Sender: TObject; Button: TMouseButton;
1994 Shift: TShiftState; X, Y: Integer);
1995begin
1996 if FNextButtonActive then
1997 begin
1998 stsArea.Panels[2].Bevel := pbRaised;
1999 popAlerts.AutoPopup := FALSE;
2000 if (X > FNextButtonL) and (X < FNextButtonR) then
2001 if Button = mbLeft then mnuFileNextClick(Self);
2002 end;
2003end;
2004
2005procedure TfrmFrame.stsAreaDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
2006 const Rect: TRect);
2007begin
2008 if FNextButtonActive then with StatusBar.Canvas do
2009 begin
2010 Draw(Rect.Left + 2, Rect.Top, FNextButtonBitmap); { draw bitmap }
2011 TextOut(Rect.Left + 20, Rect.Top + 2, 'Next'); { draw text to the right of the bitmap }
2012 end;
2013end;
2014
2015{ Toolbar Methods (make panels act like buttons) ------------------------------------------- }
2016
2017procedure TfrmFrame.pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
2018 Shift: TShiftState; X, Y: Integer);
2019{ emulate a button press in the patient identification panel }
2020begin
2021 if pnlPatient.BevelOuter = bvLowered then exit;
2022 pnlPatient.BevelOuter := bvLowered;
2023 with lblPtName do SetBounds(Left+2, Top+2, Width, Height);
2024 with lblPtSSN do SetBounds(Left+2, Top+2, Width, Height);
2025 with lblPtAge do SetBounds(Left+2, Top+2, Width, Height);
2026end;
2027
2028procedure TfrmFrame.pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
2029 Shift: TShiftState; X, Y: Integer);
2030{ emulate the button raising in the patient identification panel & call Patient Inquiry }
2031begin
2032 if pnlPatient.BevelOuter = bvRaised then exit;
2033 pnlPatient.BevelOuter := bvRaised;
2034 with lblPtName do SetBounds(Left-2, Top-2, Width, Height);
2035 with lblPtSSN do SetBounds(Left-2, Top-2, Width, Height);
2036 with lblPtAge do SetBounds(Left-2, Top-2, Width, Height);
2037end;
2038
2039procedure TfrmFrame.pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
2040 Shift: TShiftState; X, Y: Integer);
2041{ emulate a button press in the encounter panel }
2042begin
2043 if User.IsReportsOnly then
2044 exit;
2045 pnlVisit.BevelOuter := bvLowered;
2046 //with lblStLocation do SetBounds(Left+2, Top+2, Width, Height);
2047 with lblPtLocation do SetBounds(Left+2, Top+2, Width, Height);
2048 with lblPtProvider do SetBounds(Left+2, Top+2, Width, Height);
2049end;
2050
2051procedure TfrmFrame.pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
2052 Shift: TShiftState; X, Y: Integer);
2053{ emulate a button raising in the encounter panel and call Update Provider/Location }
2054begin
2055 if User.IsReportsOnly then
2056 exit;
2057 pnlVisit.BevelOuter := bvRaised;
2058 //with lblStLocation do SetBounds(Left-2, Top-2, Width, Height);
2059 with lblPtLocation do SetBounds(Left-2, Top-2, Width, Height);
2060 with lblPtProvider do SetBounds(Left-2, Top-2, Width, Height);
2061end;
2062
2063procedure TfrmFrame.pnlPrimaryCareMouseDown(Sender: TObject;
2064 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2065begin
2066 pnlPrimaryCare.BevelOuter := bvLowered;
2067 with lblPtCare do SetBounds(Left+2, Top+2, Width, Height);
2068 with lblPtAttending do SetBounds(Left+2, Top+2, Width, Height);
2069end;
2070
2071procedure TfrmFrame.pnlPrimaryCareMouseUp(Sender: TObject;
2072 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2073begin
2074 pnlPrimaryCare.BevelOuter := bvRaised;
2075 with lblPtCare do SetBounds(Left-2, Top-2, Width, Height);
2076 with lblPtAttending do SetBounds(Left-2, Top-2, Width, Height);
2077end;
2078
2079procedure TfrmFrame.pnlPostingsMouseDown(Sender: TObject;
2080 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2081{ emulate a button press in the postings panel }
2082begin
2083 pnlPostings.BevelOuter := bvLowered;
2084 with lblPtPostings do SetBounds(Left+2, Top+2, Width, Height);
2085 with lblPtCWAD do SetBounds(Left+2, Top+2, Width, Height);
2086end;
2087
2088procedure TfrmFrame.pnlPostingsMouseUp(Sender: TObject;
2089 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2090{ emulate a button raising in the posting panel and call Postings }
2091begin
2092 pnlPostings.BevelOuter := bvRaised;
2093 with lblPtPostings do SetBounds(Left-2, Top-2, Width, Height);
2094 with lblPtCWAD do SetBounds(Left-2, Top-2, Width, Height);
2095end;
2096
2097{ Resize and Font-Change procedures -------------------------------------------------------- }
2098
2099procedure TfrmFrame.LoadSizesForUser;
2100var
2101 s1, s2, s3, s4, Dummy: integer;
2102
2103 panelBottom, panelMedIn : integer;
2104
2105begin
2106 ChangeFont(UserFontSize);
2107 SetUserBounds(TControl(frmFrame));
2108 SetUserWidths(TControl(frmProblems.pnlLeft));
2109 //SetUserWidths(TControl(frmMeds.pnlLeft));
2110 SetUserWidths(TControl(frmOrders.pnlLeft));
2111 SetUserWidths(TControl(frmNotes.pnlLeft));
2112 SetUserWidths(TControl(frmConsults.pnlLeft));
2113 SetUserWidths(TControl(frmDCSumm.pnlLeft));
2114 if Assigned(frmSurgery) then SetUserWidths(TControl(frmSurgery.pnlLeft));
2115 SetUserWidths(TControl(frmLabs.pnlLeft));
2116 SetUserWidths(TControl(frmReports.pnlLeft));
2117 SetUserColumns(TControl(frmOrders.hdrOrders));
2118 SetUserColumns(TControl(frmMeds.hdrMedsIn)); // still need conversion
2119 SetUserColumns(TControl(frmMeds.hdrMedsOut));
2120 SetUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight);
2121 SetUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight);
2122 SetUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, Dummy ,Dummy);
2123 SetUserBounds2(DrawerSplitters,s1, s2, s3, Dummy);
2124 if Assigned(frmSurgery) then frmSurgery.Drawers.LastOpenSize := Dummy; //CQ7315
2125 frmNotes.Drawers.LastOpenSize := s1;
2126 frmConsults.Drawers.LastOpenSize := s2;
2127 frmDCSumm.Drawers.LastOpenSize := s3;
2128
2129 with frmMeds do
2130 begin
2131 SetUserBounds2(frmMeds.Name+'Split', panelBottom, panelMedIn, Dummy, Dummy);
2132 if (panelBottom > frmMeds.Height-50) then panelBottom := frmMeds.Height-50;
2133 if (panelMedIn > panelBottom-50) then panelMedIn := panelBottom-50;
2134 frmMeds.pnlBottom.Height := panelBottom;
2135 frmMeds.pnlMedIn.Height := panelMedIn;
2136 //Meds Tab Non-VA meds columns
2137 SetUserColumns(TControl(hdrMedsNonVA)); //CQ7314
2138 end;
2139
2140 frmCover.DisableAlign;
2141 try
2142 SetUserBounds2(CoverSplitters1, s1, s2, s3, s4);
2143 if s1 > 0 then
2144 frmCover.pnl_1.Width := LowerOf( frmCover.pnl_not3.ClientWidth - 5, s1);
2145 if s2 > 0 then
2146 frmCover.pnl_3.Width := LowerOf( frmCover.pnlTop.ClientWidth - 5, s2);
2147 if s3 > 0 then
2148 frmCover.pnlTop.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s3);
2149 if s4 > 0 then
2150 frmCover.pnl_4.Width := LowerOf( frmCover.pnlMiddle.ClientWidth - 5, s4);
2151
2152 SetUserBounds2(CoverSplitters2, s1, s2, s3, Dummy);
2153 if s1 > 0 then
2154 frmCover.pnlBottom.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s1);
2155 if s2 > 0 then
2156 frmCover.pnl_6.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s2);
2157 if s3 > 0 then
2158 frmCover.pnl_8.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s3);
2159
2160 finally
2161 frmCover.EnableAlign;
2162 end;
2163 if ParamSearch('rez') = '640' then SetBounds(Left, Top, 648, 488); // for testing
2164end;
2165
2166procedure TfrmFrame.SaveSizesForUser;
2167var
2168 SizeList: TStringList;
2169 SurgTempHt: integer;
2170begin
2171 SaveUserFontSize(MainFontSize);
2172 SizeList := TStringList.Create;
2173 try
2174 with SizeList do
2175 begin
2176 Add(StrUserBounds(frmFrame));
2177 Add(StrUserWidth(frmProblems.pnlLeft));
2178 //Add(StrUserWidth(frmMeds.pnlLeft));
2179 Add(StrUserWidth(frmOrders.pnlLeft));
2180 Add(StrUserWidth(frmNotes.pnlLeft));
2181 Add(StrUserWidth(frmConsults.pnlLeft));
2182 Add(StrUserWidth(frmDCSumm.pnlLeft));
2183 if Assigned(frmSurgery) then Add(StrUserWidth(frmSurgery.pnlLeft));
2184 Add(StrUserWidth(frmLabs.pnlLeft));
2185 Add(StrUserWidth(frmReports.pnlLeft));
2186 Add(StrUserColumns(frmOrders.hdrOrders));
2187 Add(StrUserColumns(frmMeds.hdrMedsIn));
2188 Add(StrUserColumns(frmMeds.hdrMedsOut));
2189 Add(StrUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight));
2190 Add(StrUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight));
2191 Add(StrUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, 0 ,0));
2192
2193 //v26.47 - RV - access violation if Surgery Tab not enabled. Set to designer height as default.
2194 if Assigned(frmSurgery) then SurgTempHt := frmSurgery.Drawers.pnlTemplates.Height else SurgTempHt := 85;
2195 Add(StrUserBounds2(DrawerSplitters, frmNotes.Drawers.LastOpenSize,
2196 frmConsults.Drawers.LastOpenSize,
2197 frmDCSumm.Drawers.LastOpenSize,
2198 SurgTempHt)); // last parameter = CQ7315
2199
2200 Add(StrUserBounds2(CoverSplitters1,
2201 frmCover.pnl_1.Width,
2202 frmCover.pnl_3.Width,
2203 frmCover.pnlTop.Height,
2204 frmCover.pnl_4.Width));
2205 Add(StrUserBounds2(CoverSplitters2,
2206 frmCover.pnlBottom.Height,
2207 frmCover.pnl_6.Width,
2208 frmCover.pnl_8.Width,
2209 0));
2210
2211 //Meds Tab Splitters
2212 Add(StrUserBounds2(frmMeds.Name+'Split',frmMeds.pnlBottom.Height,frmMeds.pnlMedIn.Height,0,0));
2213
2214 //Meds Tab Non-VA meds columns
2215 Add(StrUserColumns(fMeds.frmMeds.hdrMedsNonVA)); //CQ7314
2216
2217 //Orders Tab columns
2218 Add(StrUserColumns(fOrders.frmOrders.hdrOrders)); //CQ6328
2219
2220 if EnduringPtSelSplitterPos <> 0 then
2221 Add(StrUserBounds2('frmPtSel.sptVert', EnduringPtSelSplitterPos, 0, 0, 0));
2222 end;
2223 //Add sizes for forms that used SaveUserBounds() to save thier positions
2224 SizeHolder.AddSizesToStrList(SizeList);
2225 //Send the SizeList to the Database
2226 SaveUserSizes(SizeList);
2227 finally
2228 SizeList.Free;
2229 end;
2230end;
2231
2232procedure TfrmFrame.FormResize(Sender: TObject);
2233{ need to resize tab forms specifically since they don't inherit resize event (because they
2234 are derived from TForm itself) }
2235begin
2236 if FTerminate or FClosing then Exit;
2237 if csDestroying in ComponentState then Exit;
2238 MoveWindow(frmCover.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2239 MoveWindow(frmProblems.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2240 MoveWindow(frmMeds.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2241 MoveWindow(frmOrders.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2242 MoveWindow(frmNotes.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2243 MoveWindow(frmConsults.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2244 MoveWindow(frmDCSumm.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2245 if Assigned(frmSurgery) then MoveWindow(frmSurgery.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2246 MoveWindow(frmLabs.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2247 MoveWindow(frmReports.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2248 with stsArea do
2249 begin
2250 Panels[1].Width := stsArea.Width - FFixedStatusWidth;
2251 FNextButtonL := Panels[0].Width + Panels[1].Width;
2252 FNextButtonR := FNextButtonL + Panels[2].Width;
2253 end;
2254 lstCIRNLocations.Left := FNextButtonL - ScrollBarWidth - 100;
2255 lstCIRNLocations.Width := ClientWidth - lstCIRNLocations.Left;
2256 Self.Repaint;
2257end;
2258
2259procedure TfrmFrame.ChangeFont(NewFontSize: Integer);
2260{ Makes changes in all components whenever the font size is changed. This is hardcoded and
2261 based on MS Sans Serif for now, as only the font size may be selected. Courier New is used
2262 wherever non-proportional fonts are required. }
2263const
2264 TAB_VOFFSET = 7;
2265var
2266 OldFont: TFont;
2267begin
2268// Ho ho! ResizeAnchoredFormToFont(self) doesn't work here because the
2269// Form size is aliased with MainFormSize.
2270 OldFont := TFont.Create;
2271 try
2272 DisableAlign;
2273 try
2274 OldFont.Assign(Font);
2275 with Self do Font.Size := NewFontSize;
2276 with lblPtName do Font.Size := NewFontSize; // must change BOLDED labels by hand
2277 with lblPtSSN do Font.Size := NewFontSize;
2278 with lblPtAge do Font.Size := NewFontSize;
2279 with lblPtLocation do Font.Size := NewFontSize;
2280 with lblPtProvider do Font.Size := NewFontSize;
2281 with lblPtPostings do Font.Size := NewFontSize;
2282 with lblPtCare do Font.Size := NewFontSize;
2283 with lblPtAttending do Font.Size := NewFontSize;
2284 with lblFlag do Font.Size := NewFontSize;
2285 with lblPtCWAD do Font.Size := NewFontSize;
2286 with lblCIRN do Font.Size := NewFontSize;
2287 with lblCIRNData do Font.Size := NewFontSize;
2288 with lstCIRNLocations do Font.Size := NewFontSize;
2289 with tabPage do Font.Size := NewFontSize;
2290 with laMHV do Font.Size := NewFontSize; //VAA
2291 with laVAA2 do Font.Size := NewFontSize; //VAA
2292
2293 tabPage.Height := MainFontHeight + TAB_VOFFSET; // resize tab selector
2294 FitToolbar; // resize toolbar
2295 stsArea.Font.Size := NewFontSize;
2296 stsArea.Height := MainFontHeight + TAB_VOFFSET;
2297 stsArea.Panels[0].Width := ResizeWidth( OldFont, Font, stsArea.Panels[0].Width);
2298 stsArea.Panels[2].Width := ResizeWidth( OldFont, Font, stsArea.Panels[2].Width);
2299
2300 //VAA CQ8271
2301 if ((fCover.PtIsVAA and fCover.PtIsMHV)) then
2302 begin
2303 laMHV.Height := (pnlToolBar.Height div 2) -1;
2304 with laVAA2 do
2305 begin
2306 Top := laMHV.Top + laMHV.Height;
2307 Height := (pnlToolBar.Height div 2) -1;
2308 end;
2309 end;
2310 //end VAA
2311
2312 RefreshFixedStatusWidth;
2313 FormResize( self );
2314 finally
2315 EnableAlign;
2316 end;
2317 finally
2318 OldFont.Free;
2319 end;
2320
2321 //remove CWAD color if using high-contrast colors
2322 if ColorToRGB(clWindowText) <> ColorToRGB(clBlack) then
2323 begin
2324 lblPtCWAD.Font.Color := clWindowText;
2325 lblFlag.Font.Color := clWindowText;
2326 end;
2327
2328 case (NewFontSize) of
2329 8: mnu8pt.Checked := true;
2330 10: mnu10pt1.Checked := true;
2331 12: mnu12pt1.Checked := true;
2332 14: mnu14pt1.Checked := true;
2333 18: mnu18pt1.Checked := true;
2334 24: mnu24pt1.Checked := true;
2335 end;
2336
2337 //Now that the form elements are resized, the pages will know what size to take.
2338 frmCover.SetFontSize(NewFontSize); // child pages lack a ParentFont property
2339 frmProblems.SetFontSize(NewFontSize);
2340 frmMeds.SetFontSize(NewFontSize);
2341 frmOrders.SetFontSize(NewFontSize);
2342 frmNotes.SetFontSize(NewFontSize);
2343 frmConsults.SetFontSize(NewFontSize);
2344 frmDCSumm.SetFontSize(NewFontSize);
2345 if Assigned(frmSurgery) then frmSurgery.SetFontSize(NewFontSize);
2346 frmLabs.SetFontSize(NewFontSize);
2347 frmReports.SetFontSize(NewFontSize);
2348 TfrmIconLegend.SetFontSize(NewFontSize);
2349 uOrders.SetFontSize(NewFontSize);
2350 if Assigned(frmRemDlg) then frmRemDlg.SetFontSize;
2351 if Assigned(frmReminderTree) then frmReminderTree.SetFontSize(NewFontSize);
2352 if GraphFloat <> nil then ResizeAnchoredFormToFont(GraphFloat);
2353end;
2354
2355procedure TfrmFrame.FitToolBar;
2356{ resizes and repositions the panels & labels used in the toolbar }
2357const
2358 PATIENT_WIDTH = 29;
2359 VISIT_WIDTH = 36;
2360 POSTING_WIDTH = 11.5;
2361 FLAG_WIDTH = 5;
2362 CIRN_WIDTH = 7;
2363 MHV_WIDTH = 6;
2364 LINES_HIGH = 2;
2365 M_HORIZ = 4;
2366 M_MIDDLE = 2;
2367 M_NVERT = 4;
2368 M_WVERT = 6;
2369 TINY_MARGIN = 2;
2370//var
2371 //WidthNeeded: integer;
2372begin
2373 pnlToolbar.Height := (LINES_HIGH * lblPtName.Height) + M_HORIZ + M_MIDDLE + M_HORIZ;
2374 pnlPatient.Width := HigherOf(PATIENT_WIDTH * MainFontWidth, lblPtName.Width + (M_WVERT * 2));
2375 lblPtSSN.Top := M_HORIZ + lblPtName.Height + M_MIDDLE;
2376 lblPtAge.Top := lblPtSSN.Top;
2377 lblPtAge.Left := pnlPatient.Width - lblPtAge.Width - M_WVERT;
2378 pnlVisit.Width := HigherOf(LowerOf(VISIT_WIDTH * MainFontWidth,
2379 HigherOf(lblPtProvider.Width + (M_WVERT * 2),
2380 lblPtLocation.Width + (M_WVERT * 2))),
2381 PATIENT_WIDTH * MainFontWidth);
2382 lblPtProvider.Top := lblPtSSN.Top;
2383 lblPtAttending.Top := lblPtSSN.Top;
2384 lblCIRNData.Top := lblPtSSN.Top;
2385 pnlPostings.Width := Round(POSTING_WIDTH * MainFontWidth);
2386 pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
2387 pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
2388 pnlCIRN.Width := Round(CIRN_WIDTH * MainFontWidth) + M_WVERT;
2389 paVAA.Width := Round(MHV_WIDTH * MainFontWidth) + M_WVERT;
2390 with lblPtPostings do
2391 SetBounds(M_WVERT, M_HORIZ, pnlPostings.Width-M_WVERT-M_WVERT, lblPtName.Height);
2392 with lblPtCWAD do
2393 SetBounds(M_WVERT, lblPtSSN.Top, lblPtPostings.Width, lblPtName.Height);
2394 //Low resolution handling: First, try to fit everything on by shrinking fields
2395 if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
2396 begin
2397 lblPtAge.Left := lblPtAge.Left - (lblPtName.Left - TINY_MARGIN);
2398 lblPtName.Left := TINY_MARGIN;
2399 lblPTSSN.Left := TINY_MARGIN;
2400 pnlPatient.Width := HigherOf( lblPtName.Left + lblPtName.Width, lblPtAge.Left + lblPtAge.Width)+ TINY_MARGIN;
2401 lblPtLocation.Left := TINY_MARGIN;
2402 lblPtProvider.Left := TINY_MARGIN;
2403 pnlVisit.Width := HigherOf( lblPtLocation.Left + lblPtLocation.Width, lblPtProvider.Left + lblPtProvider.Width)+ TINY_MARGIN;
2404 end;
2405 //If that is not enough, add scroll bars to form
2406 {if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
2407 begin
2408 WidthNeeded := HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN - pnlPrimaryCare.Width;
2409 HorzScrollBar.Range := ClientWidth + WidthNeeded;
2410 Width := Width + WidthNeeded;
2411 end
2412 else } // commented out - BA
2413 HorzScrollBar.Range := 0;
2414end;
2415
2416{ Temporary Calls -------------------------------------------------------------------------- }
2417
2418procedure TfrmFrame.ToggleMenuItemChecked(Sender: TObject);
2419begin
2420 with (Sender as TMenuItem) do
2421 begin
2422 if not Checked then
2423 Checked := true
2424 else
2425 Checked := false;
2426 end;
2427end;
2428
2429procedure TfrmFrame.mnuFontSizeClick(Sender: TObject);
2430begin
2431 if (frmRemDlg <> nil) then
2432 ShowMessage('Please close the reminder dialog before changing font sizes.')
2433 else
2434 if (dlgProbs <> nil) then
2435 ShowMessage('Font size cannot be changed while adding or editing a problem.')
2436 else
2437 begin
2438 with (Sender as TMenuItem) do
2439 begin
2440 ToggleMenuItemChecked(Sender);
2441 fMeds.oldFont := MainFontSize; //CQ9182
2442 ChangeFont(Tag);
2443 end;
2444 end;
2445end;
2446
2447procedure TfrmFrame.mnuEditClick(Sender: TObject);
2448var
2449 IsReadOnly: Boolean;
2450begin
2451 FEditCtrl := nil;
2452 if Screen.ActiveControl is TCustomEdit then FEditCtrl := TCustomEdit(Screen.ActiveControl);
2453 if FEditCtrl <> nil then
2454 begin
2455 if FEditCtrl is TMemo then IsReadOnly := TMemo(FEditCtrl).ReadOnly
2456 else if FEditCtrl is TEdit then IsReadOnly := TEdit(FEditCtrl).ReadOnly
2457 else if FEditCtrl is TRichEdit then IsReadOnly := TRichEdit(FEditCtrl).ReadOnly
2458 else IsReadOnly := True;
2459 mnuEditUndo.Enabled := FEditCtrl.Perform(EM_CANUNDO, 0, 0) <> 0;
2460 mnuEditCut.Enabled := FEditCtrl.SelLength > 0;
2461 mnuEditCopy.Enabled := mnuEditCut.Enabled;
2462 mnuEditPaste.Enabled := (IsReadOnly = False) and Clipboard.HasFormat(CF_TEXT);
2463 end else
2464 begin
2465 mnuEditUndo.Enabled := False;
2466 mnuEditCut.Enabled := False;
2467 mnuEditCopy.Enabled := False;
2468 mnuEditPaste.Enabled := False;
2469 end;
2470end;
2471
2472procedure TfrmFrame.mnuEditUndoClick(Sender: TObject);
2473begin
2474 FEditCtrl.Perform(EM_UNDO, 0, 0);
2475end;
2476
2477procedure TfrmFrame.mnuEditCutClick(Sender: TObject);
2478begin
2479 FEditCtrl.CutToClipboard;
2480end;
2481
2482procedure TfrmFrame.mnuEditCopyClick(Sender: TObject);
2483begin
2484 FEditCtrl.CopyToClipboard;
2485end;
2486
2487procedure TfrmFrame.mnuEditPasteClick(Sender: TObject);
2488begin
2489 FEditCtrl.SelText := Clipboard.AsText;
2490 //FEditCtrl.PasteFromClipboard; // use AsText to prevent formatting from being pasted
2491end;
2492
2493procedure TfrmFrame.mnuFilePrintClick(Sender: TObject);
2494begin
2495 case mnuFilePrint.Tag of
2496 CT_NOTES: frmNotes.RequestPrint;
2497 CT_CONSULTS: frmConsults.RequestPrint;
2498 CT_DCSUMM: frmDCSumm.RequestPrint;
2499 CT_REPORTS: frmReports.RequestPrint;
2500 CT_LABS: frmLabs.RequestPrint;
2501 CT_ORDERS: frmOrders.RequestPrint;
2502 CT_PROBLEMS: frmProblems.RequestPrint;
2503 CT_SURGERY: if Assigned(frmSurgery) then frmSurgery.RequestPrint;
2504 end;
2505end;
2506
2507function TfrmFrame.FormHelp(Command: Word; Data: Integer;
2508 var CallHelp: Boolean): Boolean;
2509var
2510 ActiveForm: TForm;
2511begin
2512 inherited;
2513 if Screen.ActiveForm <> nil then
2514 begin
2515 if Screen.ActiveForm.ActiveControl <> nil then
2516 begin
2517 if Screen.ActiveForm.ActiveControl is TForm then
2518 ActiveForm := TForm(Screen.ActiveForm.ActiveControl)
2519 else if Screen.ActiveForm.ActiveControl.Owner is TForm then
2520 ActiveForm := TForm(Screen.ActiveForm.ActiveControl.Owner)
2521 else
2522 ActiveForm := Screen.ActiveForm;
2523 end
2524 else
2525 ActiveForm := Screen.ActiveForm;
2526 HelpFile := ActiveForm.HelpFile;
2527 end ;
2528 Result := True;
2529end;
2530
2531procedure TfrmFrame.WMSysCommand(var Message: TMessage);
2532begin
2533 case TabToPageID(tabPage.TabIndex) of
2534 CT_NOTES:
2535 if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2536 with Message do
2537 begin
2538 SendMessage(frmNotes.Handle, Msg, WParam, LParam);
2539 Result := 0;
2540 end
2541 else
2542 inherited;
2543 CT_DCSUMM:
2544 if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboAttending') then
2545 with Message do
2546 begin
2547 SendMessage(frmDCSumm.Handle, Msg, WParam, lParam);
2548 Result := 0;
2549 end
2550 else
2551 inherited;
2552 CT_CONSULTS:
2553 if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2554 with Message do
2555 begin
2556 SendMessage(frmConsults.Handle, Msg, WParam, lParam);
2557 Result := 0;
2558 end
2559 else
2560 inherited;
2561 else
2562 inherited;
2563 end;
2564 if Message.WParam = SC_MAXIMIZE then
2565 begin
2566 // form becomes maximized;
2567 frmOrders.mnuOptimizeFieldsClick(self);
2568 frmProblems.mnuOptimizeFieldsClick(self);
2569 frmMeds.mnuOptimizeFieldsClick(self);
2570 end
2571 else if Message.WParam = SC_MINIMIZE then
2572 begin
2573 // form becomes maximized;
2574 end
2575 else if Message.WParam = SC_RESTORE then
2576 begin
2577 // form is restored (from maximized);
2578 frmOrders.mnuOptimizeFieldsClick(self);
2579 frmProblems.mnuOptimizeFieldsClick(self);
2580 frmMeds.mnuOptimizeFieldsClick(self);
2581 end;
2582end;
2583
2584procedure TfrmFrame.RemindersChanged(Sender: TObject);
2585var
2586 ImgName: string;
2587begin
2588 pnlReminders.tag := HAVE_REMINDERS;
2589 pnlReminders.Hint := 'Click to display reminders';
2590 case GetReminderStatus of
2591 rsUnknown:
2592 begin
2593 ImgName := 'BMP_REMINDERS_UNKNOWN';
2594 pnlReminders.Caption := 'Reminders';
2595 end;
2596 rsDue:
2597 begin
2598 ImgName := 'BMP_REMINDERS_DUE';
2599 pnlReminders.Caption := 'Due Reminders';
2600 end;
2601 rsApplicable:
2602 begin
2603 ImgName := 'BMP_REMINDERS_APPLICABLE';
2604 pnlReminders.Caption := 'Applicable Reminders';
2605 end;
2606 rsNotApplicable:
2607 begin
2608 ImgName := 'BMP_REMINDERS_OTHER';
2609 pnlReminders.Caption := 'Other Reminders';
2610 end;
2611 else
2612 begin
2613 ImgName := 'BMP_REMINDERS_NONE';
2614 pnlReminders.Hint := 'There are currently no reminders available';
2615 pnlReminders.Caption := pnlReminders.Hint;
2616 pnlReminders.tag := NO_REMINDERS;
2617 end;
2618 end;
2619 if(RemindersEvaluatingInBackground) then
2620 begin
2621 if(anmtRemSearch.ResName = '') then
2622 begin
2623 TORExposedAnimate(anmtRemSearch).OnMouseDown := pnlRemindersMouseDown;
2624 TORExposedAnimate(anmtRemSearch).OnMouseUp := pnlRemindersMouseUp;
2625 anmtRemSearch.ResHandle := 0;
2626 anmtRemSearch.ResName := 'REMSEARCHAVI';
2627 end;
2628 imgReminder.Visible := FALSE;
2629 anmtRemSearch.Active := TRUE;
2630 anmtRemSearch.Visible := TRUE;
2631 if(pnlReminders.Hint <> '') then
2632 pnlReminders.Hint := CRLF + pnlReminders.Hint + '.';
2633 pnlReminders.Hint := 'Evaluating Reminders... ' + pnlReminders.Hint;
2634 pnlReminders.Caption := pnlReminders.Hint;
2635 end
2636 else
2637 begin
2638 anmtRemSearch.Visible := FALSE;
2639 imgReminder.Visible := TRUE;
2640 imgReminder.Picture.Bitmap.LoadFromResourceName(hInstance, ImgName);
2641 anmtRemSearch.Active := FALSE;
2642 end;
2643 mnuViewReminders.Enabled := (pnlReminders.tag = HAVE_REMINDERS);
2644end;
2645
2646procedure TfrmFrame.pnlRemindersMouseDown(Sender: TObject;
2647 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2648begin
2649 if(not InitialRemindersLoaded) then
2650 StartupReminders;
2651 if(pnlReminders.tag = HAVE_REMINDERS) then
2652 pnlReminders.BevelOuter := bvLowered;
2653end;
2654
2655procedure TfrmFrame.pnlRemindersMouseUp(Sender: TObject;
2656 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2657begin
2658 pnlReminders.BevelOuter := bvRaised;
2659 if(pnlReminders.tag = HAVE_REMINDERS) then
2660 ViewInfo(mnuViewReminders);
2661end;
2662
2663//--------------------- CIRN-related procedures --------------------------------
2664
2665procedure TfrmFrame.SetUpCIRN;
2666var
2667 i: integer;
2668 aAutoQuery: string;
2669 ASite: TRemoteSite;
2670begin
2671 with RemoteSites do
2672 if UseVistaWeb then
2673 begin
2674 ChangePatient(Patient.DFN);
2675 lblCIRN.Caption := 'Remote'; //VistaWeb On
2676 lblCIRNData.Caption := 'Data*';
2677 pnlCIRN.Caption := 'Remote Data';
2678 lblCIRN.Width := 43;
2679 lblCIRNData.Width := 43;
2680 lblCIRNData.Alignment := taCenter;
2681 lblCIRN.Alignment := taCenter;
2682 lblCIRN.Enabled := True;
2683 lblCIRNData.Enabled := True;
2684 lblCIRNAvail.Enabled := True;
2685 pnlCIRN.TabStop := True;
2686 if RemoteDataExists and (RemoteSites.Count > 0) then
2687 begin
2688 lblCIRN.Enabled := True;
2689 lblCIRNData.Enabled := True;
2690 lblCIRNAvail.Enabled := True;
2691 pnlCIRN.TabStop := True;
2692 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
2693 begin
2694 lblCIRN.Font.Color := clBlue;
2695 lblCIRNData.Font.Color := clBlue;
2696 lblCIRNAvail.Font.Color := clBlue;
2697 lstCIRNLocations.Font.Color := clBlue;
2698 lblCIRN.Caption := 'Remote';
2699 lblCIRNData.Caption := 'Data*';
2700 lblCIRNAvail.Caption := 'Available';
2701 pnlCIRN.Caption := 'Remote Data Available';
2702 end
2703 else
2704 begin
2705 lblCIRN.Font.Color := clWindowText;
2706 lblCIRNData.Font.Color := clWindowText;
2707 lblCIRNAvail.Font.Color := clWindowText;
2708 lstCIRNLocations.Font.Color := clWindowText;
2709 end;
2710 end
2711 else
2712 begin
2713 lblCIRN.Font.Color := clWindowText;
2714 lblCIRNData.Font.Color := clWindowText;
2715 lblCIRNAvail.Font.Color := clWindowText;
2716 lblCIRN.Enabled := False;
2717 lblCIRNData.Enabled := False;
2718 lblCIRNAvail.Enabled := False;
2719 pnlCIRN.TabStop := False;
2720 pnlCIRN.Hint := NoDataReason;
2721 end;
2722 pnlCIRN.Hint := 'Click to open VistaWeb';
2723 end
2724 else
2725 begin
2726 ChangePatient(Patient.DFN);
2727 lblCIRN.Caption := ' Remote';
2728 lblCIRNData.Caption := 'Data';
2729 pnlCIRN.Caption := 'Remote Data';
2730 lblCIRNAvail.Caption := '';
2731 lblCIRN.Width := 43;
2732 lblCIRNData.Width := 43;
2733 lblCIRNData.Alignment := taCenter;
2734 lblCIRN.Alignment := taCenter;
2735 if RemoteDataExists and (RemoteSites.Count > 0) then
2736 begin
2737 lblCIRN.Enabled := True;
2738 lblCIRNData.Enabled := True;
2739 lblCIRNAvail.Enabled := True;
2740 pnlCIRN.TabStop := True;
2741 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
2742 begin
2743 lblCIRN.Font.Color := clBlue;
2744 lblCIRNData.Font.Color := clBlue;
2745 lblCIRNAvail.Font.Color := clBlue;
2746 lstCIRNLocations.Font.Color := clBlue;
2747 lblCIRN.Caption := 'Remote';
2748 lblCIRNData.Caption := 'Data';
2749 lblCIRNAvail.Caption := 'Available';
2750 pnlCIRN.Caption := 'Remote Data Available';
2751 end
2752 else
2753 begin
2754 lblCIRN.Font.Color := clWindowText;
2755 lblCIRNData.Font.Color := clWindowText;
2756 lblCIRNAvail.Font.Color := clWindowText;
2757 lstCIRNLocations.Font.Color := clWindowText;
2758 lblCIRNAvail.Color := clWindowText;
2759 end;
2760 pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
2761 lstCIRNLocations.Items.Add('-1' + U + 'Use VistaWeb from now on');
2762 if RemoteSites.Count > 0 then
2763 lstCIRNLocations.Items.Add('0' + U + 'All Available Sites');
2764 for i := 0 to RemoteSites.Count - 1 do
2765 begin
2766 ASite := TRemoteSite(SiteList[i]);
2767 lstCIRNLocations.Items.Add(ASite.SiteID + U + ASite.SiteName + U +
2768 FormatFMDateTime('mmm dd yyyy hh:nn', ASite.LastDate));
2769 end;
2770 end
2771 else
2772 begin
2773 lblCIRN.Font.Color := clWindowText;
2774 lblCIRNData.Font.Color := clWindowText;
2775 lblCIRNAvail.Font.Color := clWindowText;
2776 lblCIRN.Enabled := False;
2777 lblCIRNData.Enabled := False;
2778 lblCIRNAvail.Enabled := False;
2779 pnlCIRN.TabStop := False;
2780 pnlCIRN.Hint := NoDataReason;
2781 end;
2782 aAutoQuery := AutoRDV; //Check to see if Remote Queries should be used for all available sites
2783 if (aAutoQuery = '1') and (lstCIRNLocations.Count > 0) then
2784 begin
2785 lstCIRNLocations.ItemIndex := 1;
2786 lstCIRNLocations.Checked[1] := true;
2787 lstCIRNLocationsClick(self);
2788 end;
2789 end;
2790end;
2791
2792procedure TfrmFrame.pnlCIRNClick(Sender: TObject);
2793//var
2794// aAddress: string;
2795begin
2796 {if UseVistaWeb then
2797 begin
2798 pnlCIRN.BevelOuter := bvRaised;
2799 pnlCIRN.Hint := 'Click to open VistaWeb';
2800 lblCIRN.Width := 43;
2801 lblCIRNData.Width := 43;
2802 lblCIRNData.Alignment := taCenter;
2803 lblCIRN.Alignment := taCenter;
2804 lstCIRNLocations.Visible := false;
2805 lstCIRNLocations.SendToBack;
2806 aAddress := GetVistaWebAddress(Patient.DFN);
2807 ShellExecute(Handle, 'open', PChar(aAddress), PChar(''), '', SW_NORMAL);
2808 Exit;
2809 end;
2810 if not RemoteSites.RemoteDataExists then Exit;
2811 if (not lstCIRNLocations.Visible) then
2812 begin
2813 pnlCIRN.BevelOuter := bvLowered;
2814 lstCIRNLocations.Visible := True;
2815 lstCIRNLocations.BringToFront;
2816 lstCIRNLocations.SetFocus;
2817 pnlCIRN.Hint := 'Click to close list.';
2818 end
2819 else
2820 begin
2821 pnlCIRN.BevelOuter := bvRaised;
2822 lstCIRNLocations.Visible := False;
2823 lstCIRNLocations.SendToBack;
2824 pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
2825 end }
2826 ViewInfo(mnuViewRemoteData);
2827end;
2828
2829procedure TfrmFrame.lstCIRNLocationsClick(Sender: TObject);
2830const
2831 DGSR_FAIL = -1;
2832 DGSR_NONE = 0;
2833 DGSR_SHOW = 1;
2834 DGSR_ASK = 2;
2835 DGSR_DENY = 3;
2836var
2837 iIndex,j,iAll,iCur: integer;
2838 aMsg,s: string;
2839 AccessStatus: integer;
2840begin
2841 iAll := 1;
2842 AccessStatus := 0;
2843 iIndex := lstCIRNLocations.ItemIndex;
2844 if iIndex = 0 then
2845 if (piece(lstCIRNLocations.Items[0],'^',1) = '-1') and (lstCIRNLocations.Checked[iIndex] = true) then
2846 begin
2847 if MessageDlg('Are you sure you want to make VistaWeb your default for viewing Remote Data?',
2848 mtConfirmation, [mbYes, mbNo], 0) = mrYes then
2849 begin
2850 ChangeVistaWebParam('1');
2851 lblCIRN.Caption := 'Remote'; //VistaWeb On
2852 lblCIRNData.Caption := 'Data*';
2853 pnlCIRN.Caption := 'Remote Data';
2854 lblCIRNAvail.Caption := '';
2855 lblCIRN.Width := 43;
2856 lblCIRNData.Width := 43;
2857 lblCIRNData.Alignment := taCenter;
2858 lblCIRN.Alignment := taCenter;
2859 with RemoteSites do if RemoteDataExists and (RemoteSites.Count > 0) then
2860 begin
2861 lblCIRN.Enabled := True;
2862 lblCIRNData.Enabled := True;
2863 pnlCIRN.TabStop := True;
2864 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
2865 begin
2866 lblCIRN.Font.Color := clBlue;
2867 lblCIRNData.Font.Color := clBlue;
2868 lstCIRNLocations.Font.Color := clBlue;
2869 lblCIRN.Caption := 'Remote';
2870 lblCIRNData.Caption := 'Data*';
2871 lblCIRNAvail.Caption := 'Available';
2872 pnlCIRN.Caption := 'Remote Data Available';
2873 end
2874 else
2875 begin
2876 lblCIRN.Font.Color := clWindowText;
2877 lblCIRNData.Font.Color := clWindowText;
2878 lstCIRNLocations.Font.Color := clWindowText;
2879 lblCIRNAvail.Font.Color := clWindowText;
2880 end;
2881 end;
2882 pnlCIRNClick(self);
2883 Exit;
2884 end
2885 else
2886 lstCIRNLocations.Checked[iIndex] := false;
2887 end
2888 else
2889 begin
2890 ChangeVistaWebParam('0');
2891 lblCIRN.Caption := 'Remote';
2892 lblCIRNData.Caption := 'Data';
2893 pnlCIRN.Caption := 'Remote Data';
2894 lblCIRN.Width := 43;
2895 lblCIRNData.Width := 43;
2896 lblCIRNData.Alignment := taCenter;
2897 lblCIRN.Alignment := taCenter;
2898 pnlCIRNClick(self);
2899 Exit;
2900 end;
2901 if not CheckHL7TCPLink then
2902 begin
2903 InfoBox('Local HL7 TCP Link is down.' + CRLF + 'Unable to retrieve remote data.', TC_DGSR_ERR, MB_OK);
2904 lstCIRNLocations.Checked[iIndex] := false;
2905 Exit;
2906 end;
2907 if lstCIRNLocations.Items.Count > 1 then
2908 if piece(lstCIRNLocations.Items[1],'^',1) = '0' then
2909 iAll := 2;
2910 with frmReports do
2911 if piece(uRemoteType,'^',2) = 'V' then
2912 begin
2913 lvReports.Items.BeginUpdate;
2914 lvReports.Items.Clear;
2915 lvReports.Columns.Clear;
2916 lvReports.Items.EndUpdate;
2917 end;
2918 uReportInstruction := '';
2919 frmReports.TabControl1.Tabs.Clear;
2920 frmLabs.TabControl1.Tabs.Clear;
2921 frmReports.TabControl1.Tabs.AddObject('Local',nil);
2922 frmLabs.TabControl1.Tabs.AddObject('Local',nil);
2923 StatusText('Checking Remote Sites...');
2924 if piece(lstCIRNLocations.Items[iIndex],'^',1) = '0' then // All sites have been clicked
2925 if lstCIRNLocations.Checked[iIndex] = false then // All selection is being turned off
2926 begin
2927 with RemoteSites.SiteList do
2928 for j := 0 to Count - 1 do
2929 if lstCIRNLocations.Checked[j+2] = true then
2930 begin
2931 lstCIRNLocations.Checked[j+2] := false;
2932 TRemoteSite(RemoteSites.SiteList[j]).Selected := false;
2933 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2934 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2935 end;
2936 end
2937 else
2938 begin
2939 with RemoteSites.SiteList do
2940 for j := 0 to Count - 1 do
2941 begin
2942 Screen.Cursor := crHourGlass;
2943 {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[j]).SiteID,
2944 AccessStatus);}
2945 Screen.Cursor := crDefault;
2946 aMsg := aMsg + ' at site: ' + TRemoteSite(Items[j]).SiteName;
2947 s := lstCIRNLocations.Items[j+2];
2948 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3);
2949 case AccessStatus of
2950 DGSR_FAIL: begin
2951 if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
2952 begin
2953 lstCIRNLocations.Checked[j+2] := true;
2954 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2955 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2956 TRemoteSite(Items[j]).Selected := true;
2957 end
2958 else
2959 begin
2960 InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
2961 lstCIRNLocations.Checked[j+2] := false;
2962 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
2963 TRemoteSite(Items[j]).Selected := false;
2964 Continue;
2965 end;
2966 end;
2967 DGSR_NONE: begin
2968 lstCIRNLocations.Checked[j+2] := true;
2969 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2970 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2971 TRemoteSite(Items[j]).Selected := true;
2972 end;
2973 DGSR_SHOW: begin
2974 InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
2975 lstCIRNLocations.Checked[j+2] := true;
2976 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2977 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2978 TRemoteSite(Items[j]).Selected := true;
2979 end;
2980 DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
2981 MB_DEFBUTTON2) = IDYES then
2982 begin
2983 lstCIRNLocations.Checked[j+2] := true;
2984 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2985 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2986 TRemoteSite(Items[j]).Selected := true;
2987 end
2988 else
2989 begin
2990 lstCIRNLocations.Checked[j+2] := false;
2991 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
2992 TRemoteSite(Items[j]).Selected := false;
2993 Continue;
2994 end;
2995 else begin
2996 InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
2997 lstCIRNLocations.Checked[j+2] := false;
2998 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
2999 TRemoteSite(Items[j]).Selected := false;
3000 Continue;
3001 end;
3002 end;
3003 end;
3004 end
3005 else
3006 begin
3007 if iIndex > 0 then
3008 begin
3009 iCur := iIndex - iAll;
3010 TRemoteSite(RemoteSites.SiteList[iCur]).Selected :=
3011 lstCIRNLocations.Checked[iIndex];
3012 if lstCIRNLocations.Checked[iIndex] = true then
3013 with RemoteSites.SiteList do
3014 begin
3015 Screen.Cursor := crHourGlass;
3016 {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[iCur]).SiteID,
3017 AccessStatus);}
3018 Screen.Cursor := crDefault;
3019 aMsg := aMsg + ' at site: ' + TRemoteSite(Items[iCur]).SiteName;
3020 s := lstCIRNLocations.Items[iIndex];
3021 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3);
3022 case AccessStatus of
3023 DGSR_FAIL: begin
3024 if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
3025 begin
3026 lstCIRNLocations.Checked[iIndex] := true;
3027 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3028 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3029 TRemoteSite(Items[iCur]).Selected := true;
3030 end
3031 else
3032 begin
3033 InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
3034 lstCIRNLocations.Checked[iIndex] := false;
3035 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
3036 TRemoteSite(Items[iCur]).Selected := false;
3037 end;
3038 end;
3039 DGSR_NONE: begin
3040 lstCIRNLocations.Checked[iIndex] := true;
3041 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3042 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3043 TRemoteSite(Items[iCur]).Selected := true;
3044 end;
3045 DGSR_SHOW: begin
3046 InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
3047 lstCIRNLocations.Checked[iIndex] := true;
3048 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3049 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3050 TRemoteSite(Items[iCur]).Selected := true;
3051 end;
3052 DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
3053 MB_DEFBUTTON2) = IDYES then
3054 begin
3055 lstCIRNLocations.Checked[iIndex] := true;
3056 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3057 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3058 TRemoteSite(Items[iCur]).Selected := true;
3059 end
3060 else
3061 begin
3062 lstCIRNLocations.Checked[iIndex] := false;
3063 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
3064 end;
3065 else begin
3066 InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
3067 lstCIRNLocations.Checked[iIndex] := false;
3068 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
3069 TRemoteSite(Items[iCur]).Selected := false;
3070 end;
3071 end;
3072 with frmReports do
3073 if piece(uRemoteType,'^',1) = '1' then
3074 if not(piece(uRemoteType,'^',2) = 'V') then
3075 begin
3076 TabControl1.Visible := true;
3077 pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3078 end;
3079 with frmLabs do
3080 if lstReports.ItemIndex > -1 then
3081 if piece(lstReports.Items[lstReports.ItemIndex],'^',3) = '1' then
3082 if not(piece(lstReports.Items[lstReports.ItemIndex],'^',5) = 'V') then
3083 TabControl1.Visible := true;
3084 end;
3085 end;
3086 end;
3087 with RemoteSites.SiteList do
3088 for j := 0 to Count - 1 do
3089 if TRemoteSite(Items[j]).Selected then
3090 begin
3091 frmReports.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3092 TRemoteSite(Items[j]));
3093 frmLabs.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3094 TRemoteSite(Items[j]));
3095 end;
3096 //frmLabs.TabControl1.OnChange(nil);
3097 //frmReports.TabControl1.OnChange(nil);
3098 if frmReports.tvReports.SelectionCount > 0 then frmReports.tvReportsClick(self);
3099 if frmLabs.lstReports.ItemIndex > -1 then frmLabs.ExtlstReportsClick(self, true);
3100 StatusText('');
3101end;
3102
3103procedure TfrmFrame.popCIRNCloseClick(Sender: TObject);
3104begin
3105 lstCIRNLocations.Visible := False;
3106 lstCirnLocations.SendToBack;
3107 pnlCIRN.BevelOuter := bvRaised;
3108end;
3109
3110procedure TfrmFrame.popCIRNSelectAllClick(Sender: TObject);
3111
3112begin
3113 lstCIRNLocations.ItemIndex := 0;
3114 lstCIRNLocations.Checked[0] := true;
3115 lstCIRNLocations.OnClick(Self);
3116end;
3117
3118procedure TfrmFrame.popCIRNSelectNoneClick(Sender: TObject);
3119
3120begin
3121 lstCIRNLocations.ItemIndex := 0;
3122 lstCIRNLocations.Checked[0] := false;
3123 lstCIRNLocations.OnClick(Self);
3124end;
3125
3126procedure TfrmFrame.mnuFilePrintSetupClick(Sender: TObject);
3127var
3128 CurrPrt: string;
3129begin
3130 CurrPrt := SelectDevice(Self, Encounter.Location, True,'');
3131 User.CurrentPrinter := Piece(CurrPrt, U, 1);
3132end;
3133
3134procedure TfrmFrame.lstCIRNLocationsChange(Sender: TObject);
3135begin
3136 if lstCIRNLocations.ItemIndex > 0 then
3137 if (lstCIRNLocations.Selected[lstCIRNLocations.ItemIndex] = true) and (uUpdateStat = false) then
3138 if not (piece(lstCIRNLocations.Items[1],'^',1) = '0') then
3139 lstCIRNLocations.OnClick(nil);
3140end;
3141
3142procedure TfrmFrame.LabInfo1Click(Sender: TObject);
3143begin
3144 ExecuteLabInfo;
3145end;
3146
3147procedure TfrmFrame.mnuFileNotifRemoveClick(Sender: TObject);
3148const
3149 TC_REMOVE_ALERT = 'Remove Current Alert';
3150 TX_REMOVE_ALERT1 = 'This action will delete the alert you are currently processing; the alert will ' + CRLF +
3151 'disappear automatically when all orders have been acted on, but this action may' + CRLF +
3152 'be used to remove the alert if some orders are to be left unchanged.' + CRLF + CRLF +
3153 'Your ';
3154 TX_REMOVE_ALERT2 = ' alert for ';
3155 TX_REMOVE_ALERT3 = ' will be deleted!' + CRLF + CRLF + 'Are you sure?';
3156var
3157 AlertMsg, AlertType: string;
3158
3159 procedure StopProcessingNotifs;
3160 begin
3161 Notifications.Clear;
3162 FNextButtonActive := False;
3163 stsArea.Panels[2].Bevel := pbLowered;
3164 mnuFileNext.Enabled := False;
3165 mnuFileNotifRemove.Enabled := False;
3166 end;
3167
3168begin
3169 if not Notifications.Active then Exit;
3170 case Notifications.Followup of
3171 NF_MEDICATIONS_EXPIRING_INPT : AlertType := 'Expiring Medications';
3172 NF_MEDICATIONS_EXPIRING_OUTPT : AlertType := 'Expiring Medications';
3173 NF_ORDER_REQUIRES_ELEC_SIGNATURE: AlertType := 'Unsigned Orders';
3174 NF_FLAGGED_ORDERS : AlertType := 'Flagged Orders (for clarification)';
3175 NF_UNVERIFIED_MEDICATION_ORDER : AlertType := 'Unverified Medication Order';
3176 NF_UNVERIFIED_ORDER : AlertType := 'Unverified Order';
3177 NF_FLAGGED_OI_EXP_INPT : AlertType := 'Flagged Orderable Item (INPT)';
3178 NF_FLAGGED_OI_EXP_OUTPT : AlertType := 'Flagged Orderable Item (OUTPT)';
3179 else
3180 Exit;
3181 end;
3182 AlertMsg := TX_REMOVE_ALERT1 + AlertType + TX_REMOVE_ALERT2 + Patient.Name + TX_REMOVE_ALERT3;
3183 if InfoBox(AlertMsg, TC_REMOVE_ALERT, MB_YESNO) = ID_YES then
3184 begin
3185 Notifications.DeleteForCurrentUser;
3186 Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
3187 if Notifications.Active then
3188 begin
3189 if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
3190 begin
3191 Notifications.Prior;
3192 mnuFileNextClick(Self);
3193 end
3194 else
3195 StopProcessingNotifs;
3196 end
3197 else
3198 StopProcessingNotifs;
3199 end;
3200end;
3201
3202procedure TfrmFrame.mnuToolsOptionsClick(Sender: TObject);
3203// personal preferences - changes may need to be applied to chart
3204var
3205 i: integer;
3206begin
3207 i := 0;
3208 DialogOptions(i);
3209end;
3210
3211procedure TfrmFrame.LoadUserPreferences;
3212begin
3213 LoadSizesForUser;
3214// LoadUserVitalPreferences;
3215 GetUserTemplateDefaults(TRUE);
3216end;
3217
3218procedure TfrmFrame.SaveUserPreferences;
3219begin
3220 SaveSizesForUser; // position & size settings
3221// SaveUserVitalPreferences; // save Vitals metric setting
3222 SaveUserTemplateDefaults;
3223end;
3224
3225procedure TfrmFrame.mnuFileRefreshClick(Sender: TObject);
3226begin
3227 FRefreshing := TRUE;
3228 try
3229 mnuFileOpenClick(Self);
3230 finally
3231 FRefreshing := FALSE;
3232 end;
3233end;
3234
3235procedure TfrmFrame.AppActivated(Sender: TObject);
3236begin
3237 if assigned(FOldActivate) then
3238 FOldActivate(Sender);
3239 SetActiveWindow(Application.Handle);
3240end;
3241
3242// close Treatment Factor hint window if alt-tab pressed.
3243procedure TfrmFrame.AppDeActivated(Sender: TObject);
3244begin
3245 if FRVTFhintWindowActive then
3246 begin
3247 FRVTFHintWindow.ReleaseHandle;
3248 FRVTFHintWindowActive := False;
3249 end
3250 else
3251 if FOSTFHintWndActive then
3252 begin
3253 FOSTFhintWindow.ReleaseHandle;
3254 FOSTFHintWndActive := False ;
3255 end;
3256 if FHintWinActive then // graphing - hints on values
3257 begin
3258 FHintWin.ReleaseHandle;
3259 FHintWinActive := false;
3260 end;
3261end;
3262
3263(*procedure TfrmFrame.CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
3264begin
3265 AnInstance := TPage.Create(Self);
3266 TPage(AnInstance).Parent := pnlPage;
3267 TPage(AnInstance).Show;
3268 uTabList.Add(IntToStr(ATabID));
3269 tabPage.Tabs.Add(ALabel);
3270end;*)
3271
3272procedure TfrmFrame.CreateTab(ATabID: integer; ALabel: string);
3273begin
3274 // old comment - try making owner self (instead of application) to see if solves TMenuItem.Insert bug
3275 case ATabID of
3276 CT_PROBLEMS : begin
3277 frmProblems := TfrmProblems.Create(Self);
3278 frmProblems.Parent := pnlPage;
3279 end;
3280 CT_MEDS : begin
3281 frmMeds := TfrmMeds.Create(Self);
3282 frmMeds.Parent := pnlPage;
3283 frmMeds.InitfMedsSize;
3284 end;
3285 CT_ORDERS : begin
3286 frmOrders := TfrmOrders.Create(Self);
3287 frmOrders.Parent := pnlPage;
3288 end;
3289 CT_HP : begin
3290 // not yet
3291 end;
3292 CT_NOTES : begin
3293 frmNotes := TfrmNotes.Create(Self);
3294 frmNotes.Parent := pnlPage;
3295 end;
3296 CT_CONSULTS : begin
3297 frmConsults := TfrmConsults.Create(Self);
3298 frmConsults.Parent := pnlPage;
3299 end;
3300 CT_DCSUMM : begin
3301 frmDCSumm := TfrmDCSumm.Create(Self);
3302 frmDCSumm.Parent := pnlPage;
3303 end;
3304 CT_LABS : begin
3305 frmLabs := TfrmLabs.Create(Self);
3306 frmLabs.Parent := pnlPage;
3307 end;
3308 CT_REPORTS : begin
3309 frmReports := TfrmReports.Create(Self);
3310 frmReports.Parent := pnlPage;
3311 end;
3312 CT_SURGERY : begin
3313 frmSurgery := TfrmSurgery.Create(Self);
3314 frmSurgery.Parent := pnlPage;
3315 end;
3316 CT_COVER : begin
3317 frmCover := TfrmCover.Create(Self);
3318 frmCover.Parent := pnlPage;
3319 end;
3320 else
3321 Exit;
3322 end;
3323 if ATabID = CT_COVER then
3324 begin
3325 uTabList.Insert(0, IntToStr(ATabID));
3326 tabPage.Tabs.Insert(0, ALabel);
3327 tabPage.TabIndex := 0;
3328 end
3329 else
3330 begin
3331 uTabList.Add(IntToStr(ATabID));
3332 tabPage.Tabs.Add(ALabel);
3333 end;
3334end;
3335
3336procedure TfrmFrame.ShowHideChartTabMenus(AMenuItem: TMenuItem);
3337var
3338 i: integer;
3339begin
3340 for i := 0 to AMenuItem.Count - 1 do
3341 AMenuItem.Items[i].Visible := TabExists(AMenuItem.Items[i].Tag);
3342end;
3343
3344function TfrmFrame.TabExists(ATabID: integer): boolean;
3345begin
3346 Result := (uTabList.IndexOf(IntToStr(ATabID)) > -1)
3347end;
3348
3349procedure TfrmFrame.ReportsOnlyDisplay;
3350begin
3351
3352// Configure "Edit" menu:
3353menuHideAllBut(mnuEdit, mnuEditPref); // Hide everything under Edit menu except Preferences.
3354menuHideAllBut(mnuEditPref, Prefs1); // Hide everything under Preferences menu except Fonts.
3355
3356// Remaining pull-down menus:
3357mnuView.visible := false;
3358mnuFileRefresh.visible := false;
3359mnuFileEncounter.visible := false;
3360mnuFileReview.visible := false;
3361mnuFileNext.visible := false;
3362mnuFileNotifRemove.visible := false;
3363mnuHelpBroker.visible := false;
3364mnuHelpLists.visible := false;
3365mnuHelpSymbols.visible := false;
3366
3367// Top panel components:
3368//pnlVisit.visible := false;
3369pnlVisit.hint := 'Provider/Location';
3370pnlVisit.onMouseDown := nil;
3371pnlVisit.onMouseUp := nil;
3372//pnlPrimaryCare.visible := false;
3373//pnlPostings.visible := false;
3374//lblPtCWAD.visible := false;
3375//lblPtPostings.visible := false;
3376//pnlReminders.visible := false;
3377//anmtRemSearch.visible := false;
3378
3379// Forms for other tabs:
3380frmCover.visible := false;
3381frmProblems.visible := false;
3382frmMeds.visible := false;
3383frmOrders.visible := false;
3384frmNotes.visible := false;
3385frmConsults.visible := false;
3386frmDCSumm.visible := false;
3387if Assigned(frmSurgery) then
3388 frmSurgery.visible := false;
3389frmLabs.visible := false;
3390
3391// Other tabs (so to speak):
3392tabPage.tabs.clear;
3393tabPage.tabs.add('Reports');
3394
3395end;
3396
3397procedure TfrmFrame.UpdatePtInfoOnRefresh;
3398var
3399 tmpDFN: string;
3400begin
3401 tmpDFN := Patient.DFN;
3402 Patient.Clear;
3403 Patient.DFN := tmpDFN;
3404 uCore.TempEncounterLoc := 0; //hds7591 Clinic/Ward movement.
3405 uCore.TempEncounterLocName := ''; //hds7591 Clinic/Ward movement.
3406
3407 if (FPrevInPatient and Patient.Inpatient) then //transfering inside hospital
3408 Encounter.Location := Patient.Location
3409 else if (FPrevInPatient and (not Patient.Inpatient)) then //patient was discharged
3410 begin
3411 Encounter.Inpatient := False;
3412 Encounter.Location := 0;
3413 FPrevInPatient := False;
3414 end
3415 else if ((not FPrevInPatient) and Patient.Inpatient) then //patient was admitted
3416 begin
3417 Encounter.Inpatient := True;
3418 uCore.TempEncounterLoc := Encounter.Location; //hds7591 Clinic/Ward movement.
3419 uCore.TempEncounterLocName := Encounter.LocationName; //hds7591 Clinic/Ward movement.
3420 Encounter.Location := Patient.Location;
3421 Encounter.DateTime := Patient.AdmitTime;
3422 Encounter.VisitCategory := 'H';
3423 FPrevInPatient := True;
3424 end;
3425 //if User.IsProvider then Encounter.Provider := ;
3426 DisplayEncounterText;
3427end;
3428
3429procedure TfrmFrame.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
3430var
3431 NewTabIndex: integer;
3432begin
3433 //CQ2844: Toggle Remote Data button using Alt+R
3434 case Key of
3435 82,114: if (ssAlt in Shift) then
3436 frmFrame.pnlCIRNClick(Sender);
3437 end;
3438
3439 if (Key = VK_TAB) then begin
3440 if (ssCtrl in Shift) then begin
3441 if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
3442 NewTabIndex := tabPage.TabIndex;
3443 if ssShift in Shift then
3444 dec(NewTabIndex)
3445 else
3446 inc(NewTabIndex);
3447 if NewTabIndex >= tabPage.Tabs.Count then
3448 dec(NewTabIndex,tabPage.Tabs.Count)
3449 else if NewTabIndex < 0 then
3450 inc(NewTabIndex,tabPage.Tabs.Count);
3451 tabPage.TabIndex := NewTabIndex;
3452 tabPageChange(tabPage);
3453 Key := 0;
3454 end;
3455 end;
3456 end;
3457end;
3458
3459procedure TfrmFrame.FormActivate(Sender: TObject);
3460begin
3461 if Assigned(FLastPage) then
3462 FLastPage.FocusFirstControl;
3463end;
3464
3465procedure TfrmFrame.pnlPrimaryCareEnter(Sender: TObject);
3466begin
3467 with Sender as TPanel do
3468 if (ControlCount > 0) and (Controls[0] is TSpeedButton) and (TSpeedButton(Controls[0]).Down)
3469 then
3470 BevelInner := bvLowered
3471 else
3472 BevelInner := bvRaised;
3473end;
3474
3475procedure TfrmFrame.pnlPrimaryCareExit(Sender: TObject);
3476var
3477 ShiftIsDown,TabIsDown : boolean;
3478begin
3479 with Sender as TPanel do begin
3480 BevelInner := bvNone;
3481 //Make the lstCIRNLocations act as if between pnlCIRN & pnlReminders
3482 //in the Tab Order
3483 if (lstCIRNLocations.CanFocus) then
3484 begin
3485 ShiftIsDown := Boolean(Hi(GetKeyState(VK_SHIFT)));
3486 TabIsDown := Boolean(Hi(GetKeyState(VK_TAB)));
3487 if TabIsDown then
3488 if (ShiftIsDown) and (Name = 'pnlReminders') then
3489 lstCIRNLocations.SetFocus
3490 else if Not (ShiftIsDown) and (Name = 'pnlCIRN') then
3491 lstCIRNLocations.SetFocus;
3492 end;
3493 end;
3494end;
3495
3496procedure TfrmFrame.pnlPatientClick(Sender: TObject);
3497begin
3498 ViewInfo(mnuViewDemo);
3499end;
3500
3501procedure TfrmFrame.pnlVisitClick(Sender: TObject);
3502begin
3503 //if (not User.IsReportsOnly) then // Reports Only tab.
3504 // mnuFileEncounterClick(Self);
3505 ViewInfo(mnuViewVisits);
3506end;
3507
3508procedure TfrmFrame.pnlPrimaryCareClick(Sender: TObject);
3509begin
3510 //ReportBox(DetailPrimaryCare(Patient.DFN), 'Primary Care', True);
3511 ViewInfo(mnuViewPrimaryCare);
3512end;
3513
3514procedure TfrmFrame.pnlRemindersClick(Sender: TObject);
3515begin
3516 if(pnlReminders.tag = HAVE_REMINDERS) then
3517 ViewInfo(mnuViewReminders);
3518
3519end;
3520
3521procedure TfrmFrame.pnlPostingsClick(Sender: TObject);
3522begin
3523 ViewInfo(mnuViewPostings);
3524end;
3525
3526//=========================== CCOW main changes ========================
3527
3528procedure TfrmFrame.HandleCCOWError(AMessage: string);
3529begin
3530 {$ifdef DEBUG}
3531 ShowMessage(AMessage);
3532 {$endif}
3533 InfoBox(TX_CCOW_ERROR, TC_CCOW_ERROR, MB_ICONERROR or MB_OK);
3534 FCCOWInstalled := False;
3535 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_BROKEN');
3536 pnlCCOW.Hint := TX_CCOW_BROKEN;
3537 mnuFileResumeContext.Visible := True;
3538 mnuFileResumeContext.Enabled := False;
3539 mnuFileBreakContext.Visible := True;
3540 mnuFileBreakContext.Enabled := False;
3541 FCCOWError := True;
3542end;
3543
3544function TfrmFrame.AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean;
3545var
3546 PtData : IContextItemCollection;
3547 PtDataItem2, PtDataItem3, PtDataItem4 : IContextItem;
3548 response : UserResponse;
3549 StationNumber: string;
3550 IsProdAcct: boolean;
3551begin
3552 Result := False;
3553 response := 0;
3554 try
3555 // Start a context change transaction
3556 if FCCOWInstalled then
3557 begin
3558 FCCOWError := False;
3559 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
3560 pnlCCOW.Hint := TX_CCOW_CHANGING;
3561 try
3562 ctxContextor.StartContextChange();
3563 except
3564 on E: Exception do HandleCCOWError(E.Message);
3565 end;
3566 if FCCOWError then
3567 begin
3568 Result := False;
3569 Exit;
3570 end;
3571 // Set the new proposed context data.
3572 PtData := CoContextItemCollection.Create();
3573 StationNumber := User.StationNumber;
3574 IsProdAcct := User.IsProductionAccount;
3575
3576 {$IFDEF CCOWBROKER}
3577 //IsProdAcct := RPCBrokerV.Login.IsProduction; //not yet
3578 {$ENDIF}
3579
3580 PtDataItem2 := CoContextItem.Create();
3581 PtDataItem2.Set_Name('Patient.co.PatientName'); // Patient.Name
3582 PtDataItem2.Set_Value(Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^');
3583 PtData.Add(PtDataItem2);
3584
3585 PtDataItem3 := CoContextItem.Create();
3586 if not IsProdAcct then
3587 PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber + '_TEST') // Patient.DFN
3588 else
3589 PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber); // Patient.DFN
3590 PtDataItem3.Set_Value(Patient.DFN);
3591 PtData.Add(PtDataItem3);
3592
3593 if Patient.ICN <> '' then
3594 begin
3595 PtDataItem4 := CoContextItem.Create();
3596 if not IsProdAcct then
3597 PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber_TEST') // Patient.ICN
3598 else
3599 PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber'); // Patient.ICN
3600 PtDataItem4.Set_Value(Patient.ICN);
3601 PtData.Add(PtDataItem4);
3602 end;
3603
3604 // End the context change transaction.
3605 FCCOWError := False;
3606 try
3607 response := ctxContextor.EndContextChange(true, PtData);
3608 except
3609 on E: Exception do HandleCCOWError(E.Message);
3610 end;
3611 if FCCOWError then
3612 begin
3613 HideEverything;
3614 Result := False;
3615 Exit;
3616 end;
3617 end
3618 else
3619 //response := urBreak;
3620 begin
3621 Result := True;
3622 Exit;
3623 end;
3624
3625 CCOWResponse := response;
3626 if (response = UrCommit) then
3627 begin
3628 // New context is committed.
3629 //ShowMessage('Response was Commit');
3630 mnuFileResumeContext.Enabled := False;
3631 mnuFileBreakContext.Enabled := True;
3632 FCCOWIconName := 'BMP_CCOW_LINKED';
3633 pnlCCOW.Hint := TX_CCOW_LINKED;
3634 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3635 Result := True;
3636 end
3637 else if (response = UrCancel) then
3638 begin
3639 // Proposed context change is canceled. Return to the current context.
3640 PtData.RemoveAll;
3641 mnuFileResumeContext.Enabled := False;
3642 mnuFileBreakContext.Enabled := True;
3643 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3644 Result := False;
3645 end
3646 else if (response = UrBreak) then
3647 begin
3648 // The contextor has broken the link by suspending. This app should
3649 // update the Clinical Link icon, enable the Resume menu item, and
3650 // disable the Suspend menu item.
3651 PtData.RemoveAll;
3652 mnuFileResumeContext.Enabled := True;
3653 mnuFileBreakContext.Enabled := False;
3654 FCCOWIconName := 'BMP_CCOW_BROKEN';
3655 pnlCCOW.Hint := TX_CCOW_BROKEN;
3656 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3657 if Patient.Inpatient then
3658 begin
3659 Encounter.Inpatient := True;
3660 Encounter.Location := Patient.Location;
3661 Encounter.DateTime := Patient.AdmitTime;
3662 Encounter.VisitCategory := 'H';
3663 end;
3664 if User.IsProvider then Encounter.Provider := User.DUZ;
3665 SetupPatient;
3666 tabPage.TabIndex := PageIDToTab(User.InitialTab);
3667 tabPageChange(tabPage);
3668 Result := False;
3669 end;
3670 except
3671 on exc : EOleException do
3672 //ShowMessage('EOleException: ' + exc.Message + ' - ' + string(exc.ErrorCode) );
3673 ShowMessage('EOleException: ' + exc.Message);
3674 end;
3675end;
3676
3677procedure TfrmFrame.ctxContextorCanceled(Sender: TObject);
3678begin
3679 // Application should maintain its state as the current (existing) context.
3680 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3681end;
3682
3683procedure TfrmFrame.ctxContextorPending(Sender: TObject;
3684 const aContextItemCollection: IDispatch);
3685var
3686 Reason, HyperLinkReason: string;
3687 PtChanged: boolean;
3688{$IFDEF CCOWBROKER}
3689 UserChanged: boolean;
3690{$ENDIF}
3691begin
3692 // If the app would lose data, or have other problems changing context at
3693 // this time, it should return a message using SetSurveyReponse. Note that the
3694 // user may decide to commit the context change anyway.
3695 //
3696 // if (cannot-change-context-without-a-problem) then
3697 // contextor.SetSurveyResponse('Conditional accept reason...');
3698 if FCCOWBusy then
3699 begin
3700 Sleep(10000);
3701 end;
3702
3703 FCCOWError := False;
3704 try
3705 CheckForDifferentPatient(aContextItemCollection, PtChanged);
3706{$IFDEF CCOWBROKER}
3707 CheckForDifferentUser(aContextItemCollection, UserChanged);
3708{$ENDIF}
3709 except
3710 on E: Exception do HandleCCOWError(E.Message);
3711 end;
3712 if FCCOWError then
3713 begin
3714 HideEverything;
3715 Exit;
3716 end;
3717
3718{$IFDEF CCOWBROKER}
3719 if PtChanged or UserChanged then
3720{$ELSE}
3721 if PtChanged then
3722{$ENDIF}
3723 begin
3724 FCCOWContextChanging := True;
3725 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
3726 pnlCCOW.Hint := TX_CCOW_CHANGING;
3727 AllowContextChangeAll(Reason);
3728 end;
3729 CheckHyperlinkResponse(aContextItemCollection, HyperlinkReason);
3730 Reason := HyperlinkReason + Reason;
3731 if Pos('COM_OBJECT_ACTIVE', Reason) > 0 then
3732 Sleep(12000)
3733 else if Length(Reason) > 0 then
3734 ctxContextor.SetSurveyResponse(Reason);
3735 FCCOWContextChanging := False;
3736end;
3737
3738procedure TfrmFrame.ctxContextorCommitted(Sender: TObject);
3739var
3740 Reason: string;
3741 PtChanged: boolean;
3742 i: integer;
3743begin
3744 // Application should now access the new context and update its state.
3745 FCCOWError := False;
3746 try
3747 {$IFDEF CCOWBROKER}
3748 with RPCBrokerV do if (WasUserDefined and IsUserCleared and (ctxContextor.CurrentContext.Present(CCOW_USER_NAME) = nil)) then // RV 05/11/04
3749 begin
3750 Reason := 'COMMIT';
3751 if AllowContextChangeAll(Reason) then
3752 begin
3753 Close;
3754 Exit;
3755 end;
3756 end;
3757 {$ENDIF}
3758 CheckForDifferentPatient(ctxContextor.CurrentContext, PtChanged);
3759 except
3760 on E: Exception do HandleCCOWError(E.Message);
3761 end;
3762 if FCCOWError then
3763 begin
3764 HideEverything;
3765 Exit;
3766 end;
3767 if not PtChanged then exit;
3768 FCCOWDrivedChange := True;
3769 i := 0;
3770 while Length(Screen.Forms[i].Name) > 0 do
3771 begin
3772 if fsModal in Screen.Forms[i].FormState then
3773 begin
3774 Screen.Forms[i].ModalResult := mrCancel;
3775 i := i + 1;
3776 end else // the fsModal forms always sequenced prior to the none-fsModal forms
3777 Break;
3778 end;
3779 Reason := 'COMMIT';
3780 if AllowContextChangeAll(Reason) then UpdateCCOWContext;
3781 FCCOWIconName := 'BMP_CCOW_LINKED';
3782 pnlCCOW.Hint := TX_CCOW_LINKED;
3783 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3784end;
3785
3786//function TfrmFrame.FindBestCCOWDFN(var APatientName: string): string;
3787function TfrmFrame.FindBestCCOWDFN: string;
3788var
3789 data: IContextItemCollection;
3790 anItem: IContextItem;
3791 StationNumber, tempDFN: string;
3792 IsProdAcct: Boolean;
3793
3794 procedure FindNextBestDFN;
3795 begin
3796 StationNumber := User.StationNumber;
3797 if IsProdAcct then
3798 anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber)
3799 else
3800 anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber + '_TEST');
3801 if anItem <> nil then tempDFN := anItem.Get_Value();
3802 end;
3803
3804begin
3805 if uCore.User = nil then
3806 begin
3807 Result := '';
3808 exit;
3809 end;
3810 IsProdAcct := User.IsProductionAccount;
3811 {$IFDEF CCOWBROKER}
3812 //IsProdAcct := RPCBrokerV.Login.IsProduction; //not yet
3813 {$ENDIF}
3814 // Get an item collection of the current context
3815 FCCOWError := False;
3816 try
3817 data := ctxContextor.CurrentContext;
3818 except
3819 on E: Exception do HandleCCOWError(E.Message);
3820 end;
3821 if FCCOWError then
3822 begin
3823 HideEverything;
3824 Exit;
3825 end;
3826 // Retrieve the ContextItem name and value as strings
3827 if IsProdAcct then
3828 anItem := data.Present('Patient.id.MRN.NationalIDNumber')
3829 else
3830 anItem := data.Present('Patient.id.MRN.NationalIDNumber_TEST');
3831 if anItem <> nil then
3