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