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

Last change on this file since 797 was 793, checked in by Kevin Toppenberg, 14 years ago

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