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

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

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