source: cprs/branches/tmg-cprs/CPRS-Chart/fFrame.pas@ 454

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

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