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

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

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