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

Last change on this file since 1800 was 1679, checked in by healthsevak, 10 years ago

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