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

Last change on this file since 710 was 694, checked in by Kevin Toppenberg, 15 years ago

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