source: cprs/trunk/CPRS-Chart/fFrame.pas@ 1245

Last change on this file since 1245 was 830, checked in by Kevin Toppenberg, 14 years ago

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