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

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

Upload of OR_30_270, 1.0.26.69
File size: 155.9 KB
RevLine 
[459]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}
[460]7{$DEFINE CCOWBROKER}
[459]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;
[460]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;
[459]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);
[460]232 procedure AppEventsShortCut(var Msg: TWMKey; var Handled: Boolean);
[459]233 procedure mnuToolsClick(Sender: TObject);
[460]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);
[459]243 private
244 FJustEnteredApp : boolean;
245 FCCOWInstalled: boolean;
246 FCCOWContextChanging: boolean;
247 FCCOWIconName: string;
248 FCCOWDrivedChange: boolean;
249 FCCOWBusy: boolean;
250 FCCOWError: boolean;
[460]251 FNoPatientSelected: boolean;
[459]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;
[460]266 FOldActiveFormChange: TNotifyEvent;
[459]267 FECSAuthUser: Boolean;
268 FFixedStatusWidth: integer;
269 FPrevInPatient: Boolean;
270 FFirstLoad: Boolean;
271 FFlagList: TStringList;
272 FPrevPtID: string;
[460]273 FVitalsDLLActive: boolean;
274 FGraphFloatActive: boolean;
275 FGraphContext: string;
[459]276 procedure RefreshFixedStatusWidth;
[460]277 procedure FocusApplicationTopForm;
[459]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);
[460]301 //procedure SetUpCIRN;
[459]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;
[460]312 procedure StartCCOWContextor;
313 function AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean;
[459]314 procedure UpdateCCOWContext;
315 procedure CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
316 procedure CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
[460]317{$IFDEF CCOWBROKER}
318 procedure CheckForDifferentUser(aContextItemCollection: IDispatch; var UserChanged: boolean);
319{$ENDIF}
[459]320 procedure HideEverything;
321 procedure ShowEverything;
322 //function FindBestCCOWDFN(var APatientName: string): string;
[460]323 function FindBestCCOWDFN: string;
[459]324 procedure HandleCCOWError(AMessage: string);
325 public
[460]326 EnduringPtSelSplitterPos: integer;
[459]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;
[460]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;
[459]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,
[460]369 rMisc, Clipbrd, fLabs, fReports, rReports, fPtDemo, fEncnt, fPtCWAD, uCore, fAbout, fReview, fxBroker,
[459]370 fxLists, fxServer, ORSystem, fRptBox, fSplash, rODAllergy, uInit, fLabTests, fLabInfo,
371 uReminders, fReminderTree, ORClasses, fDeviceSelect, fDrawers, fReminderDialog, ShellAPI, rVitals,
[460]372 fOptions, fGraphs, rTemplates, fSurgery, rSurgery, uEventHooks, uSignItems, fDefaultEvent,rECS,
[459]373 fIconLegend, uOrders, fPtSelOptns, DateUtils, uSpell, uOrPtf, fPatientFlagMulti,
[460]374 fAlertForward, UBAGlobals, fBAOptionsDiagnoses, UBACore, fOrdersSign, uVitals, fOrdersRenew, uFormMonitor
375 {$IFDEF CCOWBROKER}
376 , CCOW_const
377 {$ENDIF}
378 ;
[459]379
[460]380var // RV 05/11/04
381 IsRunExecuted: Boolean = FALSE; // RV 05/11/04
382 GraphFloat: TfrmGraphs;
383
[459]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
[460]456 if frmFrame.VitalsDLLActive then
457 CloseVitalsDLL()
458 else
459 Close;
[459]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;
[460]509 if COMObjectActive or SpellCheckInProgress or VitalsDLLActive then
[459]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;
[460]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;
[459]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;
[460]622 FOldActiveFormChange := Screen.OnActiveFormChange;
[459]623 Screen.OnActiveFormChange := ScreenActiveFormChange;
624 if not (ParamSearch('CCOW')='DISABLE') then
625 try
[460]626 StartCCOWContextor;
[459]627 except
[460]628 IsRunExecuted := False;
[459]629 FCCOWInstalled := False;
630 pnlCCOW.Visible := False;
631 mnuFileResumeContext.Visible := False;
632 mnuFileBreakContext.Visible := False;
633 end
634 else
635 begin
[460]636 IsRunExecuted := False;
[459]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
[460]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
[459]668 if not ConnectToServer(TX_OPTION) then
669 begin
[460]670 if Assigned(RPCBrokerV) then
671 InfoBox(RPCBrokerV.RPCBError, 'Error', MB_OK or MB_ICONERROR);
[459]672 Close;
673 Exit;
674 end;
675
[460]676 if ctxContextor <> nil then
677 begin
678 if not (ParamSearch('CCOW') = 'PATIENTONLY') then
679 ctxContextor.NotificationFilter := ctxContextor.NotificationFilter + ';User';
680 end;
681
[459]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;
[460]689 Application.OnDeActivate := AppDeActivated;
690
[459]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;
[460]801 GraphFloatActive := false;
802 GraphContext := '';
[459]803 uRemoteType := '';
[460]804 FPrevPtID := '';
[459]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;
[460]818 SetFormMonitoring(true);
[459]819end;
820
[460]821procedure TfrmFrame.StartCCOWContextor;
[459]822begin
823 try
[460]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;
[459]836 except
837 on exc : EOleException do
[460]838 begin
839 IsRunExecuted := False;
840 FreeAndNil(ctxContextor);
841 try
842 ctxContextor := TContextorControl.Create(Self);
843 with ctxContextor do
[459]844 begin
[460]845 OnPending := ctxContextorPending;
846 OnCommitted := ctxContextorCommitted;
847 OnCanceled := ctxContextorCanceled;
[459]848 end;
[460]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;
[459]866 end;
[460]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;
[459]878
[460]879procedure TfrmFrame.UMInitiate(var Message: TMessage);
880begin
881 NotifyOtherApps(NAE_OPEN, IntToStr(User.DUZ));
[459]882 LoadUserPreferences;
[460]883 GetBAStatus(User.DUZ,Patient.DFN);
[459]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;
[460]894 Screen.OnActiveFormChange := FOldActiveFormChange;
[459]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;
[460]906 ctxContextor.Free;
[459]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;
[460]974 mnuTools.Insert(i, UserTool);
[459]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;
[460]1048 SetFormMonitoring(false);
[459]1049 if FCreateProgress < FCP_FINISH then FTerminate := True;
1050
1051 FlushNotifierBuffer;
1052 if FCreateProgress = FCP_FINISH then NotifyOtherApps(NAE_CLOSE, '');
1053 TerminateOtherAppNotification;
1054
[460]1055 if GraphFloat <> nil then
1056 begin
1057 if frmFrame.GraphFloatActive then
1058 GraphFloat.Close;
1059 GraphFloat.Release;
1060 end;
1061
[459]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
[460]1067 if FCreateProgress = FCP_FINISH then ClearFlag;
[459]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
[460]1096 //if GraphFloat <> nil then GraphFloat.Release;
[459]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;
[460]1328
[459]1329 HasActiveFlg(FlagList, HasFlag, Patient.DFN);
[460]1330 if HasFlag then
[459]1331 begin
[460]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;
[459]1342 end;
[460]1343 FPrevPtID := patient.DFN;
1344 frmCover.UpdateVAAButton; //VAA CQ7525 (moved here in v26.30 (RV))
[459]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;
[460]1355 CCOWResponse: UserResponse;
[462]1356
1357 procedure UpdatePatientInfoForAlert;
1358 begin
1359 if Patient.Inpatient then
1360 begin
1361 Encounter.Inpatient := True;
1362 Encounter.Location := Patient.Location;
1363 Encounter.DateTime := Patient.AdmitTime;
1364 Encounter.VisitCategory := 'H';
1365 end;
1366 if User.IsProvider then Encounter.Provider := User.DUZ;
1367 SetupPatient(FlaggedPTList);
1368 if (FlaggedPTList.IndexOf(Patient.DFN) < 0) then
1369 FlaggedPTList.Add(Patient.DFN);
1370 end;
1371
[459]1372begin
1373 SaveDFN := Patient.DFN;
1374 Notifications.Next;
1375 if Notifications.Active then
1376 begin
1377 NewDFN := Notifications.DFN;
1378 //Patient.DFN := Notifications.DFN;
1379 //if SaveDFN <> Patient.DFN then
1380 if SaveDFN <> NewDFN then
1381 begin
1382 // newdfn does not have new patient.co information for CCOW call
1383 if (AllowContextChangeAll(Reason)) then
1384 begin
1385 RemindersStarted := FALSE;
1386 Patient.DFN := NewDFN;
1387 Encounter.Clear;
1388 Changes.Clear;
1389 if Assigned(FlagList) then
1390 begin
1391 FlagList.Clear;
1392 HasFlag := False;
1393 HasActiveFlg(FlagList, HasFlag, NewDFN);
1394 end;
[462]1395 if FCCOWInstalled and (ctxContextor.State = csParticipating) then
[459]1396 begin
[462]1397 if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
1398 UpdatePatientInfoForAlert
1399 else
1400 begin
1401 case CCOWResponse of
1402 urCancel:
1403 begin
1404 Patient.DFN := SaveDFN;
1405 Notifications.Prior;
1406 Exit;
1407 end;
1408 urBreak:
1409 begin
1410 // do not revert to old DFN if context was manually broken by user - v26 (RV)
1411 if (ctxContextor.State = csParticipating) then Patient.DFN := SaveDFN;
1412 UpdatePatientInfoForAlert;
1413 end;
1414 else
1415 UpdatePatientInfoForAlert;
1416 end;
1417 end;
[459]1418 end
1419 else
[462]1420 UpdatePatientInfoForAlert
[459]1421 end else
1422 begin
1423 Patient.DFN := SaveDFN;
1424 Notifications.Prior;
1425 Exit;
1426 end;
1427 end;
1428 stsArea.Panels.Items[1].Text := Notifications.Text;
1429 FChangeSource := CC_NOTIFICATION;
1430 NextIndex := PageIDToTab(CT_COVER);
1431 tabPage.TabIndex := CT_NOPAGE;
1432 tabPageChange(tabPage);
1433 mnuFileNotifRemove.Enabled := Notifications.Followup in [NF_FLAGGED_ORDERS,
1434 NF_ORDER_REQUIRES_ELEC_SIGNATURE,
[460]1435 NF_MEDICATIONS_EXPIRING_INPT,
1436 NF_MEDICATIONS_EXPIRING_OUTPT,
[459]1437 NF_UNVERIFIED_MEDICATION_ORDER,
1438 NF_UNVERIFIED_ORDER,
1439 NF_FLAGGED_OI_EXP_INPT,
1440 NF_FLAGGED_OI_EXP_OUTPT];
1441 case Notifications.FollowUp of
1442 NF_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1443 NF_FLAGGED_ORDERS : NextIndex := PageIDToTab(CT_ORDERS);
1444 NF_ORDER_REQUIRES_ELEC_SIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
1445 NF_ABNORMAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1446 NF_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
1447 NF_CONSULT_REQUEST_RESOLUTION : NextIndex := PageIDToTab(CT_CONSULTS);
1448 NF_ABNORMAL_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
1449 NF_IMAGING_REQUEST_CANCEL_HELD : NextIndex := PageIDToTab(CT_ORDERS);
1450 NF_NEW_SERVICE_CONSULT_REQUEST : NextIndex := PageIDToTab(CT_CONSULTS);
1451 NF_CONSULT_REQUEST_CANCEL_HOLD : NextIndex := PageIDToTab(CT_CONSULTS);
1452 NF_SITE_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1453 NF_ORDERER_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1454 NF_ORDER_REQUIRES_COSIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
1455 NF_LAB_ORDER_CANCELED : NextIndex := PageIDToTab(CT_ORDERS);
1456 NF_STAT_RESULTS :
1457 if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'LRCH' then
1458 NextIndex := PageIDToTab(CT_LABS)
1459 else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'GMRC' then
1460 NextIndex := PageIDToTab(CT_CONSULTS)
1461 else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'RA' then
1462 NextIndex := PageIDToTab(CT_REPORTS);
1463 NF_DNR_EXPIRING : NextIndex := PageIDToTab(CT_ORDERS);
[460]1464 NF_MEDICATIONS_EXPIRING_INPT : NextIndex := PageIDToTab(CT_ORDERS);
1465 NF_MEDICATIONS_EXPIRING_OUTPT : NextIndex := PageIDToTab(CT_ORDERS);
[459]1466 NF_UNVERIFIED_MEDICATION_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1467 NF_NEW_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1468 NF_IMAGING_RESULTS_AMENDED : NextIndex := PageIDToTab(CT_REPORTS);
1469 NF_CRITICAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
1470 NF_UNVERIFIED_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1471 NF_FLAGGED_OI_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
1472 NF_FLAGGED_OI_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1473 NF_DC_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
1474 NF_CONSULT_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_CONSULTS);
1475 NF_DCSUMM_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_DCSUMM);
1476 NF_NOTES_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_NOTES);
1477 NF_CONSULT_REQUEST_UPDATED : NextIndex := PageIDToTab(CT_CONSULTS);
1478 NF_FLAGGED_OI_EXP_INPT : NextIndex := PageIDToTab(CT_ORDERS);
1479 NF_FLAGGED_OI_EXP_OUTPT : NextIndex := PageIDToTab(CT_ORDERS);
1480 NF_CONSULT_PROC_INTERPRETATION : NextIndex := PageIDToTab(CT_CONSULTS);
1481 NF_IMAGING_REQUEST_CHANGED :
1482 begin
1483 ReportBox(GetNotificationFollowUpText(Patient.DFN, Notifications.FollowUp, Notifications.AlertData), Pieces(Piece(Notifications.RecordID, U, 1), ':', 2, 3), True);
1484 Notifications.Delete;
1485 end;
1486 NF_LAB_THRESHOLD_EXCEEDED : NextIndex := PageIDToTab(CT_LABS);
1487 NF_SURGERY_UNSIGNED_NOTE : if TabExists(CT_SURGERY) then
1488 NextIndex := PageIDToTab(CT_SURGERY)
1489 else
1490 InfoBox(TX_NO_SURG_NOTIF, TC_NO_SURG_NOTIF, MB_OK);
1491 //NextIndex := PageIDToTab(CT_NOTES);
1492 else InfoBox(TX_UNK_NOTIF, TC_UNK_NOTIF, MB_OK);
1493 end;
1494 tabPage.TabIndex := NextIndex;
1495 tabPageChange(tabPage);
1496 end
1497 else mnuFileOpenClick(mnuFileNext);
1498end;
1499
1500
1501procedure TfrmFrame.SetBADxList;
1502var
1503 i: smallint;
1504begin
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 else
1512 begin
1513 //Kill the old Dx list
1514 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
1515 TObject(UBAGlobals.tempDxList[i]).Free;
1516
1517 UBAGlobals.tempDxList.Clear;
1518 Application.ProcessMessages;
1519
1520 //Create new Dx list for newly selected patient
1521 if not Assigned(UBAGlobals.tempDxList) then
1522 begin
1523 UBAGlobals.tempDxList := TList.Create;
1524 UBAGlobals.tempDxList.Count := 0;
1525 Application.ProcessMessages;
1526 end;
1527 end;
1528end;
1529
1530procedure TfrmFrame.mnuFileOpenClick(Sender: TObject);
1531{ select a new patient & update the header displays (patient id, encounter, postings) }
1532var
1533 SaveDFN, Reason: string;
1534 //NextTab: Integer; // moved up for visibility - v23.4 rV
[460]1535 ok, OldRemindersStarted, PtSelCancelled: boolean;
[459]1536 //i: smallint;
[460]1537 CCOWResponse: UserResponse;
[459]1538begin
[460]1539 PtSelCancelled := FALSE;
[459]1540 DetermineNextTab;
1541(* if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
1542 NextTab := TabToPageID(tabPage.TabIndex)
1543 else
1544 NextTab := User.InitialTab;
1545 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1546 if User.IsReportsOnly then // Reports Only tab.
1547 NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
1548 if not TabExists(NextTab) then NextTab := CT_COVER;
1549 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1550 if NextTab = CT_ORDERS then
1551 if frmOrders <> nil then with frmOrders do
1552 begin
1553 if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
1554 PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
1555 end;*)
1556 if not AllowContextChangeAll(Reason) then Exit;
1557
1558 // update status text here
1559 stsArea.Panels.Items[1].Text := '';
1560 if (not User.IsReportsOnly) then
1561 begin
1562 if not FRefreshing then
1563 begin
1564 Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
1565 if Notifications.Active then
1566 begin
1567 if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
1568 begin
1569 Notifications.Prior;
1570 Exit;
1571 end;
1572 end;
1573 if Notifications.Active then Notifications.Prior;
1574 end;
1575 end;
1576
[460]1577 if FNoPatientSelected then
1578 SaveDFN := ''
1579 else
1580 SaveDFN := Patient.DFN;
1581
[459]1582 OldRemindersStarted := RemindersStarted;
1583 RemindersStarted := FALSE;
1584 try
1585 if FRefreshing then
1586 begin
1587 UpdatePtInfoOnRefresh;
1588 ok := TRUE;
1589 end
1590 else
1591 begin
1592 ok := FALSE;
1593 if (not User.IsReportsOnly) then
1594 begin
1595 if FCCOWInstalled and (ctxContextor.State = csParticipating) then
1596 begin
1597 UpdateCCOWContext;
1598 if not FCCOWError then
1599 begin
1600 FCCOWIconName := 'BMP_CCOW_LINKED';
1601 pnlCCOW.Hint := TX_CCOW_LINKED;
1602 imgCCOW.Picture.Bitmap.LoadFromResourceName(hInstance, FCCOWIconName);
1603 end;
1604 end
1605 else
1606 begin
1607 FCCOWIconName := 'BMP_CCOW_BROKEN';
1608 pnlCCOW.Hint := TX_CCOW_BROKEN;
1609 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
1610 end;
1611 if (Patient.DFN = '') or (Sender = mnuFileOpen) or (Sender = mnuFileNext) or (Sender = mnuViewDemo) then
[460]1612 SelectPatient(SHOW_NOTIFICATIONS, Font.Size, PtSelCancelled);
1613 if PtSelCancelled then exit;
[459]1614 ShowEverything;
1615 DisplayEncounterText;
1616 FPrevInPatient := Patient.Inpatient;
1617 if Notifications.Active then
1618 begin
1619 // display 'next notification' button
1620 FNextButtonActive := True;
1621 with stsArea.Panels[2] do
1622 begin
1623 //Text := 'Next ->';
1624 Bevel := pbRaised;
1625 end;
1626 mnuFileNext.Enabled := True;
1627 mnuFileNextClick(Self);
1628 end
1629 else
1630 begin
1631 // hide the 'next notification' button
1632 FNextButtonActive := False;
1633 with stsArea.Panels[2] do
1634 begin
1635 //Text := '';
1636 Bevel := pbLowered;
1637 end;
1638 mnuFileNext.Enabled := False;
1639 mnuFileNotifRemove.Enabled := False;
1640 if Patient.DFN <> SaveDFN then
1641 ok := TRUE;
1642 end
1643 end
1644 else
1645 begin
1646 Notifications.Clear;
[460]1647 SelectPatient(False, Font.Size, PtSelCancelled); // Call Pt. Sel. w/o notifications.
1648 if PtSelCancelled then exit;
[459]1649 ShowEverything;
[460]1650 DisplayEncounterText;
[459]1651 FPrevInPatient := Patient.Inpatient;
1652 ok := TRUE;
1653 end;
1654 end;
1655 if ok then
1656 begin
1657 if FCCOWInstalled and (ctxContextor.State = csParticipating) and (not FRefreshing) then
1658 begin
[460]1659 if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
[459]1660 begin
1661 SetupPatient;
1662 tabPage.TabIndex := PageIDToTab(NextTab);
1663 tabPageChange(tabPage);
1664 end
1665 else
1666 begin
[460]1667 case CCOWResponse of
1668 urCancel: UpdateCCOWContext;
1669 urBreak:
1670 begin
1671 // do not revert to old DFN if context was manually broken by user - v26 (RV)
1672 if (ctxContextor.State = csParticipating) then Patient.DFN := SaveDFN;
1673 SetupPatient;
1674 tabPage.TabIndex := PageIDToTab(NextTab);
1675 tabPageChange(tabPage);
1676 end;
[462]1677 else
1678 begin
1679 SetupPatient;
1680 tabPage.TabIndex := PageIDToTab(NextTab);
1681 tabPageChange(tabPage);
1682 end;
[460]1683 end;
[459]1684 end;
1685 end
1686 else
1687 begin
1688 SetupPatient;
1689 tabPage.TabIndex := PageIDToTab(NextTab);
1690 tabPageChange(tabPage);
1691 end;
1692 end;
1693 finally
1694 if (not FRefreshing) and (Patient.DFN = SaveDFN) then
1695 RemindersStarted := OldRemindersStarted;
1696 FFirstLoad := False;
1697 end;
1698 {Begin BillingAware}
1699 if BILLING_AWARE then frmFrame.SetBADxList; //end IsBillingAware
1700 {End BillingAware}
[460]1701 //frmCover.UpdateVAAButton; //VAA CQ7525 CQ#7933 - moved to SetupPatient, before event hook execution (RV)
[459]1702end;
1703
1704procedure TfrmFrame.DetermineNextTab;
1705begin
1706 if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
1707 begin
1708 if (tabPage.TabIndex < 0) then
1709 NextTab := LastTab
1710 else
1711 NextTab := TabToPageID(tabPage.TabIndex);
1712 end
1713 else
1714 NextTab := User.InitialTab;
1715 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1716 if User.IsReportsOnly then // Reports Only tab.
1717 NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
1718 if not TabExists(NextTab) then NextTab := CT_COVER;
1719 if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1720 if NextTab = CT_ORDERS then
1721 if frmOrders <> nil then with frmOrders do
1722 begin
1723 if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
1724 PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
1725 end;
1726end;
1727
1728procedure TfrmFrame.mnuFileEncounterClick(Sender: TObject);
1729{ displays encounter window and updates encounter display in case encounter was updated }
1730begin
1731 UpdateEncounter(NPF_ALL); {*KCM*}
1732 DisplayEncounterText;
1733end;
1734
1735procedure TfrmFrame.mnuFileReviewClick(Sender: TObject);
1736{ displays the Review Changes window (which resets the Encounter object) }
1737var
1738 EventChanges: boolean;
1739 NameNeedLook: string;
1740begin
1741 EventChanges := False;
1742 NameNeedLook := '';
1743 UpdatePtInfoOnRefresh;
1744 if Changes.Count > 0 then
1745 begin
1746 if (frmOrders <> nil) and (frmOrders.TheCurrentView <> nil) and ( frmOrders.TheCurrentView.EventDelay.EventIFN>0) then
1747 begin
1748 EventChanges := True;
1749 NameNeedLook := frmOrders.TheCurrentView.ViewName;
1750 frmOrders.PtEvtCompleted(frmOrders.TheCurrentView.EventDelay.PtEventIFN, frmOrders.TheCurrentView.EventDelay.EventName);
1751 end;
1752 ReviewChanges(TimedOut, EventChanges);
1753 if TabToPageID(tabPage.TabIndex)= CT_MEDS then
1754 begin
1755 frmOrders.InitOrderSheets2(NameNeedLook);
1756 end;
1757 end
1758 else InfoBox('No new changes to review/sign.', 'Review Changes', MB_OK);
1759end;
1760
1761procedure TfrmFrame.mnuFileExitClick(Sender: TObject);
1762{ see the CloseQuery event }
1763var
1764 i: smallint;
1765begin
1766 try
1767 if BILLING_AWARE then
1768 begin
1769 if Assigned(tempDxList) then
1770 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
1771 TObject(UBAGlobals.tempDxList[i]).Free;
1772
1773 UBAGlobals.tempDxList.Clear;
1774 Application.ProcessMessages;
1775 end; //end IsBillingAware
1776 except
1777 on EAccessViolation do
1778 begin
1779 {$ifdef debug}ShowMessage('Access Violation in procedure TfrmFrame.mnuFileExitClick()');{$endif}
1780 raise;
1781 end;
1782 on E: Exception do
1783 begin
1784 {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmFrame.mnuFileExitClick()');{$endif}
1785 raise;
1786 end;
1787 end;
1788
1789 Close;
1790end;
1791
1792{ View Menu Events ------------------------------------------------------------------------- }
1793
1794procedure TfrmFrame.mnuViewPostingsClick(Sender: TObject);
1795begin
1796end;
1797
1798{ Tool Menu Events ------------------------------------------------------------------------- }
1799
1800function TfrmFrame.ExpandCommand(x: string): string;
1801{ look for 'macros' on the command line and expand them using current context }
1802
1803 procedure Substitute(const Key, Data: string);
1804 var
1805 Stop, Start: Integer;
1806 begin
1807 Stop := Pos(Key, x) - 1;
1808 Start := Stop + Length(Key) + 1;
1809 x := Copy(x, 1, Stop) + Data + Copy(x, Start, Length(x));
1810 end;
1811
1812begin
1813 if Pos('%MREF', x) > 0 then Substitute('%MREF',
1814 '^TMP(''ORWCHART'',' + MScalar('$J') + ',''' + DottedIPStr + ''',' + IntToHex(Handle, 8) + ')');
1815 if Pos('%SRV', x) > 0 then Substitute('%SRV', RPCBrokerV.Server);
1816 if Pos('%PORT', x) > 0 then Substitute('%PORT', IntToStr(RPCBrokerV.ListenerPort));
1817 if Pos('%DFN', x) > 0 then Substitute('%DFN', Patient.DFN); //*DFN*
1818 if Pos('%DUZ', x) > 0 then Substitute('%DUZ', IntToStr(User.DUZ));
1819 Result := x;
1820end;
1821
1822procedure TfrmFrame.ToolClick(Sender: TObject);
1823{ executes the program associated with an item on the Tools menu, the command line is stored
1824 in the item's hint property }
1825const
1826 TXT_ECS_NOTFOUND = 'The ECS application is not found at the default directory,' + #13 + 'would you like manually search it?';
1827 TC_ECS_NOTFOUND = 'Application Not Found';
1828var
1829 x, AFile, Param, MenuCommand, ECSAppend, CapNm, curPath : string;
1830 IsECSInterface: boolean;
1831
1832 function TakeOutAmps(AString: string): string;
1833 var
1834 S1,S2: string;
1835 begin
1836 if Pos('&',AString)=0 then
1837 begin
1838 Result := AString;
1839 Exit;
1840 end;
1841 S1 := Piece(AString,'&',1);
1842 S2 := Piece(AString,'&',2);
1843 Result := S1 + S2;
1844 end;
1845
1846 function ExcuteEC(AFile,APara: string): boolean;
1847 begin
1848 if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL) > 32 ) then Result := True
1849 else
1850 begin
1851 if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
1852 begin
1853 if OROpenDlg.Execute then
1854 begin
1855 AFile := OROpenDlg.FileName;
1856 if Pos('ecs gui.exe',lowerCase(AFile))<1 then
1857 begin
1858 ShowMessage('This is not a valid ECS application.');
1859 Result := True;
1860 end else
1861 begin
1862 if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL)<32) then Result := False
1863 else Result := True;
1864 end;
1865 end
1866 else Result := True;
1867 end else Result := True;
1868 end;
1869 end;
1870
1871 function ExcuteECS(AFile, APara: string; var currPath: string): boolean;
1872 var
1873 commandline,RPCHandle: string;
1874 StartupInfo: TStartupInfo;
1875 ProcessInfo: TProcessInformation;
1876 begin
1877 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
1878 with StartupInfo do
1879 begin
1880 cb := SizeOf(TStartupInfo);
1881 dwFlags := STARTF_USESHOWWINDOW;
1882 wShowWindow := SW_SHOWNORMAL;
1883 end;
1884 commandline := AFile + Param;
1885 RPCHandle := GetAppHandle(RPCBrokerV);
1886 commandline := commandline + ' H=' + RPCHandle;
1887 if CreateProcess(nil, PChar(commandline), nil, nil, False,
1888 NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then Result := True
1889 else
1890 begin
1891 if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
1892 begin
1893 if OROpenDlg.Execute then
1894 begin
1895 AFile := OROpenDlg.FileName;
1896 if Pos('ecs gui.exe',lowerCase(AFile))<1 then
1897 begin
1898 ShowMessage('This is not a valid ECS application.');
1899 Result := True;
1900 end else
1901 begin
1902 SaveUserPath('Event Capture Interface='+AFile, currPath);
1903 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
1904 with StartupInfo do
1905 begin
1906 cb := SizeOf(TStartupInfo);
1907 dwFlags := STARTF_USESHOWWINDOW;
1908 wShowWindow := SW_SHOWNORMAL;
1909 end;
1910 commandline := AFile + Param;
1911 RPCHandle := GetAppHandle(RPCBrokerV);
1912 commandline := commandline + ' H=' + RPCHandle;
1913 if not CreateProcess(nil, PChar(commandline), nil, nil, False,
1914 NORMAL_PRIORITY_CLASS, nil, nil,StartupInfo,ProcessInfo) then Result := False
1915 else Result := True;
1916 end;
1917 end
1918 else Result := True;
1919 end else Result := True;
1920 end;
1921 end;
1922
1923begin
1924 MenuCommand := '';
1925 ECSAppend := '';
1926 IsECSInterface := False;
1927 curPath := '';
1928 CapNm := LowerCase(TMenuItem(Sender).Caption);
1929 CapNm := TakeOutAmps(CapNm);
1930 if AnsiCompareText('event capture interface',CapNm)=0 then
1931 begin
1932 IsECSInterface := True;
1933 if FECSAuthUser then UpdateECSParameter(ECSAppend)
1934 else begin
1935 ShowMessage('You don''t have permission to use ECS.');
1936 exit;
1937 end;
1938 end;
1939 MenuCommand := TMenuItem(Sender).Hint + ECSAppend;
1940 x := ExpandCommand(MenuCommand);
1941 if CharAt(x, 1) = '"' then
1942 begin
1943 x := Copy(x, 2, Length(x));
1944 AFile := Copy(x, 1, Pos('"',x)-1);
1945 Param := Copy(x, Pos('"',x)+1, Length(x));
1946 end else
1947 begin
1948 AFile := Piece(x, ' ', 1);
1949 Param := Copy(x, Length(AFile)+1, Length(x));
1950 end;
1951 if IsECSInterface then
1952 begin
1953 if not ExcuteECS(AFile,Param,curPath) then
1954 ExcuteECS(AFile,Param,curPath);
1955 if Length(curPath)>0 then
1956 TMenuItem(Sender).Hint := curPath;
1957 end
1958 else if (Pos('ecs',LowerCase(AFile))>0) and (not IsECSInterface) then
1959 begin
1960 if not ExcuteEC(AFile,Param) then
1961 ExcuteEC(AFile,Param);
1962 end else
1963 begin
1964 ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL);
1965 end;
1966end;
1967
1968{ Help Menu Events ------------------------------------------------------------------------- }
1969
1970procedure TfrmFrame.mnuHelpBrokerClick(Sender: TObject);
1971{ used for debugging - shows last n broker calls }
1972begin
1973 ShowBroker;
1974end;
1975
1976procedure TfrmFrame.mnuHelpListsClick(Sender: TObject);
1977{ used for debugging - shows internal contents of TORListBox }
1978begin
1979 if Screen.ActiveControl is TListBox
1980 then DebugListItems(TListBox(Screen.ActiveControl))
1981 else InfoBox('Focus control is not a listbox', 'ListBox Data', MB_OK);
1982end;
1983
1984procedure TfrmFrame.mnuHelpSymbolsClick(Sender: TObject);
1985{ used for debugging - shows current symbol table }
1986begin
1987 DebugShowServer;
1988end;
1989
1990procedure TfrmFrame.mnuHelpAboutClick(Sender: TObject);
1991{ displays the about screen }
1992begin
1993 ShowAbout;
1994end;
1995
1996{ Status Bar Methods }
1997
1998procedure TfrmFrame.UMStatusText(var Message: TMessage);
1999{ displays status bar text (using the pointer to a text buffer passed in LParam) }
2000begin
2001 stsArea.Panels.Items[0].Text := StrPas(PChar(Message.LParam));
2002 stsArea.Refresh;
2003end;
2004
2005procedure TfrmFrame.stsAreaMouseDown(Sender: TObject; Button: TMouseButton;
2006 Shift: TShiftState; X, Y: Integer);
2007begin
2008 if (FNextButtonActive) and (X > FNextButtonL) and (X < FNextButtonR) then
2009 begin
2010 stsArea.Panels[2].Bevel := pbLowered;
2011 popAlerts.AutoPopup := TRUE;
2012 end;
2013end;
2014
2015procedure TfrmFrame.stsAreaMouseUp(Sender: TObject; Button: TMouseButton;
2016 Shift: TShiftState; X, Y: Integer);
2017begin
2018 if FNextButtonActive then
2019 begin
2020 stsArea.Panels[2].Bevel := pbRaised;
2021 popAlerts.AutoPopup := FALSE;
2022 if (X > FNextButtonL) and (X < FNextButtonR) then
2023 if Button = mbLeft then mnuFileNextClick(Self);
2024 end;
2025end;
2026
2027procedure TfrmFrame.stsAreaDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
2028 const Rect: TRect);
2029begin
2030 if FNextButtonActive then with StatusBar.Canvas do
2031 begin
2032 Draw(Rect.Left + 2, Rect.Top, FNextButtonBitmap); { draw bitmap }
2033 TextOut(Rect.Left + 20, Rect.Top + 2, 'Next'); { draw text to the right of the bitmap }
2034 end;
2035end;
2036
2037{ Toolbar Methods (make panels act like buttons) ------------------------------------------- }
2038
2039procedure TfrmFrame.pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
2040 Shift: TShiftState; X, Y: Integer);
2041{ emulate a button press in the patient identification panel }
2042begin
[460]2043 if pnlPatient.BevelOuter = bvLowered then exit;
[459]2044 pnlPatient.BevelOuter := bvLowered;
2045 with lblPtName do SetBounds(Left+2, Top+2, Width, Height);
2046 with lblPtSSN do SetBounds(Left+2, Top+2, Width, Height);
2047 with lblPtAge do SetBounds(Left+2, Top+2, Width, Height);
2048end;
2049
2050procedure TfrmFrame.pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
2051 Shift: TShiftState; X, Y: Integer);
2052{ emulate the button raising in the patient identification panel & call Patient Inquiry }
2053begin
[460]2054 if pnlPatient.BevelOuter = bvRaised then exit;
[459]2055 pnlPatient.BevelOuter := bvRaised;
2056 with lblPtName do SetBounds(Left-2, Top-2, Width, Height);
2057 with lblPtSSN do SetBounds(Left-2, Top-2, Width, Height);
2058 with lblPtAge do SetBounds(Left-2, Top-2, Width, Height);
2059end;
2060
2061procedure TfrmFrame.pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
2062 Shift: TShiftState; X, Y: Integer);
2063{ emulate a button press in the encounter panel }
2064begin
2065 if User.IsReportsOnly then
2066 exit;
2067 pnlVisit.BevelOuter := bvLowered;
2068 //with lblStLocation do SetBounds(Left+2, Top+2, Width, Height);
2069 with lblPtLocation do SetBounds(Left+2, Top+2, Width, Height);
2070 with lblPtProvider do SetBounds(Left+2, Top+2, Width, Height);
2071end;
2072
2073procedure TfrmFrame.pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
2074 Shift: TShiftState; X, Y: Integer);
2075{ emulate a button raising in the encounter panel and call Update Provider/Location }
2076begin
2077 if User.IsReportsOnly then
2078 exit;
2079 pnlVisit.BevelOuter := bvRaised;
2080 //with lblStLocation do SetBounds(Left-2, Top-2, Width, Height);
2081 with lblPtLocation do SetBounds(Left-2, Top-2, Width, Height);
2082 with lblPtProvider do SetBounds(Left-2, Top-2, Width, Height);
2083end;
2084
2085procedure TfrmFrame.pnlPrimaryCareMouseDown(Sender: TObject;
2086 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2087begin
2088 pnlPrimaryCare.BevelOuter := bvLowered;
2089 with lblPtCare do SetBounds(Left+2, Top+2, Width, Height);
2090 with lblPtAttending do SetBounds(Left+2, Top+2, Width, Height);
2091end;
2092
2093procedure TfrmFrame.pnlPrimaryCareMouseUp(Sender: TObject;
2094 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2095begin
2096 pnlPrimaryCare.BevelOuter := bvRaised;
2097 with lblPtCare do SetBounds(Left-2, Top-2, Width, Height);
2098 with lblPtAttending do SetBounds(Left-2, Top-2, Width, Height);
2099end;
2100
2101procedure TfrmFrame.pnlPostingsMouseDown(Sender: TObject;
2102 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2103{ emulate a button press in the postings panel }
2104begin
2105 pnlPostings.BevelOuter := bvLowered;
2106 with lblPtPostings do SetBounds(Left+2, Top+2, Width, Height);
2107 with lblPtCWAD do SetBounds(Left+2, Top+2, Width, Height);
2108end;
2109
2110procedure TfrmFrame.pnlPostingsMouseUp(Sender: TObject;
2111 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2112{ emulate a button raising in the posting panel and call Postings }
2113begin
2114 pnlPostings.BevelOuter := bvRaised;
2115 with lblPtPostings do SetBounds(Left-2, Top-2, Width, Height);
2116 with lblPtCWAD do SetBounds(Left-2, Top-2, Width, Height);
2117end;
2118
2119{ Resize and Font-Change procedures -------------------------------------------------------- }
2120
2121procedure TfrmFrame.LoadSizesForUser;
2122var
2123 s1, s2, s3, s4, Dummy: integer;
2124
2125 panelBottom, panelMedIn : integer;
2126
2127begin
2128 ChangeFont(UserFontSize);
2129 SetUserBounds(TControl(frmFrame));
2130 SetUserWidths(TControl(frmProblems.pnlLeft));
2131 //SetUserWidths(TControl(frmMeds.pnlLeft));
2132 SetUserWidths(TControl(frmOrders.pnlLeft));
2133 SetUserWidths(TControl(frmNotes.pnlLeft));
2134 SetUserWidths(TControl(frmConsults.pnlLeft));
2135 SetUserWidths(TControl(frmDCSumm.pnlLeft));
2136 if Assigned(frmSurgery) then SetUserWidths(TControl(frmSurgery.pnlLeft));
2137 SetUserWidths(TControl(frmLabs.pnlLeft));
2138 SetUserWidths(TControl(frmReports.pnlLeft));
2139 SetUserColumns(TControl(frmOrders.hdrOrders));
2140 SetUserColumns(TControl(frmMeds.hdrMedsIn)); // still need conversion
2141 SetUserColumns(TControl(frmMeds.hdrMedsOut));
2142 SetUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight);
2143 SetUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight);
2144 SetUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, Dummy ,Dummy);
2145 SetUserBounds2(DrawerSplitters,s1, s2, s3, Dummy);
[460]2146 if Assigned(frmSurgery) then frmSurgery.Drawers.LastOpenSize := Dummy; //CQ7315
[459]2147 frmNotes.Drawers.LastOpenSize := s1;
2148 frmConsults.Drawers.LastOpenSize := s2;
2149 frmDCSumm.Drawers.LastOpenSize := s3;
2150
2151 with frmMeds do
2152 begin
2153 SetUserBounds2(frmMeds.Name+'Split', panelBottom, panelMedIn, Dummy, Dummy);
2154 if (panelBottom > frmMeds.Height-50) then panelBottom := frmMeds.Height-50;
2155 if (panelMedIn > panelBottom-50) then panelMedIn := panelBottom-50;
2156 frmMeds.pnlBottom.Height := panelBottom;
2157 frmMeds.pnlMedIn.Height := panelMedIn;
[460]2158 //Meds Tab Non-VA meds columns
2159 SetUserColumns(TControl(hdrMedsNonVA)); //CQ7314
[459]2160 end;
2161
[460]2162 frmCover.DisableAlign;
[459]2163 try
2164 SetUserBounds2(CoverSplitters1, s1, s2, s3, s4);
2165 if s1 > 0 then
2166 frmCover.pnl_1.Width := LowerOf( frmCover.pnl_not3.ClientWidth - 5, s1);
2167 if s2 > 0 then
2168 frmCover.pnl_3.Width := LowerOf( frmCover.pnlTop.ClientWidth - 5, s2);
2169 if s3 > 0 then
2170 frmCover.pnlTop.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s3);
2171 if s4 > 0 then
2172 frmCover.pnl_4.Width := LowerOf( frmCover.pnlMiddle.ClientWidth - 5, s4);
2173
2174 SetUserBounds2(CoverSplitters2, s1, s2, s3, Dummy);
2175 if s1 > 0 then
2176 frmCover.pnlBottom.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s1);
2177 if s2 > 0 then
2178 frmCover.pnl_6.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s2);
2179 if s3 > 0 then
2180 frmCover.pnl_8.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s3);
2181
2182 finally
2183 frmCover.EnableAlign;
2184 end;
2185 if ParamSearch('rez') = '640' then SetBounds(Left, Top, 648, 488); // for testing
2186end;
2187
2188procedure TfrmFrame.SaveSizesForUser;
2189var
2190 SizeList: TStringList;
[460]2191 SurgTempHt: integer;
[459]2192begin
2193 SaveUserFontSize(MainFontSize);
2194 SizeList := TStringList.Create;
2195 try
2196 with SizeList do
2197 begin
2198 Add(StrUserBounds(frmFrame));
2199 Add(StrUserWidth(frmProblems.pnlLeft));
2200 //Add(StrUserWidth(frmMeds.pnlLeft));
2201 Add(StrUserWidth(frmOrders.pnlLeft));
2202 Add(StrUserWidth(frmNotes.pnlLeft));
2203 Add(StrUserWidth(frmConsults.pnlLeft));
2204 Add(StrUserWidth(frmDCSumm.pnlLeft));
2205 if Assigned(frmSurgery) then Add(StrUserWidth(frmSurgery.pnlLeft));
2206 Add(StrUserWidth(frmLabs.pnlLeft));
2207 Add(StrUserWidth(frmReports.pnlLeft));
2208 Add(StrUserColumns(frmOrders.hdrOrders));
2209 Add(StrUserColumns(frmMeds.hdrMedsIn));
2210 Add(StrUserColumns(frmMeds.hdrMedsOut));
2211 Add(StrUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight));
2212 Add(StrUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight));
2213 Add(StrUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, 0 ,0));
[460]2214
2215 //v26.47 - RV - access violation if Surgery Tab not enabled. Set to designer height as default.
2216 if Assigned(frmSurgery) then SurgTempHt := frmSurgery.Drawers.pnlTemplates.Height else SurgTempHt := 85;
[459]2217 Add(StrUserBounds2(DrawerSplitters, frmNotes.Drawers.LastOpenSize,
2218 frmConsults.Drawers.LastOpenSize,
[460]2219 frmDCSumm.Drawers.LastOpenSize,
2220 SurgTempHt)); // last parameter = CQ7315
2221
[459]2222 Add(StrUserBounds2(CoverSplitters1,
2223 frmCover.pnl_1.Width,
2224 frmCover.pnl_3.Width,
2225 frmCover.pnlTop.Height,
2226 frmCover.pnl_4.Width));
2227 Add(StrUserBounds2(CoverSplitters2,
2228 frmCover.pnlBottom.Height,
2229 frmCover.pnl_6.Width,
2230 frmCover.pnl_8.Width,
2231 0));
2232
2233 //Meds Tab Splitters
2234 Add(StrUserBounds2(frmMeds.Name+'Split',frmMeds.pnlBottom.Height,frmMeds.pnlMedIn.Height,0,0));
2235
[460]2236 //Meds Tab Non-VA meds columns
2237 Add(StrUserColumns(fMeds.frmMeds.hdrMedsNonVA)); //CQ7314
2238
2239 //Orders Tab columns
2240 Add(StrUserColumns(fOrders.frmOrders.hdrOrders)); //CQ6328
2241
[459]2242 if EnduringPtSelSplitterPos <> 0 then
2243 Add(StrUserBounds2('frmPtSel.sptVert', EnduringPtSelSplitterPos, 0, 0, 0));
2244 end;
2245 //Add sizes for forms that used SaveUserBounds() to save thier positions
2246 SizeHolder.AddSizesToStrList(SizeList);
2247 //Send the SizeList to the Database
2248 SaveUserSizes(SizeList);
2249 finally
2250 SizeList.Free;
2251 end;
2252end;
2253
2254procedure TfrmFrame.FormResize(Sender: TObject);
2255{ need to resize tab forms specifically since they don't inherit resize event (because they
2256 are derived from TForm itself) }
2257begin
2258 if FTerminate or FClosing then Exit;
2259 if csDestroying in ComponentState then Exit;
2260 MoveWindow(frmCover.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2261 MoveWindow(frmProblems.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2262 MoveWindow(frmMeds.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2263 MoveWindow(frmOrders.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2264 MoveWindow(frmNotes.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2265 MoveWindow(frmConsults.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2266 MoveWindow(frmDCSumm.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2267 if Assigned(frmSurgery) then MoveWindow(frmSurgery.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2268 MoveWindow(frmLabs.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2269 MoveWindow(frmReports.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2270 with stsArea do
2271 begin
2272 Panels[1].Width := stsArea.Width - FFixedStatusWidth;
2273 FNextButtonL := Panels[0].Width + Panels[1].Width;
2274 FNextButtonR := FNextButtonL + Panels[2].Width;
2275 end;
2276 lstCIRNLocations.Left := FNextButtonL - ScrollBarWidth - 100;
2277 lstCIRNLocations.Width := ClientWidth - lstCIRNLocations.Left;
2278 Self.Repaint;
2279end;
2280
2281procedure TfrmFrame.ChangeFont(NewFontSize: Integer);
2282{ Makes changes in all components whenever the font size is changed. This is hardcoded and
2283 based on MS Sans Serif for now, as only the font size may be selected. Courier New is used
2284 wherever non-proportional fonts are required. }
2285const
2286 TAB_VOFFSET = 7;
2287var
2288 OldFont: TFont;
2289begin
2290// Ho ho! ResizeAnchoredFormToFont(self) doesn't work here because the
2291// Form size is aliased with MainFormSize.
2292 OldFont := TFont.Create;
2293 try
2294 DisableAlign;
2295 try
2296 OldFont.Assign(Font);
2297 with Self do Font.Size := NewFontSize;
2298 with lblPtName do Font.Size := NewFontSize; // must change BOLDED labels by hand
2299 with lblPtSSN do Font.Size := NewFontSize;
2300 with lblPtAge do Font.Size := NewFontSize;
2301 with lblPtLocation do Font.Size := NewFontSize;
2302 with lblPtProvider do Font.Size := NewFontSize;
2303 with lblPtPostings do Font.Size := NewFontSize;
2304 with lblPtCare do Font.Size := NewFontSize;
2305 with lblPtAttending do Font.Size := NewFontSize;
2306 with lblFlag do Font.Size := NewFontSize;
2307 with lblPtCWAD do Font.Size := NewFontSize;
2308 with lblCIRN do Font.Size := NewFontSize;
2309 with lblCIRNData do Font.Size := NewFontSize;
2310 with lstCIRNLocations do Font.Size := NewFontSize;
2311 with tabPage do Font.Size := NewFontSize;
[460]2312 with laMHV do Font.Size := NewFontSize; //VAA
2313 with laVAA2 do Font.Size := NewFontSize; //VAA
[459]2314
2315 tabPage.Height := MainFontHeight + TAB_VOFFSET; // resize tab selector
2316 FitToolbar; // resize toolbar
2317 stsArea.Font.Size := NewFontSize;
2318 stsArea.Height := MainFontHeight + TAB_VOFFSET;
2319 stsArea.Panels[0].Width := ResizeWidth( OldFont, Font, stsArea.Panels[0].Width);
2320 stsArea.Panels[2].Width := ResizeWidth( OldFont, Font, stsArea.Panels[2].Width);
[460]2321
2322 //VAA CQ8271
2323 if ((fCover.PtIsVAA and fCover.PtIsMHV)) then
2324 begin
2325 laMHV.Height := (pnlToolBar.Height div 2) -1;
2326 with laVAA2 do
2327 begin
2328 Top := laMHV.Top + laMHV.Height;
2329 Height := (pnlToolBar.Height div 2) -1;
2330 end;
2331 end;
2332 //end VAA
2333
[459]2334 RefreshFixedStatusWidth;
2335 FormResize( self );
2336 finally
2337 EnableAlign;
2338 end;
2339 finally
2340 OldFont.Free;
2341 end;
2342
2343 //remove CWAD color if using high-contrast colors
2344 if ColorToRGB(clWindowText) <> ColorToRGB(clBlack) then
2345 begin
2346 lblPtCWAD.Font.Color := clWindowText;
2347 lblFlag.Font.Color := clWindowText;
2348 end;
2349
[460]2350 case (NewFontSize) of
2351 8: mnu8pt.Checked := true;
2352 10: mnu10pt1.Checked := true;
2353 12: mnu12pt1.Checked := true;
2354 14: mnu14pt1.Checked := true;
2355 18: mnu18pt1.Checked := true;
2356 24: mnu24pt1.Checked := true;
2357 end;
2358
[459]2359 //Now that the form elements are resized, the pages will know what size to take.
2360 frmCover.SetFontSize(NewFontSize); // child pages lack a ParentFont property
2361 frmProblems.SetFontSize(NewFontSize);
2362 frmMeds.SetFontSize(NewFontSize);
2363 frmOrders.SetFontSize(NewFontSize);
2364 frmNotes.SetFontSize(NewFontSize);
2365 frmConsults.SetFontSize(NewFontSize);
2366 frmDCSumm.SetFontSize(NewFontSize);
2367 if Assigned(frmSurgery) then frmSurgery.SetFontSize(NewFontSize);
2368 frmLabs.SetFontSize(NewFontSize);
2369 frmReports.SetFontSize(NewFontSize);
2370 TfrmIconLegend.SetFontSize(NewFontSize);
2371 uOrders.SetFontSize(NewFontSize);
2372 if Assigned(frmRemDlg) then frmRemDlg.SetFontSize;
2373 if Assigned(frmReminderTree) then frmReminderTree.SetFontSize(NewFontSize);
[460]2374 if GraphFloat <> nil then ResizeAnchoredFormToFont(GraphFloat);
[459]2375end;
2376
2377procedure TfrmFrame.FitToolBar;
2378{ resizes and repositions the panels & labels used in the toolbar }
2379const
2380 PATIENT_WIDTH = 29;
2381 VISIT_WIDTH = 36;
2382 POSTING_WIDTH = 11.5;
[460]2383 FLAG_WIDTH = 5;
[459]2384 CIRN_WIDTH = 7;
[460]2385 MHV_WIDTH = 6;
[459]2386 LINES_HIGH = 2;
2387 M_HORIZ = 4;
2388 M_MIDDLE = 2;
2389 M_NVERT = 4;
2390 M_WVERT = 6;
2391 TINY_MARGIN = 2;
[460]2392//var
2393 //WidthNeeded: integer;
[459]2394begin
2395 pnlToolbar.Height := (LINES_HIGH * lblPtName.Height) + M_HORIZ + M_MIDDLE + M_HORIZ;
2396 pnlPatient.Width := HigherOf(PATIENT_WIDTH * MainFontWidth, lblPtName.Width + (M_WVERT * 2));
2397 lblPtSSN.Top := M_HORIZ + lblPtName.Height + M_MIDDLE;
2398 lblPtAge.Top := lblPtSSN.Top;
2399 lblPtAge.Left := pnlPatient.Width - lblPtAge.Width - M_WVERT;
2400 pnlVisit.Width := HigherOf(LowerOf(VISIT_WIDTH * MainFontWidth,
2401 HigherOf(lblPtProvider.Width + (M_WVERT * 2),
2402 lblPtLocation.Width + (M_WVERT * 2))),
2403 PATIENT_WIDTH * MainFontWidth);
2404 lblPtProvider.Top := lblPtSSN.Top;
2405 lblPtAttending.Top := lblPtSSN.Top;
2406 lblCIRNData.Top := lblPtSSN.Top;
2407 pnlPostings.Width := Round(POSTING_WIDTH * MainFontWidth);
2408 pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
2409 pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
[460]2410 pnlCIRN.Width := Round(CIRN_WIDTH * MainFontWidth) + M_WVERT;
2411 paVAA.Width := Round(MHV_WIDTH * MainFontWidth) + M_WVERT;
[459]2412 with lblPtPostings do
2413 SetBounds(M_WVERT, M_HORIZ, pnlPostings.Width-M_WVERT-M_WVERT, lblPtName.Height);
2414 with lblPtCWAD do
2415 SetBounds(M_WVERT, lblPtSSN.Top, lblPtPostings.Width, lblPtName.Height);
2416 //Low resolution handling: First, try to fit everything on by shrinking fields
2417 if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
2418 begin
2419 lblPtAge.Left := lblPtAge.Left - (lblPtName.Left - TINY_MARGIN);
2420 lblPtName.Left := TINY_MARGIN;
2421 lblPTSSN.Left := TINY_MARGIN;
2422 pnlPatient.Width := HigherOf( lblPtName.Left + lblPtName.Width, lblPtAge.Left + lblPtAge.Width)+ TINY_MARGIN;
2423 lblPtLocation.Left := TINY_MARGIN;
2424 lblPtProvider.Left := TINY_MARGIN;
2425 pnlVisit.Width := HigherOf( lblPtLocation.Left + lblPtLocation.Width, lblPtProvider.Left + lblPtProvider.Width)+ TINY_MARGIN;
2426 end;
2427 //If that is not enough, add scroll bars to form
[460]2428 {if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
[459]2429 begin
2430 WidthNeeded := HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN - pnlPrimaryCare.Width;
2431 HorzScrollBar.Range := ClientWidth + WidthNeeded;
2432 Width := Width + WidthNeeded;
2433 end
[460]2434 else } // commented out - BA
[459]2435 HorzScrollBar.Range := 0;
2436end;
2437
2438{ Temporary Calls -------------------------------------------------------------------------- }
2439
[460]2440procedure TfrmFrame.ToggleMenuItemChecked(Sender: TObject);
2441begin
2442 with (Sender as TMenuItem) do
2443 begin
2444 if not Checked then
2445 Checked := true
2446 else
2447 Checked := false;
2448 end;
2449end;
2450
[459]2451procedure TfrmFrame.mnuFontSizeClick(Sender: TObject);
2452begin
2453 if (frmRemDlg <> nil) then
2454 ShowMessage('Please close the reminder dialog before changing font sizes.')
[460]2455 else
2456 if (dlgProbs <> nil) then
[459]2457 ShowMessage('Font size cannot be changed while adding or editing a problem.')
2458 else
[460]2459 begin
2460 with (Sender as TMenuItem) do
2461 begin
2462 ToggleMenuItemChecked(Sender);
2463 fMeds.oldFont := MainFontSize; //CQ9182
2464 ChangeFont(Tag);
2465 end;
2466 end;
[459]2467end;
2468
2469procedure TfrmFrame.mnuEditClick(Sender: TObject);
2470var
2471 IsReadOnly: Boolean;
2472begin
2473 FEditCtrl := nil;
2474 if Screen.ActiveControl is TCustomEdit then FEditCtrl := TCustomEdit(Screen.ActiveControl);
2475 if FEditCtrl <> nil then
2476 begin
2477 if FEditCtrl is TMemo then IsReadOnly := TMemo(FEditCtrl).ReadOnly
2478 else if FEditCtrl is TEdit then IsReadOnly := TEdit(FEditCtrl).ReadOnly
2479 else if FEditCtrl is TRichEdit then IsReadOnly := TRichEdit(FEditCtrl).ReadOnly
2480 else IsReadOnly := True;
2481 mnuEditUndo.Enabled := FEditCtrl.Perform(EM_CANUNDO, 0, 0) <> 0;
2482 mnuEditCut.Enabled := FEditCtrl.SelLength > 0;
2483 mnuEditCopy.Enabled := mnuEditCut.Enabled;
2484 mnuEditPaste.Enabled := (IsReadOnly = False) and Clipboard.HasFormat(CF_TEXT);
2485 end else
2486 begin
2487 mnuEditUndo.Enabled := False;
2488 mnuEditCut.Enabled := False;
2489 mnuEditCopy.Enabled := False;
2490 mnuEditPaste.Enabled := False;
2491 end;
2492end;
2493
2494procedure TfrmFrame.mnuEditUndoClick(Sender: TObject);
2495begin
2496 FEditCtrl.Perform(EM_UNDO, 0, 0);
2497end;
2498
2499procedure TfrmFrame.mnuEditCutClick(Sender: TObject);
2500begin
2501 FEditCtrl.CutToClipboard;
2502end;
2503
2504procedure TfrmFrame.mnuEditCopyClick(Sender: TObject);
2505begin
2506 FEditCtrl.CopyToClipboard;
2507end;
2508
2509procedure TfrmFrame.mnuEditPasteClick(Sender: TObject);
2510begin
2511 FEditCtrl.SelText := Clipboard.AsText;
2512 //FEditCtrl.PasteFromClipboard; // use AsText to prevent formatting from being pasted
2513end;
2514
2515procedure TfrmFrame.mnuFilePrintClick(Sender: TObject);
2516begin
2517 case mnuFilePrint.Tag of
2518 CT_NOTES: frmNotes.RequestPrint;
2519 CT_CONSULTS: frmConsults.RequestPrint;
2520 CT_DCSUMM: frmDCSumm.RequestPrint;
2521 CT_REPORTS: frmReports.RequestPrint;
2522 CT_LABS: frmLabs.RequestPrint;
2523 CT_ORDERS: frmOrders.RequestPrint;
2524 CT_PROBLEMS: frmProblems.RequestPrint;
2525 CT_SURGERY: if Assigned(frmSurgery) then frmSurgery.RequestPrint;
2526 end;
2527end;
2528
2529function TfrmFrame.FormHelp(Command: Word; Data: Integer;
2530 var CallHelp: Boolean): Boolean;
2531var
2532 ActiveForm: TForm;
2533begin
2534 inherited;
2535 if Screen.ActiveForm <> nil then
2536 begin
2537 if Screen.ActiveForm.ActiveControl <> nil then
2538 begin
2539 if Screen.ActiveForm.ActiveControl is TForm then
2540 ActiveForm := TForm(Screen.ActiveForm.ActiveControl)
2541 else if Screen.ActiveForm.ActiveControl.Owner is TForm then
2542 ActiveForm := TForm(Screen.ActiveForm.ActiveControl.Owner)
2543 else
2544 ActiveForm := Screen.ActiveForm;
2545 end
2546 else
2547 ActiveForm := Screen.ActiveForm;
2548 HelpFile := ActiveForm.HelpFile;
2549 end ;
2550 Result := True;
2551end;
2552
2553procedure TfrmFrame.WMSysCommand(var Message: TMessage);
2554begin
2555 case TabToPageID(tabPage.TabIndex) of
2556 CT_NOTES:
2557 if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2558 with Message do
2559 begin
2560 SendMessage(frmNotes.Handle, Msg, WParam, LParam);
2561 Result := 0;
2562 end
2563 else
2564 inherited;
2565 CT_DCSUMM:
2566 if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboAttending') then
2567 with Message do
2568 begin
2569 SendMessage(frmDCSumm.Handle, Msg, WParam, lParam);
2570 Result := 0;
2571 end
2572 else
2573 inherited;
2574 CT_CONSULTS:
2575 if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2576 with Message do
2577 begin
2578 SendMessage(frmConsults.Handle, Msg, WParam, lParam);
2579 Result := 0;
2580 end
2581 else
2582 inherited;
2583 else
2584 inherited;
2585 end;
[460]2586 if Message.WParam = SC_MAXIMIZE then
2587 begin
2588 // form becomes maximized;
2589 frmOrders.mnuOptimizeFieldsClick(self);
2590 frmProblems.mnuOptimizeFieldsClick(self);
2591 frmMeds.mnuOptimizeFieldsClick(self);
2592 end
2593 else if Message.WParam = SC_MINIMIZE then
2594 begin
2595 // form becomes maximized;
2596 end
2597 else if Message.WParam = SC_RESTORE then
2598 begin
2599 // form is restored (from maximized);
2600 frmOrders.mnuOptimizeFieldsClick(self);
2601 frmProblems.mnuOptimizeFieldsClick(self);
2602 frmMeds.mnuOptimizeFieldsClick(self);
2603 end;
[459]2604end;
2605
2606procedure TfrmFrame.RemindersChanged(Sender: TObject);
2607var
2608 ImgName: string;
2609begin
2610 pnlReminders.tag := HAVE_REMINDERS;
2611 pnlReminders.Hint := 'Click to display reminders';
2612 case GetReminderStatus of
2613 rsUnknown:
2614 begin
2615 ImgName := 'BMP_REMINDERS_UNKNOWN';
2616 pnlReminders.Caption := 'Reminders';
2617 end;
2618 rsDue:
2619 begin
2620 ImgName := 'BMP_REMINDERS_DUE';
2621 pnlReminders.Caption := 'Due Reminders';
2622 end;
2623 rsApplicable:
2624 begin
2625 ImgName := 'BMP_REMINDERS_APPLICABLE';
2626 pnlReminders.Caption := 'Applicable Reminders';
2627 end;
2628 rsNotApplicable:
2629 begin
2630 ImgName := 'BMP_REMINDERS_OTHER';
2631 pnlReminders.Caption := 'Other Reminders';
2632 end;
2633 else
2634 begin
2635 ImgName := 'BMP_REMINDERS_NONE';
2636 pnlReminders.Hint := 'There are currently no reminders available';
2637 pnlReminders.Caption := pnlReminders.Hint;
2638 pnlReminders.tag := NO_REMINDERS;
2639 end;
2640 end;
2641 if(RemindersEvaluatingInBackground) then
2642 begin
2643 if(anmtRemSearch.ResName = '') then
2644 begin
2645 TORExposedAnimate(anmtRemSearch).OnMouseDown := pnlRemindersMouseDown;
2646 TORExposedAnimate(anmtRemSearch).OnMouseUp := pnlRemindersMouseUp;
2647 anmtRemSearch.ResHandle := 0;
2648 anmtRemSearch.ResName := 'REMSEARCHAVI';
2649 end;
2650 imgReminder.Visible := FALSE;
2651 anmtRemSearch.Active := TRUE;
2652 anmtRemSearch.Visible := TRUE;
2653 if(pnlReminders.Hint <> '') then
2654 pnlReminders.Hint := CRLF + pnlReminders.Hint + '.';
2655 pnlReminders.Hint := 'Evaluating Reminders... ' + pnlReminders.Hint;
2656 pnlReminders.Caption := pnlReminders.Hint;
2657 end
2658 else
2659 begin
2660 anmtRemSearch.Visible := FALSE;
2661 imgReminder.Visible := TRUE;
2662 imgReminder.Picture.Bitmap.LoadFromResourceName(hInstance, ImgName);
2663 anmtRemSearch.Active := FALSE;
2664 end;
2665 mnuViewReminders.Enabled := (pnlReminders.tag = HAVE_REMINDERS);
2666end;
2667
2668procedure TfrmFrame.pnlRemindersMouseDown(Sender: TObject;
2669 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2670begin
2671 if(not InitialRemindersLoaded) then
2672 StartupReminders;
2673 if(pnlReminders.tag = HAVE_REMINDERS) then
2674 pnlReminders.BevelOuter := bvLowered;
2675end;
2676
2677procedure TfrmFrame.pnlRemindersMouseUp(Sender: TObject;
2678 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2679begin
2680 pnlReminders.BevelOuter := bvRaised;
2681 if(pnlReminders.tag = HAVE_REMINDERS) then
[460]2682 ViewInfo(mnuViewReminders);
[459]2683end;
2684
2685//--------------------- CIRN-related procedures --------------------------------
2686
2687procedure TfrmFrame.SetUpCIRN;
2688var
2689 i: integer;
[460]2690 aAutoQuery: string;
[459]2691 ASite: TRemoteSite;
2692begin
2693 with RemoteSites do
[460]2694 if UseVistaWeb then
[459]2695 begin
2696 ChangePatient(Patient.DFN);
[460]2697 lblCIRN.Caption := 'Remote'; //VistaWeb On
2698 lblCIRNData.Caption := 'Data*';
2699 pnlCIRN.Caption := 'Remote Data';
2700 lblCIRN.Width := 43;
2701 lblCIRNData.Width := 43;
2702 lblCIRNData.Alignment := taCenter;
2703 lblCIRN.Alignment := taCenter;
2704 lblCIRN.Enabled := True;
2705 lblCIRNData.Enabled := True;
2706 lblCIRNAvail.Enabled := True;
2707 pnlCIRN.TabStop := True;
[459]2708 if RemoteDataExists and (RemoteSites.Count > 0) then
2709 begin
2710 lblCIRN.Enabled := True;
2711 lblCIRNData.Enabled := True;
[460]2712 lblCIRNAvail.Enabled := True;
[459]2713 pnlCIRN.TabStop := True;
2714 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
2715 begin
2716 lblCIRN.Font.Color := clBlue;
2717 lblCIRNData.Font.Color := clBlue;
[460]2718 lblCIRNAvail.Font.Color := clBlue;
[459]2719 lstCIRNLocations.Font.Color := clBlue;
[460]2720 lblCIRN.Caption := 'Remote';
2721 lblCIRNData.Caption := 'Data*';
2722 lblCIRNAvail.Caption := 'Available';
2723 pnlCIRN.Caption := 'Remote Data Available';
[459]2724 end
2725 else
2726 begin
2727 lblCIRN.Font.Color := clWindowText;
2728 lblCIRNData.Font.Color := clWindowText;
[460]2729 lblCIRNAvail.Font.Color := clWindowText;
[459]2730 lstCIRNLocations.Font.Color := clWindowText;
2731 end;
[460]2732 end
2733 else
2734 begin
2735 lblCIRN.Font.Color := clWindowText;
2736 lblCIRNData.Font.Color := clWindowText;
2737 lblCIRNAvail.Font.Color := clWindowText;
2738 lblCIRN.Enabled := False;
2739 lblCIRNData.Enabled := False;
2740 lblCIRNAvail.Enabled := False;
2741 pnlCIRN.TabStop := False;
2742 pnlCIRN.Hint := NoDataReason;
2743 end;
2744 pnlCIRN.Hint := 'Click to open VistaWeb';
2745 end
2746 else
2747 begin
2748 ChangePatient(Patient.DFN);
2749 lblCIRN.Caption := ' Remote';
2750 lblCIRNData.Caption := 'Data';
2751 pnlCIRN.Caption := 'Remote Data';
2752 lblCIRNAvail.Caption := '';
2753 lblCIRN.Width := 43;
2754 lblCIRNData.Width := 43;
2755 lblCIRNData.Alignment := taCenter;
2756 lblCIRN.Alignment := taCenter;
2757 if RemoteDataExists and (RemoteSites.Count > 0) then
2758 begin
2759 lblCIRN.Enabled := True;
2760 lblCIRNData.Enabled := True;
2761 lblCIRNAvail.Enabled := True;
2762 pnlCIRN.TabStop := True;
2763 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
2764 begin
2765 lblCIRN.Font.Color := clBlue;
2766 lblCIRNData.Font.Color := clBlue;
2767 lblCIRNAvail.Font.Color := clBlue;
2768 lstCIRNLocations.Font.Color := clBlue;
2769 lblCIRN.Caption := 'Remote';
2770 lblCIRNData.Caption := 'Data';
2771 lblCIRNAvail.Caption := 'Available';
2772 pnlCIRN.Caption := 'Remote Data Available';
2773 end
2774 else
2775 begin
2776 lblCIRN.Font.Color := clWindowText;
2777 lblCIRNData.Font.Color := clWindowText;
2778 lblCIRNAvail.Font.Color := clWindowText;
2779 lstCIRNLocations.Font.Color := clWindowText;
2780 lblCIRNAvail.Color := clWindowText;
2781 end;
[459]2782 pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
[460]2783 lstCIRNLocations.Items.Add('-1' + U + 'Use VistaWeb from now on');
[459]2784 if RemoteSites.Count > 0 then
2785 lstCIRNLocations.Items.Add('0' + U + 'All Available Sites');
2786 for i := 0 to RemoteSites.Count - 1 do
2787 begin
2788 ASite := TRemoteSite(SiteList[i]);
2789 lstCIRNLocations.Items.Add(ASite.SiteID + U + ASite.SiteName + U +
2790 FormatFMDateTime('mmm dd yyyy hh:nn', ASite.LastDate));
2791 end;
2792 end
2793 else
2794 begin
2795 lblCIRN.Font.Color := clWindowText;
2796 lblCIRNData.Font.Color := clWindowText;
[460]2797 lblCIRNAvail.Font.Color := clWindowText;
[459]2798 lblCIRN.Enabled := False;
2799 lblCIRNData.Enabled := False;
[460]2800 lblCIRNAvail.Enabled := False;
[459]2801 pnlCIRN.TabStop := False;
2802 pnlCIRN.Hint := NoDataReason;
2803 end;
[460]2804 aAutoQuery := AutoRDV; //Check to see if Remote Queries should be used for all available sites
2805 if (aAutoQuery = '1') and (lstCIRNLocations.Count > 0) then
2806 begin
2807 lstCIRNLocations.ItemIndex := 1;
2808 lstCIRNLocations.Checked[1] := true;
2809 lstCIRNLocationsClick(self);
2810 end;
2811 end;
[459]2812end;
2813
2814procedure TfrmFrame.pnlCIRNClick(Sender: TObject);
[460]2815//var
2816// aAddress: string;
[459]2817begin
[460]2818 {if UseVistaWeb then
2819 begin
2820 pnlCIRN.BevelOuter := bvRaised;
2821 pnlCIRN.Hint := 'Click to open VistaWeb';
2822 lblCIRN.Width := 43;
2823 lblCIRNData.Width := 43;
2824 lblCIRNData.Alignment := taCenter;
2825 lblCIRN.Alignment := taCenter;
2826 lstCIRNLocations.Visible := false;
2827 lstCIRNLocations.SendToBack;
2828 aAddress := GetVistaWebAddress(Patient.DFN);
2829 ShellExecute(Handle, 'open', PChar(aAddress), PChar(''), '', SW_NORMAL);
2830 Exit;
2831 end;
[459]2832 if not RemoteSites.RemoteDataExists then Exit;
2833 if (not lstCIRNLocations.Visible) then
2834 begin
2835 pnlCIRN.BevelOuter := bvLowered;
2836 lstCIRNLocations.Visible := True;
2837 lstCIRNLocations.BringToFront;
2838 lstCIRNLocations.SetFocus;
2839 pnlCIRN.Hint := 'Click to close list.';
2840 end
2841 else
2842 begin
2843 pnlCIRN.BevelOuter := bvRaised;
2844 lstCIRNLocations.Visible := False;
2845 lstCIRNLocations.SendToBack;
2846 pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
[460]2847 end }
2848 ViewInfo(mnuViewRemoteData);
[459]2849end;
2850
2851procedure TfrmFrame.lstCIRNLocationsClick(Sender: TObject);
2852const
2853 DGSR_FAIL = -1;
2854 DGSR_NONE = 0;
2855 DGSR_SHOW = 1;
2856 DGSR_ASK = 2;
2857 DGSR_DENY = 3;
2858var
2859 iIndex,j,iAll,iCur: integer;
2860 aMsg,s: string;
2861 AccessStatus: integer;
2862begin
[460]2863 iAll := 1;
[459]2864 AccessStatus := 0;
[460]2865 iIndex := lstCIRNLocations.ItemIndex;
2866 if iIndex = 0 then
2867 if (piece(lstCIRNLocations.Items[0],'^',1) = '-1') and (lstCIRNLocations.Checked[iIndex] = true) then
2868 begin
2869 if MessageDlg('Are you sure you want to make VistaWeb your default for viewing Remote Data?',
2870 mtConfirmation, [mbYes, mbNo], 0) = mrYes then
2871 begin
2872 ChangeVistaWebParam('1');
2873 lblCIRN.Caption := 'Remote'; //VistaWeb On
2874 lblCIRNData.Caption := 'Data*';
2875 pnlCIRN.Caption := 'Remote Data';
2876 lblCIRNAvail.Caption := '';
2877 lblCIRN.Width := 43;
2878 lblCIRNData.Width := 43;
2879 lblCIRNData.Alignment := taCenter;
2880 lblCIRN.Alignment := taCenter;
2881 with RemoteSites do if RemoteDataExists and (RemoteSites.Count > 0) then
2882 begin
2883 lblCIRN.Enabled := True;
2884 lblCIRNData.Enabled := True;
2885 pnlCIRN.TabStop := True;
2886 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
2887 begin
2888 lblCIRN.Font.Color := clBlue;
2889 lblCIRNData.Font.Color := clBlue;
2890 lstCIRNLocations.Font.Color := clBlue;
2891 lblCIRN.Caption := 'Remote';
2892 lblCIRNData.Caption := 'Data*';
2893 lblCIRNAvail.Caption := 'Available';
2894 pnlCIRN.Caption := 'Remote Data Available';
2895 end
2896 else
2897 begin
2898 lblCIRN.Font.Color := clWindowText;
2899 lblCIRNData.Font.Color := clWindowText;
2900 lstCIRNLocations.Font.Color := clWindowText;
2901 lblCIRNAvail.Font.Color := clWindowText;
2902 end;
2903 end;
2904 pnlCIRNClick(self);
2905 Exit;
2906 end
2907 else
2908 lstCIRNLocations.Checked[iIndex] := false;
2909 end
2910 else
2911 begin
2912 ChangeVistaWebParam('0');
2913 lblCIRN.Caption := 'Remote';
2914 lblCIRNData.Caption := 'Data';
2915 pnlCIRN.Caption := 'Remote Data';
2916 lblCIRN.Width := 43;
2917 lblCIRNData.Width := 43;
2918 lblCIRNData.Alignment := taCenter;
2919 lblCIRN.Alignment := taCenter;
2920 pnlCIRNClick(self);
2921 Exit;
2922 end;
[459]2923 if not CheckHL7TCPLink then
2924 begin
2925 InfoBox('Local HL7 TCP Link is down.' + CRLF + 'Unable to retrieve remote data.', TC_DGSR_ERR, MB_OK);
[460]2926 lstCIRNLocations.Checked[iIndex] := false;
[459]2927 Exit;
2928 end;
[460]2929 if lstCIRNLocations.Items.Count > 1 then
2930 if piece(lstCIRNLocations.Items[1],'^',1) = '0' then
2931 iAll := 2;
[459]2932 with frmReports do
2933 if piece(uRemoteType,'^',2) = 'V' then
2934 begin
2935 lvReports.Items.BeginUpdate;
2936 lvReports.Items.Clear;
2937 lvReports.Columns.Clear;
2938 lvReports.Items.EndUpdate;
2939 end;
2940 uReportInstruction := '';
2941 frmReports.TabControl1.Tabs.Clear;
2942 frmLabs.TabControl1.Tabs.Clear;
2943 frmReports.TabControl1.Tabs.AddObject('Local',nil);
2944 frmLabs.TabControl1.Tabs.AddObject('Local',nil);
2945 StatusText('Checking Remote Sites...');
2946 if piece(lstCIRNLocations.Items[iIndex],'^',1) = '0' then // All sites have been clicked
2947 if lstCIRNLocations.Checked[iIndex] = false then // All selection is being turned off
2948 begin
2949 with RemoteSites.SiteList do
2950 for j := 0 to Count - 1 do
[460]2951 if lstCIRNLocations.Checked[j+2] = true then
[459]2952 begin
[460]2953 lstCIRNLocations.Checked[j+2] := false;
[459]2954 TRemoteSite(RemoteSites.SiteList[j]).Selected := false;
2955 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2956 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2957 end;
2958 end
2959 else
2960 begin
2961 with RemoteSites.SiteList do
2962 for j := 0 to Count - 1 do
2963 begin
2964 Screen.Cursor := crHourGlass;
2965 {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[j]).SiteID,
2966 AccessStatus);}
2967 Screen.Cursor := crDefault;
2968 aMsg := aMsg + ' at site: ' + TRemoteSite(Items[j]).SiteName;
[460]2969 s := lstCIRNLocations.Items[j+2];
2970 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3);
[459]2971 case AccessStatus of
2972 DGSR_FAIL: begin
2973 if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
2974 begin
[460]2975 lstCIRNLocations.Checked[j+2] := true;
[459]2976 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2977 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2978 TRemoteSite(Items[j]).Selected := true;
2979 end
2980 else
2981 begin
2982 InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
[460]2983 lstCIRNLocations.Checked[j+2] := false;
2984 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
[459]2985 TRemoteSite(Items[j]).Selected := false;
2986 Continue;
2987 end;
2988 end;
2989 DGSR_NONE: begin
[460]2990 lstCIRNLocations.Checked[j+2] := true;
[459]2991 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2992 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2993 TRemoteSite(Items[j]).Selected := true;
2994 end;
2995 DGSR_SHOW: begin
2996 InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
[460]2997 lstCIRNLocations.Checked[j+2] := true;
[459]2998 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2999 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3000 TRemoteSite(Items[j]).Selected := true;
3001 end;
3002 DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
3003 MB_DEFBUTTON2) = IDYES then
3004 begin
[460]3005 lstCIRNLocations.Checked[j+2] := true;
[459]3006 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3007 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3008 TRemoteSite(Items[j]).Selected := true;
3009 end
3010 else
3011 begin
[460]3012 lstCIRNLocations.Checked[j+2] := false;
3013 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
[459]3014 TRemoteSite(Items[j]).Selected := false;
3015 Continue;
3016 end;
3017 else begin
3018 InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
[460]3019 lstCIRNLocations.Checked[j+2] := false;
3020 lstCIRNLocations.Items[j+2] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
[459]3021 TRemoteSite(Items[j]).Selected := false;
3022 Continue;
3023 end;
3024 end;
3025 end;
3026 end
3027 else
3028 begin
[460]3029 if iIndex > 0 then
[459]3030 begin
3031 iCur := iIndex - iAll;
3032 TRemoteSite(RemoteSites.SiteList[iCur]).Selected :=
3033 lstCIRNLocations.Checked[iIndex];
3034 if lstCIRNLocations.Checked[iIndex] = true then
3035 with RemoteSites.SiteList do
3036 begin
3037 Screen.Cursor := crHourGlass;
3038 {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[iCur]).SiteID,
3039 AccessStatus);}
3040 Screen.Cursor := crDefault;
3041 aMsg := aMsg + ' at site: ' + TRemoteSite(Items[iCur]).SiteName;
3042 s := lstCIRNLocations.Items[iIndex];
3043 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3);
3044 case AccessStatus of
3045 DGSR_FAIL: begin
3046 if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
3047 begin
3048 lstCIRNLocations.Checked[iIndex] := true;
3049 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3050 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3051 TRemoteSite(Items[iCur]).Selected := true;
3052 end
3053 else
3054 begin
3055 InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
3056 lstCIRNLocations.Checked[iIndex] := false;
3057 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
3058 TRemoteSite(Items[iCur]).Selected := false;
3059 end;
3060 end;
3061 DGSR_NONE: begin
3062 lstCIRNLocations.Checked[iIndex] := true;
3063 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3064 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3065 TRemoteSite(Items[iCur]).Selected := true;
3066 end;
3067 DGSR_SHOW: begin
3068 InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
3069 lstCIRNLocations.Checked[iIndex] := true;
3070 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3071 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3072 TRemoteSite(Items[iCur]).Selected := true;
3073 end;
3074 DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
3075 MB_DEFBUTTON2) = IDYES then
3076 begin
3077 lstCIRNLocations.Checked[iIndex] := true;
3078 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3079 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3080 TRemoteSite(Items[iCur]).Selected := true;
3081 end
3082 else
3083 begin
3084 lstCIRNLocations.Checked[iIndex] := false;
3085 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
3086 end;
3087 else begin
3088 InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
3089 lstCIRNLocations.Checked[iIndex] := false;
3090 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
3091 TRemoteSite(Items[iCur]).Selected := false;
3092 end;
3093 end;
3094 with frmReports do
3095 if piece(uRemoteType,'^',1) = '1' then
3096 if not(piece(uRemoteType,'^',2) = 'V') then
3097 begin
3098 TabControl1.Visible := true;
3099 pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3100 end;
3101 with frmLabs do
3102 if lstReports.ItemIndex > -1 then
3103 if piece(lstReports.Items[lstReports.ItemIndex],'^',3) = '1' then
3104 if not(piece(lstReports.Items[lstReports.ItemIndex],'^',5) = 'V') then
3105 TabControl1.Visible := true;
3106 end;
3107 end;
3108 end;
3109 with RemoteSites.SiteList do
3110 for j := 0 to Count - 1 do
3111 if TRemoteSite(Items[j]).Selected then
3112 begin
3113 frmReports.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3114 TRemoteSite(Items[j]));
3115 frmLabs.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3116 TRemoteSite(Items[j]));
3117 end;
[460]3118 //frmLabs.TabControl1.OnChange(nil);
3119 //frmReports.TabControl1.OnChange(nil);
3120 if frmReports.tvReports.SelectionCount > 0 then frmReports.tvReportsClick(self);
3121 if frmLabs.lstReports.ItemIndex > -1 then frmLabs.ExtlstReportsClick(self, true);
[459]3122 StatusText('');
3123end;
3124
3125procedure TfrmFrame.popCIRNCloseClick(Sender: TObject);
3126begin
3127 lstCIRNLocations.Visible := False;
3128 lstCirnLocations.SendToBack;
3129 pnlCIRN.BevelOuter := bvRaised;
3130end;
3131
3132procedure TfrmFrame.popCIRNSelectAllClick(Sender: TObject);
3133
3134begin
3135 lstCIRNLocations.ItemIndex := 0;
3136 lstCIRNLocations.Checked[0] := true;
3137 lstCIRNLocations.OnClick(Self);
3138end;
3139
3140procedure TfrmFrame.popCIRNSelectNoneClick(Sender: TObject);
3141
3142begin
3143 lstCIRNLocations.ItemIndex := 0;
3144 lstCIRNLocations.Checked[0] := false;
3145 lstCIRNLocations.OnClick(Self);
3146end;
3147
3148procedure TfrmFrame.mnuFilePrintSetupClick(Sender: TObject);
3149var
3150 CurrPrt: string;
3151begin
3152 CurrPrt := SelectDevice(Self, Encounter.Location, True,'');
3153 User.CurrentPrinter := Piece(CurrPrt, U, 1);
3154end;
3155
3156procedure TfrmFrame.lstCIRNLocationsChange(Sender: TObject);
3157begin
[460]3158 if lstCIRNLocations.ItemIndex > 0 then
[459]3159 if (lstCIRNLocations.Selected[lstCIRNLocations.ItemIndex] = true) and (uUpdateStat = false) then
[460]3160 if not (piece(lstCIRNLocations.Items[1],'^',1) = '0') then
[459]3161 lstCIRNLocations.OnClick(nil);
3162end;
3163
3164procedure TfrmFrame.LabInfo1Click(Sender: TObject);
3165begin
3166 ExecuteLabInfo;
3167end;
3168
3169procedure TfrmFrame.mnuFileNotifRemoveClick(Sender: TObject);
3170const
3171 TC_REMOVE_ALERT = 'Remove Current Alert';
3172 TX_REMOVE_ALERT1 = 'This action will delete the alert you are currently processing; the alert will ' + CRLF +
3173 'disappear automatically when all orders have been acted on, but this action may' + CRLF +
3174 'be used to remove the alert if some orders are to be left unchanged.' + CRLF + CRLF +
3175 'Your ';
3176 TX_REMOVE_ALERT2 = ' alert for ';
3177 TX_REMOVE_ALERT3 = ' will be deleted!' + CRLF + CRLF + 'Are you sure?';
3178var
3179 AlertMsg, AlertType: string;
3180
3181 procedure StopProcessingNotifs;
3182 begin
3183 Notifications.Clear;
3184 FNextButtonActive := False;
3185 stsArea.Panels[2].Bevel := pbLowered;
3186 mnuFileNext.Enabled := False;
3187 mnuFileNotifRemove.Enabled := False;
3188 end;
3189
3190begin
3191 if not Notifications.Active then Exit;
3192 case Notifications.Followup of
[460]3193 NF_MEDICATIONS_EXPIRING_INPT : AlertType := 'Expiring Medications';
3194 NF_MEDICATIONS_EXPIRING_OUTPT : AlertType := 'Expiring Medications';
[459]3195 NF_ORDER_REQUIRES_ELEC_SIGNATURE: AlertType := 'Unsigned Orders';
3196 NF_FLAGGED_ORDERS : AlertType := 'Flagged Orders (for clarification)';
3197 NF_UNVERIFIED_MEDICATION_ORDER : AlertType := 'Unverified Medication Order';
3198 NF_UNVERIFIED_ORDER : AlertType := 'Unverified Order';
3199 NF_FLAGGED_OI_EXP_INPT : AlertType := 'Flagged Orderable Item (INPT)';
3200 NF_FLAGGED_OI_EXP_OUTPT : AlertType := 'Flagged Orderable Item (OUTPT)';
3201 else
3202 Exit;
3203 end;
3204 AlertMsg := TX_REMOVE_ALERT1 + AlertType + TX_REMOVE_ALERT2 + Patient.Name + TX_REMOVE_ALERT3;
3205 if InfoBox(AlertMsg, TC_REMOVE_ALERT, MB_YESNO) = ID_YES then
3206 begin
3207 Notifications.DeleteForCurrentUser;
3208 Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
3209 if Notifications.Active then
3210 begin
3211 if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
3212 begin
3213 Notifications.Prior;
3214 mnuFileNextClick(Self);
3215 end
3216 else
3217 StopProcessingNotifs;
3218 end
3219 else
3220 StopProcessingNotifs;
3221 end;
3222end;
3223
3224procedure TfrmFrame.mnuToolsOptionsClick(Sender: TObject);
3225// personal preferences - changes may need to be applied to chart
3226var
3227 i: integer;
3228begin
3229 i := 0;
3230 DialogOptions(i);
3231end;
3232
3233procedure TfrmFrame.LoadUserPreferences;
3234begin
3235 LoadSizesForUser;
3236// LoadUserVitalPreferences;
3237 GetUserTemplateDefaults(TRUE);
3238end;
3239
3240procedure TfrmFrame.SaveUserPreferences;
3241begin
3242 SaveSizesForUser; // position & size settings
3243// SaveUserVitalPreferences; // save Vitals metric setting
3244 SaveUserTemplateDefaults;
3245end;
3246
3247procedure TfrmFrame.mnuFileRefreshClick(Sender: TObject);
3248begin
3249 FRefreshing := TRUE;
3250 try
3251 mnuFileOpenClick(Self);
3252 finally
3253 FRefreshing := FALSE;
3254 end;
3255end;
3256
3257procedure TfrmFrame.AppActivated(Sender: TObject);
3258begin
3259 if assigned(FOldActivate) then
3260 FOldActivate(Sender);
3261 SetActiveWindow(Application.Handle);
3262end;
3263
3264// close Treatment Factor hint window if alt-tab pressed.
3265procedure TfrmFrame.AppDeActivated(Sender: TObject);
3266begin
3267 if FRVTFhintWindowActive then
3268 begin
3269 FRVTFHintWindow.ReleaseHandle;
3270 FRVTFHintWindowActive := False;
3271 end
3272 else
3273 if FOSTFHintWndActive then
3274 begin
3275 FOSTFhintWindow.ReleaseHandle;
3276 FOSTFHintWndActive := False ;
3277 end;
[460]3278 if FHintWinActive then // graphing - hints on values
3279 begin
3280 FHintWin.ReleaseHandle;
3281 FHintWinActive := false;
3282 end;
[459]3283end;
3284
3285(*procedure TfrmFrame.CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
3286begin
3287 AnInstance := TPage.Create(Self);
3288 TPage(AnInstance).Parent := pnlPage;
3289 TPage(AnInstance).Show;
3290 uTabList.Add(IntToStr(ATabID));
3291 tabPage.Tabs.Add(ALabel);
3292end;*)
3293
3294procedure TfrmFrame.CreateTab(ATabID: integer; ALabel: string);
3295begin
3296 // old comment - try making owner self (instead of application) to see if solves TMenuItem.Insert bug
3297 case ATabID of
3298 CT_PROBLEMS : begin
3299 frmProblems := TfrmProblems.Create(Self);
3300 frmProblems.Parent := pnlPage;
3301 end;
3302 CT_MEDS : begin
3303 frmMeds := TfrmMeds.Create(Self);
3304 frmMeds.Parent := pnlPage;
3305 frmMeds.InitfMedsSize;
3306 end;
3307 CT_ORDERS : begin
3308 frmOrders := TfrmOrders.Create(Self);
3309 frmOrders.Parent := pnlPage;
3310 end;
3311 CT_HP : begin
3312 // not yet
3313 end;
3314 CT_NOTES : begin
3315 frmNotes := TfrmNotes.Create(Self);
3316 frmNotes.Parent := pnlPage;
3317 end;
3318 CT_CONSULTS : begin
3319 frmConsults := TfrmConsults.Create(Self);
3320 frmConsults.Parent := pnlPage;
3321 end;
3322 CT_DCSUMM : begin
3323 frmDCSumm := TfrmDCSumm.Create(Self);
3324 frmDCSumm.Parent := pnlPage;
3325 end;
3326 CT_LABS : begin
3327 frmLabs := TfrmLabs.Create(Self);
3328 frmLabs.Parent := pnlPage;
3329 end;
3330 CT_REPORTS : begin
3331 frmReports := TfrmReports.Create(Self);
3332 frmReports.Parent := pnlPage;
3333 end;
3334 CT_SURGERY : begin
3335 frmSurgery := TfrmSurgery.Create(Self);
3336 frmSurgery.Parent := pnlPage;
3337 end;
3338 CT_COVER : begin
3339 frmCover := TfrmCover.Create(Self);
3340 frmCover.Parent := pnlPage;
3341 end;
3342 else
3343 Exit;
3344 end;
3345 if ATabID = CT_COVER then
3346 begin
3347 uTabList.Insert(0, IntToStr(ATabID));
3348 tabPage.Tabs.Insert(0, ALabel);
3349 tabPage.TabIndex := 0;
3350 end
3351 else
3352 begin
3353 uTabList.Add(IntToStr(ATabID));
3354 tabPage.Tabs.Add(ALabel);
3355 end;
3356end;
3357
3358procedure TfrmFrame.ShowHideChartTabMenus(AMenuItem: TMenuItem);
3359var
3360 i: integer;
3361begin
3362 for i := 0 to AMenuItem.Count - 1 do
3363 AMenuItem.Items[i].Visible := TabExists(AMenuItem.Items[i].Tag);
3364end;
3365
3366function TfrmFrame.TabExists(ATabID: integer): boolean;
3367begin
3368 Result := (uTabList.IndexOf(IntToStr(ATabID)) > -1)
3369end;
3370
3371procedure TfrmFrame.ReportsOnlyDisplay;
3372begin
3373
3374// Configure "Edit" menu:
3375menuHideAllBut(mnuEdit, mnuEditPref); // Hide everything under Edit menu except Preferences.
3376menuHideAllBut(mnuEditPref, Prefs1); // Hide everything under Preferences menu except Fonts.
3377
3378// Remaining pull-down menus:
3379mnuView.visible := false;
3380mnuFileRefresh.visible := false;
3381mnuFileEncounter.visible := false;
3382mnuFileReview.visible := false;
3383mnuFileNext.visible := false;
3384mnuFileNotifRemove.visible := false;
3385mnuHelpBroker.visible := false;
3386mnuHelpLists.visible := false;
3387mnuHelpSymbols.visible := false;
3388
3389// Top panel components:
3390//pnlVisit.visible := false;
3391pnlVisit.hint := 'Provider/Location';
3392pnlVisit.onMouseDown := nil;
3393pnlVisit.onMouseUp := nil;
3394//pnlPrimaryCare.visible := false;
3395//pnlPostings.visible := false;
3396//lblPtCWAD.visible := false;
3397//lblPtPostings.visible := false;
3398//pnlReminders.visible := false;
3399//anmtRemSearch.visible := false;
3400
3401// Forms for other tabs:
3402frmCover.visible := false;
3403frmProblems.visible := false;
3404frmMeds.visible := false;
3405frmOrders.visible := false;
3406frmNotes.visible := false;
3407frmConsults.visible := false;
3408frmDCSumm.visible := false;
3409if Assigned(frmSurgery) then
3410 frmSurgery.visible := false;
3411frmLabs.visible := false;
3412
3413// Other tabs (so to speak):
3414tabPage.tabs.clear;
3415tabPage.tabs.add('Reports');
3416
3417end;
3418
3419procedure TfrmFrame.UpdatePtInfoOnRefresh;
3420var
3421 tmpDFN: string;
3422begin
3423 tmpDFN := Patient.DFN;
3424 Patient.Clear;
3425 Patient.DFN := tmpDFN;
[460]3426 uCore.TempEncounterLoc := 0; //hds7591 Clinic/Ward movement.
3427 uCore.TempEncounterLocName := ''; //hds7591 Clinic/Ward movement.
[459]3428
3429 if (FPrevInPatient and Patient.Inpatient) then //transfering inside hospital
3430 Encounter.Location := Patient.Location
3431 else if (FPrevInPatient and (not Patient.Inpatient)) then //patient was discharged
3432 begin
3433 Encounter.Inpatient := False;
3434 Encounter.Location := 0;
3435 FPrevInPatient := False;
3436 end
3437 else if ((not FPrevInPatient) and Patient.Inpatient) then //patient was admitted
3438 begin
3439 Encounter.Inpatient := True;
[460]3440 uCore.TempEncounterLoc := Encounter.Location; //hds7591 Clinic/Ward movement.
3441 uCore.TempEncounterLocName := Encounter.LocationName; //hds7591 Clinic/Ward movement.
[459]3442 Encounter.Location := Patient.Location;
3443 Encounter.DateTime := Patient.AdmitTime;
3444 Encounter.VisitCategory := 'H';
3445 FPrevInPatient := True;
3446 end;
3447 //if User.IsProvider then Encounter.Provider := ;
3448 DisplayEncounterText;
3449end;
3450
[460]3451procedure TfrmFrame.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
[459]3452var
3453 NewTabIndex: integer;
3454begin
3455 //CQ2844: Toggle Remote Data button using Alt+R
3456 case Key of
[460]3457 82,114: if (ssAlt in Shift) then
[459]3458 frmFrame.pnlCIRNClick(Sender);
3459 end;
3460
3461 if (Key = VK_TAB) then begin
3462 if (ssCtrl in Shift) then begin
3463 if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
3464 NewTabIndex := tabPage.TabIndex;
3465 if ssShift in Shift then
3466 dec(NewTabIndex)
3467 else
3468 inc(NewTabIndex);
3469 if NewTabIndex >= tabPage.Tabs.Count then
3470 dec(NewTabIndex,tabPage.Tabs.Count)
3471 else if NewTabIndex < 0 then
3472 inc(NewTabIndex,tabPage.Tabs.Count);
3473 tabPage.TabIndex := NewTabIndex;
3474 tabPageChange(tabPage);
3475 Key := 0;
3476 end;
3477 end;
3478 end;
3479end;
3480
3481procedure TfrmFrame.FormActivate(Sender: TObject);
3482begin
3483 if Assigned(FLastPage) then
3484 FLastPage.FocusFirstControl;
3485end;
3486
3487procedure TfrmFrame.pnlPrimaryCareEnter(Sender: TObject);
3488begin
3489 with Sender as TPanel do
3490 if (ControlCount > 0) and (Controls[0] is TSpeedButton) and (TSpeedButton(Controls[0]).Down)
3491 then
3492 BevelInner := bvLowered
3493 else
3494 BevelInner := bvRaised;
3495end;
3496
3497procedure TfrmFrame.pnlPrimaryCareExit(Sender: TObject);
3498var
3499 ShiftIsDown,TabIsDown : boolean;
3500begin
3501 with Sender as TPanel do begin
3502 BevelInner := bvNone;
3503 //Make the lstCIRNLocations act as if between pnlCIRN & pnlReminders
3504 //in the Tab Order
3505 if (lstCIRNLocations.CanFocus) then
3506 begin
3507 ShiftIsDown := Boolean(Hi(GetKeyState(VK_SHIFT)));
3508 TabIsDown := Boolean(Hi(GetKeyState(VK_TAB)));
3509 if TabIsDown then
3510 if (ShiftIsDown) and (Name = 'pnlReminders') then
3511 lstCIRNLocations.SetFocus
3512 else if Not (ShiftIsDown) and (Name = 'pnlCIRN') then
3513 lstCIRNLocations.SetFocus;
3514 end;
3515 end;
3516end;
3517
3518procedure TfrmFrame.pnlPatientClick(Sender: TObject);
3519begin
[460]3520 ViewInfo(mnuViewDemo);
[459]3521end;
3522
3523procedure TfrmFrame.pnlVisitClick(Sender: TObject);
3524begin
[460]3525 //if (not User.IsReportsOnly) then // Reports Only tab.
3526 // mnuFileEncounterClick(Self);
3527 ViewInfo(mnuViewVisits);
[459]3528end;
3529
3530procedure TfrmFrame.pnlPrimaryCareClick(Sender: TObject);
3531begin
[460]3532 //ReportBox(DetailPrimaryCare(Patient.DFN), 'Primary Care', True);
3533 ViewInfo(mnuViewPrimaryCare);
[459]3534end;
3535
3536procedure TfrmFrame.pnlRemindersClick(Sender: TObject);
3537begin
3538 if(pnlReminders.tag = HAVE_REMINDERS) then
[460]3539 ViewInfo(mnuViewReminders);
3540
[459]3541end;
3542
3543procedure TfrmFrame.pnlPostingsClick(Sender: TObject);
3544begin
[460]3545 ViewInfo(mnuViewPostings);
[459]3546end;
3547
3548//=========================== CCOW main changes ========================
3549
3550procedure TfrmFrame.HandleCCOWError(AMessage: string);
3551begin
3552 {$ifdef DEBUG}
3553 ShowMessage(AMessage);
3554 {$endif}
3555 InfoBox(TX_CCOW_ERROR, TC_CCOW_ERROR, MB_ICONERROR or MB_OK);
3556 FCCOWInstalled := False;
3557 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_BROKEN');
3558 pnlCCOW.Hint := TX_CCOW_BROKEN;
3559 mnuFileResumeContext.Visible := True;
3560 mnuFileResumeContext.Enabled := False;
3561 mnuFileBreakContext.Visible := True;
3562 mnuFileBreakContext.Enabled := False;
3563 FCCOWError := True;
3564end;
3565
[460]3566function TfrmFrame.AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean;
[459]3567var
3568 PtData : IContextItemCollection;
3569 PtDataItem2, PtDataItem3, PtDataItem4 : IContextItem;
3570 response : UserResponse;
3571 StationNumber: string;
3572 IsProdAcct: boolean;
3573begin
3574 Result := False;
3575 response := 0;
3576 try
3577 // Start a context change transaction
3578 if FCCOWInstalled then
3579 begin
3580 FCCOWError := False;
3581 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
3582 pnlCCOW.Hint := TX_CCOW_CHANGING;
3583 try
3584 ctxContextor.StartContextChange();
3585 except
3586 on E: Exception do HandleCCOWError(E.Message);
3587 end;
3588 if FCCOWError then
3589 begin
3590 Result := False;
3591 Exit;
3592 end;
3593 // Set the new proposed context data.
3594 PtData := CoContextItemCollection.Create();
3595 StationNumber := User.StationNumber;
3596 IsProdAcct := User.IsProductionAccount;
3597
[460]3598 {$IFDEF CCOWBROKER}
3599 //IsProdAcct := RPCBrokerV.Login.IsProduction; //not yet
3600 {$ENDIF}
3601
[459]3602 PtDataItem2 := CoContextItem.Create();
3603 PtDataItem2.Set_Name('Patient.co.PatientName'); // Patient.Name
3604 PtDataItem2.Set_Value(Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^');
3605 PtData.Add(PtDataItem2);
3606
3607 PtDataItem3 := CoContextItem.Create();
3608 if not IsProdAcct then
3609 PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber + '_TEST') // Patient.DFN
3610 else
3611 PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber); // Patient.DFN
3612 PtDataItem3.Set_Value(Patient.DFN);
3613 PtData.Add(PtDataItem3);
3614
3615 if Patient.ICN <> '' then
3616 begin
3617 PtDataItem4 := CoContextItem.Create();
3618 if not IsProdAcct then
3619 PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber_TEST') // Patient.ICN
3620 else
3621 PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber'); // Patient.ICN
3622 PtDataItem4.Set_Value(Patient.ICN);
3623 PtData.Add(PtDataItem4);
3624 end;
3625
3626 // End the context change transaction.
3627 FCCOWError := False;
3628 try
3629 response := ctxContextor.EndContextChange(true, PtData);
3630 except
3631 on E: Exception do HandleCCOWError(E.Message);
3632 end;
3633 if FCCOWError then
3634 begin
3635 HideEverything;
3636 Result := False;
3637 Exit;
3638 end;
3639 end
3640 else
3641 //response := urBreak;
3642 begin
3643 Result := True;
3644 Exit;
3645 end;
3646
[460]3647 CCOWResponse := response;
[459]3648 if (response = UrCommit) then
3649 begin
3650 // New context is committed.
3651 //ShowMessage('Response was Commit');
3652 mnuFileResumeContext.Enabled := False;
3653 mnuFileBreakContext.Enabled := True;
3654 FCCOWIconName := 'BMP_CCOW_LINKED';
3655 pnlCCOW.Hint := TX_CCOW_LINKED;
3656 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3657 Result := True;
3658 end
3659 else if (response = UrCancel) then
3660 begin
3661 // Proposed context change is canceled. Return to the current context.
3662 PtData.RemoveAll;
3663 mnuFileResumeContext.Enabled := False;
3664 mnuFileBreakContext.Enabled := True;
3665 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3666 Result := False;
3667 end
3668 else if (response = UrBreak) then
3669 begin
3670 // The contextor has broken the link by suspending. This app should
3671 // update the Clinical Link icon, enable the Resume menu item, and
3672 // disable the Suspend menu item.
3673 PtData.RemoveAll;
3674 mnuFileResumeContext.Enabled := True;
3675 mnuFileBreakContext.Enabled := False;
3676 FCCOWIconName := 'BMP_CCOW_BROKEN';
3677 pnlCCOW.Hint := TX_CCOW_BROKEN;
3678 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3679 if Patient.Inpatient then
3680 begin
3681 Encounter.Inpatient := True;
3682 Encounter.Location := Patient.Location;
3683 Encounter.DateTime := Patient.AdmitTime;
3684 Encounter.VisitCategory := 'H';
3685 end;
3686 if User.IsProvider then Encounter.Provider := User.DUZ;
3687 SetupPatient;
3688 tabPage.TabIndex := PageIDToTab(User.InitialTab);
3689 tabPageChange(tabPage);
3690 Result := False;
3691 end;
3692 except
3693 on exc : EOleException do
3694 //ShowMessage('EOleException: ' + exc.Message + ' - ' + string(exc.ErrorCode) );
3695 ShowMessage('EOleException: ' + exc.Message);
3696 end;
3697end;
3698
3699procedure TfrmFrame.ctxContextorCanceled(Sender: TObject);
3700begin
3701 // Application should maintain its state as the current (existing) context.
3702 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3703end;
3704
3705procedure TfrmFrame.ctxContextorPending(Sender: TObject;
3706 const aContextItemCollection: IDispatch);
3707var
3708 Reason, HyperLinkReason: string;
3709 PtChanged: boolean;
[460]3710{$IFDEF CCOWBROKER}
3711 UserChanged: boolean;
3712{$ENDIF}
[459]3713begin
3714 // If the app would lose data, or have other problems changing context at
3715 // this time, it should return a message using SetSurveyReponse. Note that the
3716 // user may decide to commit the context change anyway.
3717 //
3718 // if (cannot-change-context-without-a-problem) then
3719 // contextor.SetSurveyResponse('Conditional accept reason...');
3720 if FCCOWBusy then
3721 begin
3722 Sleep(10000);
3723 end;
3724
3725 FCCOWError := False;
3726 try
3727 CheckForDifferentPatient(aContextItemCollection, PtChanged);
[460]3728{$IFDEF CCOWBROKER}
3729 CheckForDifferentUser(aContextItemCollection, UserChanged);
3730{$ENDIF}
[459]3731 except
3732 on E: Exception do HandleCCOWError(E.Message);
3733 end;
3734 if FCCOWError then
3735 begin
3736 HideEverything;
3737 Exit;
3738 end;
3739
[460]3740{$IFDEF CCOWBROKER}
3741 if PtChanged or UserChanged then
3742{$ELSE}
[459]3743 if PtChanged then
[460]3744{$ENDIF}
[459]3745 begin
3746 FCCOWContextChanging := True;
3747 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
3748 pnlCCOW.Hint := TX_CCOW_CHANGING;
3749 AllowContextChangeAll(Reason);
3750 end;
3751 CheckHyperlinkResponse(aContextItemCollection, HyperlinkReason);
3752 Reason := HyperlinkReason + Reason;
3753 if Pos('COM_OBJECT_ACTIVE', Reason) > 0 then
3754 Sleep(12000)
3755 else if Length(Reason) > 0 then
3756 ctxContextor.SetSurveyResponse(Reason);
3757 FCCOWContextChanging := False;
3758end;
3759
3760procedure TfrmFrame.ctxContextorCommitted(Sender: TObject);
3761var
3762 Reason: string;
3763 PtChanged: boolean;
3764 i: integer;
3765begin
3766 // Application should now access the new context and update its state.
3767 FCCOWError := False;
3768 try
[460]3769 {$IFDEF CCOWBROKER}
3770 with RPCBrokerV do if (WasUserDefined and IsUserCleared and (ctxContextor.CurrentContext.Present(CCOW_USER_NAME) = nil)) then // RV 05/11/04
3771 begin
3772 Reason := 'COMMIT';
3773 if AllowContextChangeAll(Reason) then
3774 begin
3775 Close;
3776 Exit;
3777 end;
3778 end;
3779 {$ENDIF}
3780 CheckForDifferentPatient(ctxContextor.CurrentContext, PtChanged);
[459]3781 except
3782 on E: Exception do HandleCCOWError(E.Message);
3783 end;
3784 if FCCOWError then
3785 begin
3786 HideEverything;
3787 Exit;
3788 end;
3789 if not PtChanged then exit;
3790 FCCOWDrivedChange := True;
3791 i := 0;
3792 while Length(Screen.Forms[i].Name) > 0 do
3793 begin
3794 if fsModal in Screen.Forms[i].FormState then
3795 begin
3796 Screen.Forms[i].ModalResult := mrCancel;
3797 i := i + 1;
3798 end else // the fsModal forms always sequenced prior to the none-fsModal forms
3799 Break;
3800 end;
3801 Reason := 'COMMIT';
3802 if AllowContextChangeAll(Reason) then UpdateCCOWContext;
3803 FCCOWIconName := 'BMP_CCOW_LINKED';
3804 pnlCCOW.Hint := TX_CCOW_LINKED;
3805 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3806end;
3807
3808//function TfrmFrame.FindBestCCOWDFN(var APatientName: string): string;
3809function TfrmFrame.FindBestCCOWDFN: string;
3810var
3811 data: IContextItemCollection;
3812 anItem: IContextItem;
3813 StationNumber, tempDFN: string;
3814 IsProdAcct: Boolean;
3815
3816 procedure FindNextBestDFN;
3817 begin
3818 StationNumber := User.StationNumber;
3819 if IsProdAcct then
3820 anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber)
3821 else
3822 anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber + '_TEST');
3823 if anItem <> nil then tempDFN := anItem.Get_Value();
3824 end;
3825
3826begin
3827 if uCore.User = nil then
3828 begin
3829 Result := '';
3830 exit;
3831 end;
3832 IsProdAcct := User.IsProductionAccount;
[460]3833 {$IFDEF CCOWBROKER}
3834 //IsProdAcct := RPCBrokerV.Login.IsProduction; //not yet
3835 {$ENDIF}
[459]3836 // Get an item collection of the current context
3837 FCCOWError := False;
3838 try
3839 data := ctxContextor.CurrentContext;
3840 except
3841 on E: Exception do HandleCCOWError(E.Message);
3842 end;
3843 if FCCOWError then
3844 begin
3845 HideEverything;
3846 Exit;
3847 end;
3848 // Retrieve the ContextItem name and value as strings
3849 if IsProdAcct then
3850 anItem := data.Present('Patient.id.MRN.NationalIDNumber')
3851 else
3852 anItem := data.Present('Patient.id.MRN.NationalIDNumber_TEST');
3853 if anItem <> nil then
3854 begin
3855 tempDFN := GetDFNFromICN(anItem.Get_Value()); // "Public" RPC call
3856 if tempDFN = '-1' then FindNextBestDFN;
3857 end
3858 else
3859 FindNextBestDFN;
3860 Result := tempDFN;
3861(* anItem := data.Present('Patient.co.PatientName');
3862 if anItem <> nil then APatientName := anItem.Get_Value();*)
3863 data := nil;
3864 anItem := nil;
3865end;
3866
3867procedure TfrmFrame.UpdateCCOWContext;
3868var
3869 PtDFN(*, PtName*): string;
3870begin
3871 if not FCCOWInstalled then exit;
3872 //PtDFN := FindBestCCOWDFN(PtName);
3873 PtDFN := FindBestCCOWDFN;
[460]3874 if StrToInt64Def(PtDFN, 0) > 0 then
[459]3875 begin
3876 // Select new patient based on context value
3877 if Patient.DFN = PtDFN then exit;
3878 Patient.DFN := PtDFN;
3879 //if (Patient.Name = '-1') or (PtName <> Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^') then
3880 if (Patient.Name = '-1') then
3881 begin
3882 HideEverything;
3883 exit;
3884 end
3885 else
3886 ShowEverything;
3887 Encounter.Clear;
3888 if Patient.Inpatient then
3889 begin
3890 Encounter.Inpatient := True;
3891 Encounter.Location := Patient.Location;
3892 Encounter.DateTime := Patient.AdmitTime;
3893 Encounter.VisitCategory := 'H';
3894 end;
3895 if User.IsProvider then Encounter.Provider := User.DUZ;
[460]3896 if not FFirstLoad then SetupPatient;
3897 frmCover.UpdateVAAButton; //VAA
[459]3898 DetermineNextTab;
3899 tabPage.TabIndex := PageIDToTab(NextTab);
3900 tabPageChange(tabPage);
3901 end
3902 else
3903 HideEverything;
3904end;
3905
3906procedure TfrmFrame.mnuFileBreakContextClick(Sender: TObject);
3907begin
3908 FCCOWError := False;
3909 FCCOWIconName := 'BMP_CCOW_CHANGING';
3910 pnlCCOW.Hint := TX_CCOW_CHANGING;
3911 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3912 try
3913 ctxContextor.Suspend;
3914 except
3915 on E: Exception do HandleCCOWError(E.Message);
3916 end;
3917 if FCCOWError then exit;
3918 FCCOWIconName := 'BMP_CCOW_BROKEN';
3919 pnlCCOW.Hint := TX_CCOW_BROKEN;
3920 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3921 mnuFileResumeContext.Enabled := True;
3922 mnuFileBreakContext.Enabled := False;
3923end;
3924
3925procedure TfrmFrame.mnuFileResumeContextGetClick(Sender: TObject);
3926var
3927 Reason: string;
3928begin
3929 Reason := '';
3930 if not AllowContextChangeAll(Reason) then exit;
3931 FCCOWIconName := 'BMP_CCOW_CHANGING';
3932 pnlCCOW.Hint := TX_CCOW_CHANGING;
3933 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3934 FCCOWError := False;
3935 try
3936 ctxContextor.Resume;
3937 except
3938 on E: Exception do HandleCCOWError(E.Message);
3939 end;
3940 if FCCOWError then exit;
3941 UpdateCCOWContext;
3942 FCCOWIconName := 'BMP_CCOW_LINKED';
3943 pnlCCOW.Hint := TX_CCOW_LINKED;
3944 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3945 mnuFileResumeContext.Enabled := False;
3946 mnuFileBreakContext.Visible := True;
3947 mnuFileBreakContext.Enabled := True;
3948end;
3949
3950procedure TfrmFrame.mnuFileResumeContextSetClick(Sender: TObject);
[460]3951var
3952 CCOWResponse: UserResponse;
3953 Reason: string;
[459]3954begin
[460]3955 Reason := '';
3956 if not AllowContextChangeAll(Reason) then exit;
[459]3957 FCCOWIconName := 'BMP_CCOW_CHANGING';
3958 pnlCCOW.Hint := TX_CCOW_CHANGING;
3959 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3960 FCCOWError := False;
3961 try
3962 ctxContextor.Resume;
3963 except
3964 on E: Exception do HandleCCOWError(E.Message);
3965 end;
3966 if FCCOWError then exit;
[460]3967 if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
[459]3968 begin
3969 mnuFileResumeContext.Enabled := False;
3970 mnuFileBreakContext.Visible := True;
3971 mnuFileBreakContext.Enabled := True;
3972 FCCOWIconName := 'BMP_CCOW_LINKED';
3973 pnlCCOW.Hint := TX_CCOW_LINKED;
3974 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
3975 end
3976 else
3977 begin
3978 mnuFileResumeContext.Enabled := True;
3979 mnuFileBreakContext.Enabled := False;
3980 FCCOWIconName := 'BMP_CCOW_BROKEN';
3981 pnlCCOW.Hint := TX_CCOW_BROKEN;
3982 imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
[460]3983 try
3984 if ctxContextor.State in [csParticipating] then ctxContextor.Suspend;
3985 except
3986 on E: Exception do HandleCCOWError(E.Message);
3987 end;
[459]3988 end;
3989 SetupPatient;
3990 tabPage.TabIndex := PageIDToTab(User.InitialTab);
3991 tabPageChange(tabPage);
3992end;
3993
3994procedure TfrmFrame.CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
3995var
3996 data : IContextItemCollection;
[460]3997 anItem: IContextItem;
[459]3998 PtDFN, PtName: string;
3999begin
4000 if uCore.Patient = nil then
4001 begin
4002 PtChanged := False;
4003 Exit;
4004 end;
4005 data := IContextItemCollection(aContextItemCollection) ;
4006 //PtDFN := FindBestCCOWDFN(PtName);
4007 PtDFN := FindBestCCOWDFN;
4008 // Retrieve the ContextItem name and value as strings
4009 anItem := data.Present('Patient.co.PatientName');
4010 if anItem <> nil then PtName := anItem.Get_Value();
4011 PtChanged := not ((PtDFN = Patient.DFN) and (PtName = Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^'));
4012end;
4013
[460]4014{$IFDEF CCOWBROKER}
4015procedure TfrmFrame.CheckForDifferentUser(aContextItemCollection: IDispatch; var UserChanged: boolean);
4016var
4017 data : IContextItemCollection;
4018begin
4019 if uCore.User = nil then
4020 begin
4021 UserChanged := False;
4022 Exit;
4023 end;
4024 data := IContextItemCollection(aContextItemCollection) ;
4025 UserChanged := RPCBrokerV.IsUserContextPending(data);
4026end;
4027{$ENDIF}
4028
[459]4029procedure TfrmFrame.CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
4030var
4031 data : IContextItemCollection;
4032 anItem : IContextItem;
4033 itemvalue: string;
4034 PtSubject: string;
4035begin
4036 data := IContextItemCollection(aContextItemCollection) ;
4037 anItem := data.Present('[hds_med_va.gov]request.id.name');
4038 // Retrieve the ContextItem name and value as strings
4039 if anItem <> nil then
4040 begin
4041 itemValue := anItem.Get_Value();
4042 if itemValue = 'GetWindowHandle' then
4043 begin
4044 PtSubject := 'patient.id.mrn.dfn_' + User.StationNumber;
4045 if not User.IsProductionAccount then PtSubject := PtSubject + '_test';
4046 if data.Present(PtSubject) <> nil then
4047 HyperlinkReason := '!@#$' + IntToStr(Self.Handle) + ':0:'
4048 else
4049 HyperlinkReason := '';
4050 end;
4051 end;
4052end;
4053
4054procedure TfrmFrame.HideEverything;
4055begin
[460]4056 FNoPatientSelected := TRUE;
[459]4057 pnlNoPatientSelected.Visible := True;
4058 pnlNoPatientSelected.BringToFront;
4059 mnuFileReview.Enabled := False;
4060 mnuFilePrint.Enabled := False;
4061 mnuFilePrintSelectedItems.Enabled := False;
4062 mnuFileEncounter.Enabled := False;
4063 mnuFileNext.Enabled := False;
4064 mnuFileRefresh.Enabled := False;
4065 mnuFilePrintSetup.Enabled := False;
4066 mnuFilePrintSelectedItems.Enabled := False;
4067 mnuFileNotifRemove.Enabled := False;
4068 mnuFileResumeContext.Enabled := False;
4069 mnuFileBreakContext.Enabled := False;
4070 mnuEdit.Enabled := False;
4071 mnuView.Enabled := False;
4072 mnuTools.Enabled := False;
4073end;
4074
4075procedure TfrmFrame.ShowEverything;
4076begin
[460]4077 FNoPatientSelected := FALSE;
[459]4078 pnlNoPatientSelected.Visible := False;
4079 pnlNoPatientSelected.SendToBack;
4080 mnuFileReview.Enabled := True;
4081 mnuFilePrint.Enabled := True;
4082 mnuFileEncounter.Enabled := True;
4083 mnuFileNext.Enabled := True;
4084 mnuFileRefresh.Enabled := True;
4085 mnuFilePrintSetup.Enabled := True;
4086 mnuFilePrintSelectedItems.Enabled := True;
4087 mnuFileNotifRemove.Enabled := True;
[462]4088 if not FCCOWError then
[459]4089 begin
[462]4090 if FCCOWIconName= 'BMP_CCOW_BROKEN' then
4091 begin
4092 mnuFileResumeContext.Enabled := True;
4093 mnuFileBreakContext.Enabled := False;
4094 end else
4095 begin
4096 mnuFileResumeContext.Enabled := False;
4097 mnuFileBreakContext.Enabled := True;
4098 end;
[459]4099 end;
4100 mnuEdit.Enabled := True;
4101 mnuView.Enabled := True;
4102 mnuTools.Enabled := True;
4103end;
4104
4105
4106procedure TfrmFrame.pnlFlagMouseDown(Sender: TObject; Button: TMouseButton;
4107 Shift: TShiftState; X, Y: Integer);
4108begin
4109 pnlFlag.BevelOuter := bvLowered;
4110end;
4111
4112procedure TfrmFrame.pnlFlagMouseUp(Sender: TObject; Button: TMouseButton;
4113 Shift: TShiftState; X, Y: Integer);
4114begin
4115 pnlFlag.BevelOuter := bvRaised;
4116end;
4117
4118procedure TfrmFrame.pnlFlagClick(Sender: TObject);
4119begin
[460]4120 //ShowFlags;
4121 ViewInfo(mnuViewFlags);
[459]4122end;
4123
4124procedure TfrmFrame.mnuFilePrintSelectedItemsClick(Sender: TObject);
4125begin
4126 case TabToPageID(tabPage.TabIndex) of
4127 CT_NOTES: frmNotes.LstNotesToPrint;
4128 CT_CONSULTS: frmConsults.LstConsultsToPrint;
4129 CT_DCSUMM: frmDCSumm.LstSummsToPrint;
4130 end; {case}
4131end;
4132
4133procedure TfrmFrame.mnuAlertRenewClick(Sender: TObject);
4134var XQAID: string;
4135begin
4136 XQAID := Piece(Notifications.RecordID, '^', 2);
4137 RenewAlert(XQAID);
4138end;
4139
4140procedure TfrmFrame.mnuAlertForwardClick(Sender: TObject);
4141var
4142 XQAID, AlertMsg: string;
4143begin
4144 XQAID := Piece(Notifications.RecordID,'^', 2);
4145 AlertMsg := Piece(Notifications.RecordID, '^', 1);
4146 RenewAlert(XQAID); // must renew/restore an alert before it can be forwarded
4147 ForwardAlertTo(XQAID + '^' + AlertMsg);
4148end;
4149
4150procedure TfrmFrame.mnuGECStatusClick(Sender: TObject);
4151var
4152ans, Result,str,str1,title: string;
4153cnt,i: integer;
4154fin: boolean;
4155
4156begin
4157 Result := sCallV('ORQQPXRM GEC STATUS PROMPT', [Patient.DFN]);
4158 if Piece(Result,U,1) <> '0' then
4159 begin
4160 title := Piece(Result,U,2);
4161 if pos('~',Piece(Result,U,1))>0 then
4162 begin
4163 str:='';
4164 str1 := Piece(Result,U,1);
4165 cnt := DelimCount(str1, '~');
4166 for i:=1 to cnt+1 do
4167 begin
4168 if i = 1 then str := Piece(str1,'~',i);
4169 if i > 1 then str :=str+CRLF+Piece(str1,'~',i);
4170 end;
4171 end
4172 else str := Piece(Result,U,1);
4173 if Piece(Result,U,3)='1' then
4174 begin
4175 fin := (InfoBox(str,title, MB_YESNO or MB_DEFBUTTON2)=IDYES);
4176 if fin = true then ans := '1';
4177 if fin = false then ans := '0';
4178 CallV('ORQQPXRM GEC FINISHED?',[Patient.DFN,ans]);
4179 end
4180 else
4181 InfoBox(str,title, MB_OK);
4182 end;
4183end;
4184
4185procedure TfrmFrame.pnlFlagEnter(Sender: TObject);
4186begin
4187 pnlFlag.BevelInner := bvRaised;
4188 pnlFlag.BevelOuter := bvNone;
4189 pnlFlag.BevelWidth := 4;
4190end;
4191
4192procedure TfrmFrame.pnlFlagExit(Sender: TObject);
4193begin
4194 pnlFlag.BevelWidth := 2;
4195 pnlFlag.BevelInner := bvNone;
4196 pnlFlag.BevelOuter := bvRaised;
4197end;
4198
4199procedure TfrmFrame.tabPageMouseUp(Sender: TObject; Button: TMouseButton;
4200 Shift: TShiftState; X, Y: Integer);
4201begin
4202 LastTab := TabToPageID((sender as TTabControl).TabIndex);
4203end;
4204
4205procedure TfrmFrame.lstCIRNLocationsExit(Sender: TObject);
4206begin
4207 //Make the lstCIRNLocations act as if between pnlCIRN & pnlReminders
4208 //in the Tab Order
4209 if Boolean(Hi(GetKeyState(VK_TAB))) then
4210 if Boolean(Hi(GetKeyState(VK_SHIFT))) then
4211 pnlCIRN.SetFocus
4212 else
4213 pnlReminders.SetFocus;
4214end;
4215
4216procedure TfrmFrame.AppEventsActivate(Sender: TObject);
4217begin
4218 FJustEnteredApp := True;
4219end;
4220
4221procedure TfrmFrame.ScreenActiveFormChange(Sender: TObject);
[460]4222begin
4223 if(assigned(FOldActiveFormChange)) then
4224 FOldActiveFormChange(Sender);
4225 //Focus the Form that Stays on Top after the Application Regains focus.
4226 if FJustEnteredApp then
4227 FocusApplicationTopForm;
4228 FJustEnteredApp := false;
4229end;
4230
4231procedure TfrmFrame.FocusApplicationTopForm;
[459]4232var
4233 I : integer;
4234begin
[460]4235 for I := (Screen.FormCount-1) downto 0 do //Set the last one opened last
[459]4236 begin
[460]4237 with Screen.Forms[I] do
4238 if (FormStyle = fsStayOnTop) and (Enabled) and (Visible) then
4239 SetFocus;
4240 end;
4241end;
4242
4243procedure TfrmFrame.AppEventsShortCut(var Msg: TWMKey;
4244 var Handled: Boolean);
4245begin
4246 if ((Boolean(Hi(GetKeyState(VK_MENU{ALT})))) and (Msg.CharCode = VK_F1)) then
4247 begin
4248 FocusApplicationTopForm;
4249 Handled := True;
4250 end;
4251end;
4252
4253procedure TfrmFrame.mnuToolsGraphingClick(Sender: TObject);
4254begin
4255 Screen.Cursor := crHourGlass;
4256 if GraphFloat = nil then // new graph
4257 begin
4258 GraphFloat := TfrmGraphs.Create(self);
4259 try
4260 with GraphFloat do
4261 begin
4262 if btnClose.Tag = 1 then
4263 Exit;
4264 Initialize;
4265 Caption := 'CPRS Graphing - Patient: ' + MixedCase(Patient.Name);
4266 BorderIcons := [biSystemMenu, biMaximize, biMinimize];
4267 BorderStyle := bsSizeable;
4268 BorderWidth := 1;
4269 // context sensitive type (tabPage.TabIndex) & [item]
4270 ResizeAnchoredFormToFont(GraphFloat);
4271 Show;
4272 end;
4273 finally
4274 if GraphFloat.btnClose.Tag = 1 then
4275 begin
4276 GraphFloatActive := false;
4277 GraphFloat.Free;
4278 GraphFloat := nil;
4279 end
4280 else
4281 GraphFloatActive := true;
[459]4282 end;
[460]4283 end
4284 else if GraphFloat.btnClose.Tag = 1 then
4285 Exit
4286 else if GraphFloatActive and (GraphFloat.lstTypes.Hint = Patient.DFN) then
4287 GraphFloat.BringToFront // graph is active, same patient
4288 else if GraphFloat.lstTypes.Hint = Patient.DFN then
4289 begin // graph is not active, same patient
4290 // context sensitive
4291 GraphFloat.Show;
4292 GraphFloatActive := true;
4293 end
4294 else
4295 //with GraphFloat do // new patient
4296 begin
4297 GraphFloat.InitialRetain;
4298 GraphFloatActive := false;
4299 GraphFloat.Free;
4300 GraphFloat := nil;
4301 mnuToolsGraphingClick(self); // delete and recurse
4302 {//FormCreate(self); //****************
4303 Initialize;
4304 DisplayData('top');
4305 DisplayData('bottom');
4306 lstCheck.Items.Clear;
4307 Caption := 'CPRS Graphing - Patient: ' + MixedCase(Patient.Name);
4308 // context sensitive
4309 Show;
4310 GraphFloatActive := true;}
[459]4311 end;
[460]4312 Screen.Cursor := crDefault;
[459]4313end;
4314
[460]4315procedure TfrmFrame.pnlCIRNMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
4316begin
4317 pnlCIRN.BevelOuter := bvLowered;
4318end;
[459]4319
[460]4320procedure TfrmFrame.pnlCIRNMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
4321begin
4322 pnlCIRN.BevelOuter := bvRaised;
4323end;
4324
4325procedure TfrmFrame.laMHVClick(Sender: TObject);
4326begin
4327 //if laMHV.Caption = 'MHV' then
4328 // ShellExecute(Handle, 'open', PChar('http://www.myhealth.va.gov/'), '', '', SW_NORMAL);
4329 ViewInfo(mnuViewMyHealtheVet);
4330end;
4331
4332procedure TfrmFrame.laVAA2Click(Sender: TObject);
4333{var
4334 InsuranceSubscriberName: string;
4335 ReportString: TStringList; //CQ7782 }
4336begin
4337 {if fCover.VAAFlag[0] <> '0' then //'0' means subscriber not found
4338 begin
4339 InsuranceSubscriberName := fCover.VAAFlag[12];
4340 //CQ7782
4341 //ReportString := TStringList.Create;
4342 ReportString := VAAFlag;
4343 ReportString[0] := '';
4344 ReportBox(ReportString, InsuranceSubscriberName, True);
4345 //end CQ7782
4346 end;}
4347 ViewInfo(mnuInsurance);
4348end;
4349
4350procedure TfrmFrame.ViewInfo(Sender: TObject);
4351var
4352 SelectNew: Boolean;
4353 InsuranceSubscriberName: string;
4354 ReportString: TStringList;
4355 aAddress: string;
4356begin
4357 case (Sender as TMenuItem).Tag of
4358 1:begin { displays patient inquiry report (which optionally allows new patient to be selected) }
4359 StatusText(TX_PTINQ);
4360 PatientInquiry(SelectNew);
4361 if Assigned(FLastPage) then
4362 FLastPage.FocusFirstControl;
4363 StatusText('');
4364 if SelectNew then mnuFileOpenClick(mnuViewDemo);
4365 end;
4366 2:begin
4367 if (not User.IsReportsOnly) then // Reports Only tab.
4368 mnuFileEncounterClick(Self);
4369 end;
4370 3:begin
4371 ReportBox(DetailPrimaryCare(Patient.DFN), 'Primary Care', True);
4372 end;
4373 4:begin
4374 if laMHV.Caption = 'MHV' then
4375 ShellExecute(laMHV.Handle, 'open', PChar('http://www.myhealth.va.gov/'), '', '', SW_NORMAL);
4376 end;
4377 5:begin
4378 if fCover.VAAFlag[0] <> '0' then //'0' means subscriber not found
4379 begin
4380 InsuranceSubscriberName := fCover.VAAFlag[12];
4381 ReportString := VAAFlag;
4382 ReportString[0] := '';
4383 ReportBox(ReportString, InsuranceSubscriberName, True);
4384 end;
4385 end;
4386 6:begin
4387 ShowFlags;
4388 end;
4389 7:begin
4390 if UseVistaWeb then
4391 begin
4392 pnlCIRN.BevelOuter := bvRaised;
4393 pnlCIRN.Hint := 'Click to open VistaWeb';
4394 lblCIRN.Width := 43;
4395 lblCIRNData.Width := 43;
4396 lblCIRNData.Alignment := taCenter;
4397 lblCIRN.Alignment := taCenter;
4398 lstCIRNLocations.Visible := false;
4399 lstCIRNLocations.SendToBack;
4400 aAddress := GetVistaWebAddress(Patient.DFN);
4401 ShellExecute(pnlCirn.Handle, 'open', PChar(aAddress), PChar(''), '', SW_NORMAL);
4402 Exit;
4403 end;
4404 if not RemoteSites.RemoteDataExists then Exit;
4405 if (not lstCIRNLocations.Visible) then
4406 begin
4407 pnlCIRN.BevelOuter := bvLowered;
4408 lstCIRNLocations.Visible := True;
4409 lstCIRNLocations.BringToFront;
4410 lstCIRNLocations.SetFocus;
4411 pnlCIRN.Hint := 'Click to close list.';
4412 end
4413 else
4414 begin
4415 pnlCIRN.BevelOuter := bvRaised;
4416 lstCIRNLocations.Visible := False;
4417 lstCIRNLocations.SendToBack;
4418 pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
4419 end;
4420 end;
4421 8:begin
4422 ViewReminderTree;
4423 end;
4424 9:begin { displays the window that shows crisis notes, warnings, allergies, & advance directives }
4425 ShowCWAD;
4426 end;
4427 end;
4428end;
4429
4430procedure TfrmFrame.mnuViewInformationClick(Sender: TObject);
4431begin
4432 mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
4433 mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
4434 mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
4435 mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
4436 mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
4437 mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
4438 mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
4439 mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
4440 mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
4441end;
4442
[459]4443initialization
4444
4445finalization
4446
[460]4447
[459]4448end.
4449
[460]4450
Note: See TracBrowser for help on using the repository browser.