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

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

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