[459] | 1 | unit fFrame;
|
---|
| 2 | { This is the main form for the CPRS GUI. It provides a patient-encounter-user framework
|
---|
| 3 | which all the other forms of the GUI use. }
|
---|
| 4 |
|
---|
| 5 | {$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
|
---|
| 6 | {$WARN SYMBOL_PLATFORM OFF}
|
---|
| 7 |
|
---|
| 8 | {.$define debug}
|
---|
| 9 |
|
---|
| 10 | interface
|
---|
| 11 |
|
---|
| 12 | uses
|
---|
| 13 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Tabs, ComCtrls,
|
---|
| 14 | ExtCtrls, Menus, StdCtrls, Buttons, ORFn, fPage, uConst, ORCtrls, Trpcb,
|
---|
| 15 | OleCtrls, VERGENCECONTEXTORLib_TLB, ComObj, AppEvnts;
|
---|
| 16 |
|
---|
| 17 | type
|
---|
| 18 | TfrmFrame = class(TForm)
|
---|
| 19 | pnlToolbar: TPanel;
|
---|
| 20 | stsArea: TStatusBar;
|
---|
| 21 | tabPage: TTabControl;
|
---|
| 22 | pnlPage: TPanel;
|
---|
| 23 | bvlPageTop: TBevel;
|
---|
| 24 | bvlToolTop: TBevel;
|
---|
| 25 | pnlPatient: TKeyClickPanel;
|
---|
| 26 | lblPtName: TStaticText;
|
---|
| 27 | lblPtSSN: TStaticText;
|
---|
| 28 | lblPtAge: TStaticText;
|
---|
| 29 | pnlVisit: TKeyClickPanel;
|
---|
| 30 | lblPtLocation: TStaticText;
|
---|
| 31 | lblPtProvider: TStaticText;
|
---|
| 32 | mnuFrame: TMainMenu;
|
---|
| 33 | mnuFile: TMenuItem;
|
---|
| 34 | mnuFileExit: TMenuItem;
|
---|
| 35 | mnuFileOpen: TMenuItem;
|
---|
| 36 | mnuFileReview: TMenuItem;
|
---|
| 37 | Z1: TMenuItem;
|
---|
| 38 | mnuFilePrint: TMenuItem;
|
---|
| 39 | mnuEdit: TMenuItem;
|
---|
| 40 | mnuEditUndo: TMenuItem;
|
---|
| 41 | Z3: TMenuItem;
|
---|
| 42 | mnuEditCut: TMenuItem;
|
---|
| 43 | mnuEditCopy: TMenuItem;
|
---|
| 44 | mnuEditPaste: TMenuItem;
|
---|
| 45 | Z4: TMenuItem;
|
---|
| 46 | mnuEditPref: TMenuItem;
|
---|
| 47 | Prefs1: TMenuItem;
|
---|
| 48 | mnu24pt1: TMenuItem;
|
---|
| 49 | mnu18pt1: TMenuItem;
|
---|
| 50 | mnu14pt1: TMenuItem;
|
---|
| 51 | mnu12pt1: TMenuItem;
|
---|
| 52 | mnu10pt1: TMenuItem;
|
---|
| 53 | mnu8pt: TMenuItem;
|
---|
| 54 | mnuHelp: TMenuItem;
|
---|
| 55 | mnuHelpContents: TMenuItem;
|
---|
| 56 | mnuHelpTutor: TMenuItem;
|
---|
| 57 | Z5: TMenuItem;
|
---|
| 58 | mnuHelpAbout: TMenuItem;
|
---|
| 59 | mnuTools: TMenuItem;
|
---|
| 60 | mnuView: TMenuItem;
|
---|
| 61 | mnuViewChart: TMenuItem;
|
---|
| 62 | mnuChartReports: TMenuItem;
|
---|
| 63 | mnuChartLabs: TMenuItem;
|
---|
| 64 | mnuChartDCSumm: TMenuItem;
|
---|
| 65 | mnuChartCslts: TMenuItem;
|
---|
| 66 | mnuChartNotes: TMenuItem;
|
---|
| 67 | mnuChartOrders: TMenuItem;
|
---|
| 68 | mnuChartMeds: TMenuItem;
|
---|
| 69 | mnuChartProbs: TMenuItem;
|
---|
| 70 | mnuChartCover: TMenuItem;
|
---|
| 71 | mnuHelpBroker: TMenuItem;
|
---|
| 72 | mnuFileEncounter: TMenuItem;
|
---|
| 73 | mnuViewDemo: TMenuItem;
|
---|
| 74 | mnuViewPostings: TMenuItem;
|
---|
| 75 | mnuHelpLists: TMenuItem;
|
---|
| 76 | Z6: TMenuItem;
|
---|
| 77 | mnuHelpSymbols: TMenuItem;
|
---|
| 78 | mnuFileNext: TMenuItem;
|
---|
| 79 | Z7: TMenuItem;
|
---|
| 80 | mnuFileRefresh: TMenuItem;
|
---|
| 81 | pnlPrimaryCare: TKeyClickPanel;
|
---|
| 82 | lblPtCare: TStaticText;
|
---|
| 83 | lblPtAttending: TStaticText;
|
---|
| 84 | pnlCIRN: TKeyClickPanel;
|
---|
| 85 | lblCIRN: TLabel;
|
---|
| 86 | lblCIRNData: TLabel;
|
---|
| 87 | pnlReminders: TKeyClickPanel;
|
---|
| 88 | imgReminder: TImage;
|
---|
| 89 | mnuViewReminders: TMenuItem;
|
---|
| 90 | anmtRemSearch: TAnimate;
|
---|
| 91 | lstCIRNLocations: TORListBox;
|
---|
| 92 | popCIRN: TPopupMenu;
|
---|
| 93 | popCIRNSelectAll: TMenuItem;
|
---|
| 94 | popCIRNSelectNone: TMenuItem;
|
---|
| 95 | popCIRNClose: TMenuItem;
|
---|
| 96 | mnuFilePrintSetup: TMenuItem;
|
---|
| 97 | LabInfo1: TMenuItem;
|
---|
| 98 | mnuFileNotifRemove: TMenuItem;
|
---|
| 99 | Z8: TMenuItem;
|
---|
| 100 | mnuToolsOptions: TMenuItem;
|
---|
| 101 | mnuChartSurgery: TMenuItem;
|
---|
| 102 | OROpenDlg: TOpenDialog;
|
---|
| 103 | mnuFileResumeContext: TMenuItem;
|
---|
| 104 | mnuFileResumeContextSet: TMenuItem;
|
---|
| 105 | Useexistingcontext1: TMenuItem;
|
---|
| 106 | mnuFileBreakContext: TMenuItem;
|
---|
| 107 | pnlCCOW: TPanel;
|
---|
| 108 | imgCCOW: TImage;
|
---|
| 109 | pnlPatientSelected: TPanel;
|
---|
| 110 | pnlNoPatientSelected: TPanel;
|
---|
| 111 | pnlFlag: TKeyClickPanel;
|
---|
| 112 | lblFlag: TLabel;
|
---|
| 113 | pnlPostings: TKeyClickPanel;
|
---|
| 114 | lblPtPostings: TStaticText;
|
---|
| 115 | lblPtCWAD: TStaticText;
|
---|
| 116 | mnuFilePrintSelectedItems: TMenuItem;
|
---|
| 117 | popAlerts: TPopupMenu;
|
---|
| 118 | mnuAlertContinue: TMenuItem;
|
---|
| 119 | mnuAlertForward: TMenuItem;
|
---|
| 120 | mnuAlertRenew: TMenuItem;
|
---|
| 121 | AppEvents: TApplicationEvents;
|
---|
| 122 | procedure tabPageChange(Sender: TObject);
|
---|
| 123 | procedure FormCreate(Sender: TObject);
|
---|
| 124 | procedure FormResize(Sender: TObject);
|
---|
| 125 | procedure pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 126 | Shift: TShiftState; X, Y: Integer);
|
---|
| 127 | procedure pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 128 | Shift: TShiftState; X, Y: Integer);
|
---|
| 129 | procedure pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 130 | Shift: TShiftState; X, Y: Integer);
|
---|
| 131 | procedure pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 132 | Shift: TShiftState; X, Y: Integer);
|
---|
| 133 | procedure mnuFileExitClick(Sender: TObject);
|
---|
| 134 | procedure pnlPostingsMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 135 | Shift: TShiftState; X, Y: Integer);
|
---|
| 136 | procedure pnlPostingsMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 137 | Shift: TShiftState; X, Y: Integer);
|
---|
| 138 | procedure mnuFontSizeClick(Sender: TObject);
|
---|
| 139 | procedure mnuChartTabClick(Sender: TObject);
|
---|
| 140 | procedure FormDestroy(Sender: TObject);
|
---|
| 141 | procedure mnuFileOpenClick(Sender: TObject);
|
---|
| 142 | procedure mnuHelpBrokerClick(Sender: TObject);
|
---|
| 143 | procedure mnuFileEncounterClick(Sender: TObject);
|
---|
| 144 | procedure mnuViewDemoClick(Sender: TObject);
|
---|
| 145 | procedure mnuViewPostingsClick(Sender: TObject);
|
---|
| 146 | procedure mnuHelpAboutClick(Sender: TObject);
|
---|
| 147 | procedure mnuFileReviewClick(Sender: TObject);
|
---|
| 148 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
---|
| 149 | procedure mnuHelpListsClick(Sender: TObject);
|
---|
| 150 | procedure ToolClick(Sender: TObject);
|
---|
| 151 | procedure mnuEditClick(Sender: TObject);
|
---|
| 152 | procedure mnuEditUndoClick(Sender: TObject);
|
---|
| 153 | procedure mnuEditCutClick(Sender: TObject);
|
---|
| 154 | procedure mnuEditCopyClick(Sender: TObject);
|
---|
| 155 | procedure mnuEditPasteClick(Sender: TObject);
|
---|
| 156 | procedure mnuHelpSymbolsClick(Sender: TObject);
|
---|
| 157 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 158 | procedure mnuFilePrintClick(Sender: TObject);
|
---|
| 159 | procedure mnuGECStatusClick(Sender: TObject);
|
---|
| 160 | procedure mnuFileNextClick(Sender: TObject);
|
---|
| 161 | procedure stsAreaMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 162 | Shift: TShiftState; X, Y: Integer);
|
---|
| 163 | procedure stsAreaMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 164 | Shift: TShiftState; X, Y: Integer);
|
---|
| 165 | procedure stsAreaDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
|
---|
| 166 | const Rect: TRect);
|
---|
| 167 | procedure pnlPrimaryCareMouseDown(Sender: TObject;
|
---|
| 168 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 169 | procedure pnlPrimaryCareMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 170 | Shift: TShiftState; X, Y: Integer);
|
---|
| 171 | function FormHelp(Command: Word; Data: Integer;
|
---|
| 172 | var CallHelp: Boolean): Boolean;
|
---|
| 173 | procedure mnuViewRemindersClick(Sender: TObject);
|
---|
| 174 | procedure pnlRemindersMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 175 | Shift: TShiftState; X, Y: Integer);
|
---|
| 176 | procedure pnlRemindersMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 177 | Shift: TShiftState; X, Y: Integer);
|
---|
| 178 | procedure pnlCIRNClick(Sender: TObject);
|
---|
| 179 | procedure lstCIRNLocationsClick(Sender: TObject);
|
---|
| 180 | procedure popCIRNCloseClick(Sender: TObject);
|
---|
| 181 | procedure popCIRNSelectAllClick(Sender: TObject);
|
---|
| 182 | procedure popCIRNSelectNoneClick(Sender: TObject);
|
---|
| 183 | procedure mnuFilePrintSetupClick(Sender: TObject);
|
---|
| 184 | procedure lstCIRNLocationsChange(Sender: TObject);
|
---|
| 185 | procedure LabInfo1Click(Sender: TObject);
|
---|
| 186 | procedure mnuFileNotifRemoveClick(Sender: TObject);
|
---|
| 187 | procedure mnuToolsOptionsClick(Sender: TObject);
|
---|
| 188 | procedure mnuFileRefreshClick(Sender: TObject);
|
---|
| 189 | procedure FormKeyDown(Sender: TObject; var Key: Word;
|
---|
| 190 | Shift: TShiftState);
|
---|
| 191 | procedure FormActivate(Sender: TObject);
|
---|
| 192 | procedure pnlPrimaryCareEnter(Sender: TObject);
|
---|
| 193 | procedure pnlPrimaryCareExit(Sender: TObject);
|
---|
| 194 | procedure pnlPatientClick(Sender: TObject);
|
---|
| 195 | procedure pnlVisitClick(Sender: TObject);
|
---|
| 196 | procedure pnlPrimaryCareClick(Sender: TObject);
|
---|
| 197 | procedure pnlRemindersClick(Sender: TObject);
|
---|
| 198 | procedure pnlPostingsClick(Sender: TObject);
|
---|
| 199 | procedure ctxContextorCanceled(Sender: TObject);
|
---|
| 200 | procedure ctxContextorCommitted(Sender: TObject);
|
---|
| 201 | procedure ctxContextorPending(Sender: TObject;
|
---|
| 202 | const aContextItemCollection: IDispatch);
|
---|
| 203 | procedure mnuFileBreakContextClick(Sender: TObject);
|
---|
| 204 | procedure mnuFileResumeContextGetClick(Sender: TObject);
|
---|
| 205 | procedure mnuFileResumeContextSetClick(Sender: TObject);
|
---|
| 206 | procedure pnlFlagMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 207 | Shift: TShiftState; X, Y: Integer);
|
---|
| 208 | procedure pnlFlagMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 209 | Shift: TShiftState; X, Y: Integer);
|
---|
| 210 | procedure pnlFlagClick(Sender: TObject);
|
---|
| 211 | procedure mnuFilePrintSelectedItemsClick(Sender: TObject);
|
---|
| 212 | procedure mnuAlertRenewClick(Sender: TObject);
|
---|
| 213 | procedure mnuAlertForwardClick(Sender: TObject);
|
---|
| 214 | procedure pnlFlagEnter(Sender: TObject);
|
---|
| 215 | procedure pnlFlagExit(Sender: TObject);
|
---|
| 216 | procedure tabPageMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 217 | Shift: TShiftState; X, Y: Integer);
|
---|
| 218 | procedure lstCIRNLocationsExit(Sender: TObject);
|
---|
| 219 | procedure AppEventsActivate(Sender: TObject);
|
---|
| 220 | procedure ScreenActiveFormChange(Sender: TObject);
|
---|
| 221 | procedure mnuToolsClick(Sender: TObject);
|
---|
| 222 | private
|
---|
| 223 | FJustEnteredApp : boolean;
|
---|
| 224 | FCCOWInstalled: boolean;
|
---|
| 225 | FCCOWContextChanging: boolean;
|
---|
| 226 | FCCOWIconName: string;
|
---|
| 227 | FCCOWDrivedChange: boolean;
|
---|
| 228 | FCCOWBusy: boolean;
|
---|
| 229 | FCCOWError: boolean;
|
---|
| 230 | FRefreshing: boolean;
|
---|
| 231 | FClosing: boolean;
|
---|
| 232 | FContextChanging: Boolean;
|
---|
| 233 | FChangeSource: Integer;
|
---|
| 234 | FCreateProgress: Integer;
|
---|
| 235 | FEditCtrl: TCustomEdit;
|
---|
| 236 | FLastPage: TfrmPage;
|
---|
| 237 | FNextButtonL: Integer;
|
---|
| 238 | FNextButtonR: Integer;
|
---|
| 239 | FNextButtonActive: Boolean;
|
---|
| 240 | FNextButtonBitmap: TBitmap;
|
---|
| 241 | FTerminate: Boolean;
|
---|
| 242 | FTabChanged: TNotifyEvent;
|
---|
| 243 | FOldActivate: TNotifyEvent;
|
---|
| 244 | FECSAuthUser: Boolean;
|
---|
| 245 | FFixedStatusWidth: integer;
|
---|
| 246 | FPrevInPatient: Boolean;
|
---|
| 247 | FFirstLoad: Boolean;
|
---|
| 248 | FFlagList: TStringList;
|
---|
| 249 | FPrevPtID: string;
|
---|
| 250 | procedure RefreshFixedStatusWidth;
|
---|
| 251 | procedure AppActivated(Sender: TObject);
|
---|
| 252 | procedure AppDeActivated(Sender: TObject);
|
---|
| 253 | procedure AppException(Sender: TObject; E: Exception);
|
---|
| 254 | function AllowContextChangeAll(var Reason: string): Boolean;
|
---|
| 255 | procedure ClearPatient;
|
---|
| 256 | procedure ChangeFont(NewFontSize: Integer);
|
---|
| 257 | //procedure CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
|
---|
| 258 | procedure CreateTab(ATabID: integer; ALabel: string);
|
---|
| 259 | procedure DetermineNextTab;
|
---|
| 260 | function ExpandCommand(x: string): string;
|
---|
| 261 | procedure FitToolbar;
|
---|
| 262 | procedure LoadSizesForUser;
|
---|
| 263 | procedure SaveSizesForUser;
|
---|
| 264 | procedure LoadUserPreferences;
|
---|
| 265 | procedure SaveUserPreferences;
|
---|
| 266 | procedure SwitchToPage(NewForm: TfrmPage);
|
---|
| 267 | function TabToPageID(Tab: Integer): Integer;
|
---|
| 268 | function TimeoutCondition: boolean;
|
---|
| 269 | function GetTimedOut: boolean;
|
---|
| 270 | procedure TimeOutAction;
|
---|
| 271 | procedure SetUserTools;
|
---|
| 272 | procedure SetDebugMenu;
|
---|
| 273 | procedure SetupPatient(AFlaggedList : TStringList = nil);
|
---|
| 274 | procedure SetUpCIRN;
|
---|
| 275 | procedure RemindersChanged(Sender: TObject);
|
---|
| 276 | procedure ReportsOnlyDisplay;
|
---|
| 277 | procedure UMInitiate(var Message: TMessage); message UM_INITIATE;
|
---|
| 278 | procedure UMNewOrder(var Message: TMessage); message UM_NEWORDER;
|
---|
| 279 | procedure UMStatusText(var Message: TMessage); message UM_STATUSTEXT;
|
---|
| 280 | procedure UMShowPage(var Message: TMessage); message UM_SHOWPAGE;
|
---|
| 281 | procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
|
---|
| 282 | procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
|
---|
| 283 | procedure UpdateECSParameter(var CmdParameter: string);
|
---|
| 284 | function ValidECSUser: boolean;
|
---|
| 285 | function AllowCCOWContextChange(NewDFN: string): boolean;
|
---|
| 286 | procedure UpdateCCOWContext;
|
---|
| 287 | procedure CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
|
---|
| 288 | procedure CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
|
---|
| 289 | procedure HideEverything;
|
---|
| 290 | procedure ShowEverything;
|
---|
| 291 | //function FindBestCCOWDFN(var APatientName: string): string;
|
---|
| 292 | function FindBestCCOWDFN: string;
|
---|
| 293 | procedure HandleCCOWError(AMessage: string);
|
---|
| 294 | public
|
---|
| 295 | EnduringPtSelSplitterPos: integer;
|
---|
| 296 | procedure SetBADxList;
|
---|
| 297 |
|
---|
| 298 | function PageIDToTab(PageID: Integer): Integer;
|
---|
| 299 | procedure ShowHideChartTabMenus(AMenuItem: TMenuItem);
|
---|
| 300 | procedure UpdatePtInfoOnRefresh;
|
---|
| 301 | function TabExists(ATabID: integer): boolean;
|
---|
| 302 | procedure DisplayEncounterText;
|
---|
| 303 | property ChangeSource: Integer read FChangeSource;
|
---|
| 304 | property CCOWContextChanging: Boolean read FCCOWContextChanging;
|
---|
| 305 | property CCOWDrivedChange: Boolean read FCCOWDrivedChange;
|
---|
| 306 | property CCOWBusy: Boolean read FCCOWBusy write FCCOWBusy;
|
---|
| 307 | property ContextChanging: Boolean read FContextChanging;
|
---|
| 308 | property TimedOut: Boolean read GetTimedOut;
|
---|
| 309 | property Closing: Boolean read FClosing;
|
---|
| 310 | property OnTabChanged: TNotifyEvent read FTabChanged write FTabChanged;
|
---|
| 311 | end;
|
---|
| 312 |
|
---|
| 313 | var
|
---|
| 314 | frmFrame: TfrmFrame;
|
---|
| 315 | uTabList: TStringList;
|
---|
| 316 | uRemoteType : string;
|
---|
| 317 | FlaggedPTList: TStringList;
|
---|
| 318 | ctxContextor : TContextorControl;
|
---|
| 319 | NextTab, LastTab: Integer;
|
---|
| 320 | uToolsMaxed, uToolsWarned: boolean;
|
---|
| 321 |
|
---|
| 322 | const
|
---|
| 323 | PASSCODE = '_gghwn7pghCrOJvOV61PtPvgdeEU2u5cRsGvpkVDjKT_H7SdKE_hqFYWsUIVT1H7JwT6Yz8oCtd2u2PALqWxibNXx3Yo8GPcTYsNaxW' + 'ZFo8OgT11D5TIvpu3cDQuZd3Yh_nV9jhkvb0ZBGdO9n-uNXPPEK7xfYWCI2Wp3Dsu9YDSd_EM34nvrgy64cqu9_jFJKJnGiXY96Lf1ecLiv4LT9qtmJ-BawYt7O9JZGAswi344BmmCbNxfgvgf0gfGZea';
|
---|
| 324 |
|
---|
| 325 | implementation
|
---|
| 326 |
|
---|
| 327 | {$R *.DFM}
|
---|
| 328 | {$R sBitmaps}
|
---|
| 329 | {$R sRemSrch}
|
---|
| 330 |
|
---|
| 331 | uses
|
---|
| 332 | ORNet, rCore, fPtSelMsg, fPtSel, fCover, fProbs, fMeds, fOrders, rOrders, fNotes, fConsults, fDCSumm,
|
---|
| 333 | rMisc, Clipbrd, fLabs, fReports, fPtDemo, fEncnt, fPtCWAD, uCore, fAbout, fReview, fxBroker,
|
---|
| 334 | fxLists, fxServer, ORSystem, fRptBox, fSplash, rODAllergy, uInit, fLabTests, fLabInfo,
|
---|
| 335 | uReminders, fReminderTree, ORClasses, fDeviceSelect, fDrawers, fReminderDialog, ShellAPI, rVitals,
|
---|
| 336 | fOptions, rTemplates, fSurgery, rSurgery, uEventHooks, uSignItems, fDefaultEvent,rECS,
|
---|
| 337 | fIconLegend, uOrders, fPtSelOptns, DateUtils, uSpell, uOrPtf, fPatientFlagMulti,
|
---|
| 338 | fAlertForward, UBAGlobals, fBAOptionsDiagnoses,UBACore,fOrdersSign;
|
---|
| 339 |
|
---|
| 340 | const
|
---|
| 341 | // moved to uConst - RV v16
|
---|
| 342 | (* CT_NOPAGE = -1; // chart tab - none selected
|
---|
| 343 | CT_UNKNOWN = 0; // chart tab - unknown (shouldn't happen)
|
---|
| 344 | CT_COVER = 1; // chart tab - cover sheet
|
---|
| 345 | CT_PROBLEMS = 2; // chart tab - problem list
|
---|
| 346 | CT_MEDS = 3; // chart tab - medications screen
|
---|
| 347 | CT_ORDERS = 4; // chart tab - doctor's orders
|
---|
| 348 | CT_HP = 5; // chart tab - history & physical
|
---|
| 349 | CT_NOTES = 6; // chart tab - progress notes
|
---|
| 350 | CT_CONSULTS = 7; // chart tab - consults
|
---|
| 351 | CT_DCSUMM = 8; // chart tab - discharge summaries
|
---|
| 352 | CT_LABS = 9; // chart tab - laboratory results
|
---|
| 353 | CT_REPORTS = 10; // chart tab - reports
|
---|
| 354 | CT_SURGERY = 11; // chart tab - surgery*)
|
---|
| 355 |
|
---|
| 356 | FCP_UPDATE = 10; // form create about to check auto-update
|
---|
| 357 | FCP_SETHOOK = 20; // form create about to set timeout hooks
|
---|
| 358 | FCP_SERVER = 30; // form create about to connect to server
|
---|
| 359 | FCP_CHKVER = 40; // form create about to check version
|
---|
| 360 | FCP_OBJECTS = 50; // form create about to create core objects
|
---|
| 361 | FCP_FORMS = 60; // form create about to create child forms
|
---|
| 362 | FCP_PTSEL = 70; // form create about to select patient
|
---|
| 363 | FCP_FINISH = 99; // form create finished successfully
|
---|
| 364 |
|
---|
| 365 | TX_IN_USE = 'VistA CPRS in use by: ';
|
---|
| 366 | TX_OPTION = 'OR CPRS GUI CHART';
|
---|
| 367 | TX_ECSOPT = 'EC GUI CONTEXT';
|
---|
| 368 | TX_PTINQ = 'Retrieving demographic information...';
|
---|
| 369 | TX_NOTIF_STOP = 'Stop processing notifications?';
|
---|
| 370 | TC_NOTIF_STOP = 'Currently Processing Notifications';
|
---|
| 371 | TX_UNK_NOTIF = 'Unable to process the follow up action for this notification';
|
---|
| 372 | TC_UNK_NOTIF = 'Follow Up Action Not Implemented';
|
---|
| 373 | TX_NO_SURG_NOTIF = 'This notification must be processed using the Surgery tab, ' + CRLF +
|
---|
| 374 | 'which is not currently available to you.';
|
---|
| 375 | TC_NO_SURG_NOTIF = 'Surgery Tab Not Available';
|
---|
| 376 | TX_VER1 = 'This is version ';
|
---|
| 377 | TX_VER2 = ' of CPRSChart.exe.';
|
---|
| 378 | TX_VER3 = CRLF + 'The running server version is ';
|
---|
| 379 | TX_VER_REQ = ' version server is required.';
|
---|
| 380 | TX_VER_OLD = CRLF + 'It is strongly recommended that you upgrade.';
|
---|
| 381 | TX_VER_OLD2 = CRLF + 'The program cannot be run until the client is upgraded.';
|
---|
| 382 | TX_VER_NEW = CRLF + 'The program cannot be run until the server is upgraded.';
|
---|
| 383 | TC_VER = 'Server/Client Incompatibility';
|
---|
| 384 | TC_CLIERR = 'Client Specifications Mismatch';
|
---|
| 385 |
|
---|
| 386 | SHOW_NOTIFICATIONS = True;
|
---|
| 387 |
|
---|
| 388 | TC_DGSR_ERR = 'Remote Data Error';
|
---|
| 389 | TC_DGSR_SHOW = 'Restricted Remote Record';
|
---|
| 390 | TC_DGSR_DENY = 'Remote Access Denied';
|
---|
| 391 | TX_DGSR_YESNO = CRLF + 'Do you want to continue accessing this remote patient record?';
|
---|
| 392 |
|
---|
| 393 | TX_CCOW_LINKED = 'Clinical Link On';
|
---|
| 394 | TX_CCOW_CHANGING = 'Clinical link changing';
|
---|
| 395 | TX_CCOW_BROKEN = 'Clinical link broken';
|
---|
| 396 | TX_CCOW_ERROR = 'CPRS was unable to communicate with the CCOW Context Vault' + CRLF +
|
---|
| 397 | 'CCOW patient synchronization will be unavailable for the remainder of this session.';
|
---|
| 398 | TC_CCOW_ERROR = 'CCOW Error';
|
---|
| 399 |
|
---|
| 400 | function TfrmFrame.TimeoutCondition: boolean;
|
---|
| 401 | begin
|
---|
| 402 | Result := (FCreateProgress < FCP_PTSEL);
|
---|
| 403 | end;
|
---|
| 404 |
|
---|
| 405 | function TfrmFrame.GetTimedOut: boolean;
|
---|
| 406 | begin
|
---|
| 407 | Result := uInit.TimedOut;
|
---|
| 408 | end;
|
---|
| 409 |
|
---|
| 410 | procedure TfrmFrame.TimeOutAction;
|
---|
| 411 | begin
|
---|
| 412 | Close;
|
---|
| 413 | end;
|
---|
| 414 |
|
---|
| 415 | { General Functions and Procedures }
|
---|
| 416 |
|
---|
| 417 | procedure TfrmFrame.AppException(Sender: TObject; E: Exception);
|
---|
| 418 | var
|
---|
| 419 | AnAddr: Pointer;
|
---|
| 420 | ErrMsg: string;
|
---|
| 421 | begin
|
---|
| 422 | Application.NormalizeTopMosts;
|
---|
| 423 | if (E is EIntError) then
|
---|
| 424 | begin
|
---|
| 425 | ErrMsg := E.Message + CRLF +
|
---|
| 426 | 'CreateProgress: ' + IntToStr(FCreateProgress) + CRLF +
|
---|
| 427 | 'RPC Info: ' + RPCLastCall;
|
---|
| 428 | if EExternal(E).ExceptionRecord <> nil then
|
---|
| 429 | begin
|
---|
| 430 | AnAddr := EExternal(E).ExceptionRecord^.ExceptionAddress;
|
---|
| 431 | ErrMsg := ErrMsg + CRLF + 'Address was ' + IntToStr(Integer(AnAddr));
|
---|
| 432 | end;
|
---|
| 433 | ShowMessage(ErrMsg);
|
---|
| 434 | end
|
---|
| 435 | else if (E is EBrokerError) then
|
---|
| 436 | begin
|
---|
| 437 | Application.ShowException(E);
|
---|
| 438 | FCreateProgress := FCP_FORMS;
|
---|
| 439 | Close;
|
---|
| 440 | end
|
---|
| 441 | else if (E is EOleException) then
|
---|
| 442 | begin
|
---|
| 443 | Application.ShowException(E);
|
---|
| 444 | FCreateProgress := FCP_FORMS;
|
---|
| 445 | Close;
|
---|
| 446 | end
|
---|
| 447 | else Application.ShowException(E);
|
---|
| 448 | Application.RestoreTopMosts;
|
---|
| 449 | end;
|
---|
| 450 |
|
---|
| 451 | function TfrmFrame.AllowContextChangeAll(var Reason: string): Boolean;
|
---|
| 452 | var
|
---|
| 453 | Silent: Boolean;
|
---|
| 454 | begin
|
---|
| 455 | if pnlNoPatientSelected.Visible then
|
---|
| 456 | begin
|
---|
| 457 | Result := True;
|
---|
| 458 | exit;
|
---|
| 459 | end;
|
---|
| 460 | FContextChanging := True;
|
---|
| 461 | Result := True;
|
---|
| 462 | if COMObjectActive or SpellCheckInProgress then
|
---|
| 463 | begin
|
---|
| 464 | Reason := 'COM_OBJECT_ACTIVE';
|
---|
| 465 | Result:= False;
|
---|
| 466 | end;
|
---|
| 467 | if Result then Result := frmCover.AllowContextChange(Reason);
|
---|
| 468 | if Result then Result := frmProblems.AllowContextChange(Reason);
|
---|
| 469 | if Result then Result := frmMeds.AllowContextChange(Reason);
|
---|
| 470 | if Result then Result := frmOrders.AllowContextChange(Reason);
|
---|
| 471 | if Result then Result := frmNotes.AllowContextChange(Reason);
|
---|
| 472 | if Result then Result := frmConsults.AllowContextChange(Reason);
|
---|
| 473 | if Result then Result := frmDCSumm.AllowContextChange(Reason);
|
---|
| 474 | if Result then
|
---|
| 475 | if Assigned(frmSurgery) then Result := frmSurgery.AllowContextChange(Reason);;
|
---|
| 476 | if Result then Result := frmLabs.AllowContextChange(Reason);;
|
---|
| 477 | if Result then Result := frmReports.AllowContextChange(Reason);
|
---|
| 478 | if (not User.IsReportsOnly) then
|
---|
| 479 | if Result and Changes.RequireReview then //Result := ReviewChanges(TimedOut);
|
---|
| 480 | case BOOLCHAR[FCCOWContextChanging] of
|
---|
| 481 | '1': begin
|
---|
| 482 | if Changes.RequireReview then
|
---|
| 483 | begin
|
---|
| 484 | Reason := 'Items will be left unsigned.';
|
---|
| 485 | Result := False;
|
---|
| 486 | end
|
---|
| 487 | else
|
---|
| 488 | Result := True;
|
---|
| 489 | end;
|
---|
| 490 | '0': begin
|
---|
| 491 | Silent := (TimedOut) or (Reason = 'COMMIT');
|
---|
| 492 | Result := ReviewChanges(Silent);
|
---|
| 493 | end;
|
---|
| 494 | end;
|
---|
| 495 | FContextChanging := False;
|
---|
| 496 | end;
|
---|
| 497 |
|
---|
| 498 | procedure TfrmFrame.ClearPatient;
|
---|
| 499 | { call all pages to make sure patient related information is cleared (when switching patients) }
|
---|
| 500 | begin
|
---|
| 501 | if frmFrame.Timedout then Exit; // added to correct Access Violation when "Refresh Patient Information" selected
|
---|
| 502 | lblPtName.Caption := '';
|
---|
| 503 | lblPtSSN.Caption := '';
|
---|
| 504 | lblPtAge.Caption := '';
|
---|
| 505 | pnlPatient.Caption := '';
|
---|
| 506 | lblPtCWAD.Caption := '';
|
---|
| 507 | lblPtLocation.Caption := 'Visit Not Selected';
|
---|
| 508 | lblPtProvider.Caption := 'Current Provider Not Selected';
|
---|
| 509 | pnlVisit.Caption := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
|
---|
| 510 | lblPtCare.Caption := 'Primary Care Team Unassigned';
|
---|
| 511 | lblPtAttending.Caption := '';
|
---|
| 512 | pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption;
|
---|
| 513 | frmCover.ClearPtData;
|
---|
| 514 | frmProblems.ClearPtData;
|
---|
| 515 | frmMeds.ClearPtData;
|
---|
| 516 | frmOrders.ClearPtData;
|
---|
| 517 | frmNotes.ClearPtData;
|
---|
| 518 | frmConsults.ClearPtData;
|
---|
| 519 | frmDCSumm.ClearPtData;
|
---|
| 520 | if Assigned(frmSurgery) then frmSurgery.ClearPtData;
|
---|
| 521 | frmLabs.ClearPtData;
|
---|
| 522 | frmReports.ClearPtData;
|
---|
| 523 | tabPage.TabIndex := PageIDToTab(CT_NOPAGE); // to make sure DisplayPage gets called
|
---|
| 524 | tabPageChange(tabPage);
|
---|
| 525 | ClearReminderData;
|
---|
| 526 | SigItems.Clear;
|
---|
| 527 | lstCIRNLocations.Clear;
|
---|
| 528 | uRemoteType := '';
|
---|
| 529 | ClearFlag;
|
---|
| 530 | if Assigned(FlagList) then FlagList.Clear;
|
---|
| 531 | HasFlag := False;
|
---|
| 532 | HidePatientSelectMessages;
|
---|
| 533 | end;
|
---|
| 534 |
|
---|
| 535 | procedure TfrmFrame.DisplayEncounterText;
|
---|
| 536 | { updates the display in the header bar of encounter related information (location & provider) }
|
---|
| 537 | begin
|
---|
| 538 | with Encounter do
|
---|
| 539 | begin
|
---|
| 540 | if Length(LocationText) > 0
|
---|
| 541 | then lblPtLocation.Caption := LocationText
|
---|
| 542 | else lblPtLocation.Caption := 'Visit Not Selected';
|
---|
| 543 | if Length(ProviderName) > 0
|
---|
| 544 | then lblPtProvider.Caption := 'Provider: ' + ProviderName
|
---|
| 545 | else lblPtProvider.Caption := 'Current Provider Not Selected';
|
---|
| 546 | end;
|
---|
| 547 | pnlVisit.Caption := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
|
---|
| 548 | FitToolBar;
|
---|
| 549 | end;
|
---|
| 550 |
|
---|
| 551 | { Form Events (Create, Destroy) ----------------------------------------------------------- }
|
---|
| 552 |
|
---|
| 553 | procedure TfrmFrame.RefreshFixedStatusWidth;
|
---|
| 554 | begin
|
---|
| 555 | with stsArea do
|
---|
| 556 | FFixedStatusWidth := Panels[0].Width + Panels[2].Width + Panels[3].Width + Panels[4].Width;
|
---|
| 557 | end;
|
---|
| 558 |
|
---|
| 559 | procedure TfrmFrame.FormCreate(Sender: TObject);
|
---|
| 560 | { connect to server, create tab pages, select a patient, & initialize core objects }
|
---|
| 561 | var
|
---|
| 562 | ClientVer, ServerVer, ServerReq: string;
|
---|
| 563 | begin
|
---|
| 564 | FJustEnteredApp := false;
|
---|
| 565 | SizeHolder := TSizeHolder.Create;
|
---|
| 566 | Screen.OnActiveFormChange := ScreenActiveFormChange;
|
---|
| 567 | if not (ParamSearch('CCOW')='DISABLE') then
|
---|
| 568 | try
|
---|
| 569 | ctxContextor := TContextorControl.Create(Self);
|
---|
| 570 | with ctxContextor do
|
---|
| 571 | begin
|
---|
| 572 | OnPending := ctxContextorPending;
|
---|
| 573 | OnCommitted := ctxContextorCommitted;
|
---|
| 574 | OnCanceled := ctxContextorCanceled;
|
---|
| 575 | end;
|
---|
| 576 | FCCOWBusy := False;
|
---|
| 577 | FCCOWInstalled := True;
|
---|
| 578 | FCCOWDrivedChange := False;
|
---|
| 579 | except
|
---|
| 580 | FCCOWInstalled := False;
|
---|
| 581 | pnlCCOW.Visible := False;
|
---|
| 582 | mnuFileResumeContext.Visible := False;
|
---|
| 583 | mnuFileBreakContext.Visible := False;
|
---|
| 584 | end
|
---|
| 585 | else
|
---|
| 586 | begin
|
---|
| 587 | FCCOWInstalled := False;
|
---|
| 588 | pnlCCOW.Visible := False;
|
---|
| 589 | mnuFileResumeContext.Visible := False;
|
---|
| 590 | mnuFileBreakContext.Visible := False;
|
---|
| 591 | end;
|
---|
| 592 | RefreshFixedStatusWidth;
|
---|
| 593 | FTerminate := False;
|
---|
| 594 | AutoUpdateCheck;
|
---|
| 595 |
|
---|
| 596 | FFlagList := TStringList.Create;
|
---|
| 597 |
|
---|
| 598 | // setup initial timeout here so can timeout logon
|
---|
| 599 | FCreateProgress := FCP_SETHOOK;
|
---|
| 600 | InitTimeOut(TimeoutCondition, TimeOutAction);
|
---|
| 601 |
|
---|
| 602 | // connect to the server and create an option context
|
---|
| 603 | FCreateProgress := FCP_SERVER;
|
---|
| 604 |
|
---|
| 605 | if not ConnectToServer(TX_OPTION) then
|
---|
| 606 | begin
|
---|
| 607 | Close;
|
---|
| 608 | Exit;
|
---|
| 609 | end;
|
---|
| 610 |
|
---|
| 611 | FECSAuthUser := ValidECSUser;
|
---|
| 612 | uECSReport := TECSReport.Create;
|
---|
| 613 | uECSReport.ECSPermit := FECSAuthUser;
|
---|
| 614 | RPCBrokerV.CreateContext(TX_OPTION);
|
---|
| 615 | Application.OnException := AppException;
|
---|
| 616 | FOldActivate := Application.OnActivate;
|
---|
| 617 | Application.OnActivate := AppActivated;
|
---|
| 618 | Application.OnDeactivate := AppDeActivated;
|
---|
| 619 |
|
---|
| 620 | // create initial core objects
|
---|
| 621 | FCreateProgress := FCP_OBJECTS;
|
---|
| 622 | User := TUser.Create;
|
---|
| 623 |
|
---|
| 624 | // make sure we're using the matching server version
|
---|
| 625 | FCreateProgress := FCP_CHKVER;
|
---|
| 626 | ClientVer := ClientVersion(Application.ExeName);
|
---|
| 627 | ServerVer := ServerVersion(TX_OPTION, ClientVer);
|
---|
| 628 | if (ServerVer = '0.0.0.0') then
|
---|
| 629 | begin
|
---|
| 630 | InfoBox('Unable to determine current version of server.', TX_OPTION, MB_OK);
|
---|
| 631 | Close;
|
---|
| 632 | Exit;
|
---|
| 633 | end;
|
---|
| 634 | ServerReq := Piece(FileVersionValue(Application.ExeName, FILE_VER_INTERNALNAME), ' ', 1);
|
---|
| 635 | if (ClientVer <> ServerReq) then
|
---|
| 636 | begin
|
---|
| 637 | InfoBox('Client "version" does not match client "required" server.', TC_CLIERR, MB_OK);
|
---|
| 638 | Close;
|
---|
| 639 | Exit;
|
---|
| 640 | end;
|
---|
| 641 | if (CompareVersion(ServerVer, ServerReq) <> 0) then
|
---|
| 642 | begin
|
---|
| 643 | if (sCallV('ORWU DEFAULT DIVISION', [nil]) = '1') then
|
---|
| 644 | begin
|
---|
| 645 | if (InfoBox('Proceed with mismatched Client and Server versions?', TC_CLIERR, MB_YESNO) = ID_NO) then
|
---|
| 646 | begin
|
---|
| 647 | Close;
|
---|
| 648 | Exit;
|
---|
| 649 | end;
|
---|
| 650 | end
|
---|
| 651 | else
|
---|
| 652 | begin
|
---|
| 653 | if (CompareVersion(ServerVer, ServerReq) > 0) then // Server newer than Required
|
---|
| 654 | begin
|
---|
| 655 | // NEXT LINE COMMENTED OUT - CHANGED FOR VERSION 19.16, PATCH OR*3*155:
|
---|
| 656 | // if GetUserParam('ORWOR REQUIRE CURRENT CLIENT') = '1' then
|
---|
| 657 | if (true) then // "True" statement guarantees "required" current version client.
|
---|
| 658 | begin
|
---|
| 659 | InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD2, TC_VER, MB_OK);
|
---|
| 660 | Close;
|
---|
| 661 | Exit;
|
---|
| 662 | end;
|
---|
| 663 | end
|
---|
| 664 | else InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD, TC_VER, MB_OK);
|
---|
| 665 | end;
|
---|
| 666 | if (CompareVersion(ServerVer, ServerReq) < 0) then // Server older then Required
|
---|
| 667 | begin
|
---|
| 668 | InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_NEW, TC_VER, MB_OK);
|
---|
| 669 | Close;
|
---|
| 670 | Exit;
|
---|
| 671 | end;
|
---|
| 672 | end;
|
---|
| 673 |
|
---|
| 674 | // Add future tabs here as they are created/implemented:
|
---|
| 675 | if (
|
---|
| 676 | (not User.HasCorTabs) and
|
---|
| 677 | (not User.HasRptTab)
|
---|
| 678 | )
|
---|
| 679 | then
|
---|
| 680 | begin
|
---|
| 681 | InfoBox('No valid tabs assigned', 'Tab Access Problem', MB_OK);
|
---|
| 682 | Close;
|
---|
| 683 | Exit;
|
---|
| 684 | end;
|
---|
| 685 |
|
---|
| 686 | // create creating core objects
|
---|
| 687 | Patient := TPatient.Create;
|
---|
| 688 | Encounter := TEncounter.Create;
|
---|
| 689 | Changes := TChanges.Create;
|
---|
| 690 | Notifications := TNotifications.Create;
|
---|
| 691 | RemoteSites := TRemoteSiteList.Create;
|
---|
| 692 | RemoteReports := TRemoteReportList.Create;
|
---|
| 693 | uTabList := TStringList.Create;
|
---|
| 694 | FlaggedPTList := TStringList.Create;
|
---|
| 695 | HasFlag := False;
|
---|
| 696 | FlagList := TStringList.Create;
|
---|
| 697 | FPrevPtID := '';
|
---|
| 698 | // set up structures specific to the user
|
---|
| 699 | Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')';
|
---|
| 700 | SetDebugMenu;
|
---|
| 701 | if InteractiveRemindersActive then
|
---|
| 702 | NotifyWhenRemindersChange(RemindersChanged);
|
---|
| 703 | // load all the tab pages
|
---|
| 704 | FCreateProgress := FCP_FORMS;
|
---|
| 705 | //CreateTab(TObject(frmProblems), TfrmProblems, CT_PROBLEMS, 'Problems');
|
---|
| 706 | CreateTab(CT_PROBLEMS, 'Problems');
|
---|
| 707 | CreateTab(CT_MEDS, 'Meds');
|
---|
| 708 | CreateTab(CT_ORDERS, 'Orders');
|
---|
| 709 | CreateTab(CT_NOTES, 'Notes');
|
---|
| 710 | CreateTab(CT_CONSULTS, 'Consults');
|
---|
| 711 | if ShowSurgeryTab then CreateTab(CT_SURGERY, 'Surgery');
|
---|
| 712 | CreateTab(CT_DCSUMM, 'D/C Summ');
|
---|
| 713 | CreateTab(CT_LABS, 'Labs');
|
---|
| 714 | CreateTab(CT_REPORTS, 'Reports');
|
---|
| 715 | CreateTab(CT_COVER, 'Cover Sheet');
|
---|
| 716 | ShowHideChartTabMenus(mnuViewChart);
|
---|
| 717 | // We defer calling LoadUserPreferences to UMInitiate, so that the font sizing
|
---|
| 718 | // routines recognize this as the application's main form (this hasn't been
|
---|
| 719 | // set yet).
|
---|
| 720 | FNextButtonBitmap := TBitmap.Create;
|
---|
| 721 | FNextButtonBitmap.LoadFromResourceName(hInstance, 'BMP_HANDRIGHT');
|
---|
| 722 | // set the timeout to DTIME now that there is a connection
|
---|
| 723 | UpdateTimeOutInterval(User.DTIME * 1000); // DTIME * 1000 mSec
|
---|
| 724 | // get a patient
|
---|
| 725 | HandleNeeded; // make sure handle is there for ORWPT SHARE call
|
---|
| 726 | FCreateProgress := FCP_PTSEL;
|
---|
| 727 | Enabled := False;
|
---|
| 728 | FFirstLoad := True; // First time to initialize the fFrame
|
---|
| 729 | FCreateProgress := FCP_FINISH;
|
---|
| 730 | pnlReminders.Visible := InteractiveRemindersActive;
|
---|
| 731 | uRemoteType := '';
|
---|
| 732 | SetUserTools;
|
---|
| 733 | EnduringPtSelSplitterPos := 0;
|
---|
| 734 | if User.IsReportsOnly then // Reports Only tab.
|
---|
| 735 | ReportsOnlyDisplay; // Calls procedure to hide all components/menus not needed.
|
---|
| 736 | InitialOrderVariables;
|
---|
| 737 | PostMessage(Handle, UM_INITIATE, 0, 0); // select patient after main form is created
|
---|
| 738 |
|
---|
| 739 | // mnuFileOpenClick(Self);
|
---|
| 740 | // if Patient.DFN = '' then //*DFN*
|
---|
| 741 | // begin
|
---|
| 742 | // Close;
|
---|
| 743 | // Exit;
|
---|
| 744 | // end;
|
---|
| 745 | // if WindowState = wsMinimized then WindowState := wsNormal;
|
---|
| 746 | end;
|
---|
| 747 |
|
---|
| 748 | procedure TfrmFrame.UMInitiate(var Message: TMessage);
|
---|
| 749 | begin
|
---|
| 750 | NotifyOtherApps(NAE_OPEN, IntToStr(User.DUZ));
|
---|
| 751 |
|
---|
| 752 | if FCCOWInstalled then // Please see me re: changes here - Thanks - RV.
|
---|
| 753 | try
|
---|
| 754 | // To re-enable the multiple instance functionality, remove the '#' from the following line
|
---|
| 755 | ctxContextor.Run('CPRSChart', '', TRUE, '*');
|
---|
| 756 |
|
---|
| 757 | // Uncomment the following line to run in secure binding mode, once the vault is configured to do so.
|
---|
| 758 | // Also comment out the 'ctxContextor.Run' line above.
|
---|
| 759 | //ctxContextor.Run('CPRSChart', PASSCODE, TRUE, '*');
|
---|
| 760 | except
|
---|
| 761 | on exc : EOleException do
|
---|
| 762 | begin
|
---|
| 763 | try
|
---|
| 764 | // Uncomment the following line to run in secure binding mode, once the vault is configured to do so.
|
---|
| 765 | ctxContextor.Run('CPRSChart' + '#', '', TRUE, '*');
|
---|
| 766 | //ctxContextor.Run('CPRSChart' + '#', PASSCODE, TRUE, '*');
|
---|
| 767 |
|
---|
| 768 | if ParamSearch('CCOW') = 'FORCE' then
|
---|
| 769 | begin
|
---|
| 770 | mnuFileResumeContext.Enabled := False;
|
---|
| 771 | mnuFileBreakContext.Visible := True;
|
---|
| 772 | mnuFileBreakContext.Enabled := True;
|
---|
| 773 | end
|
---|
| 774 | else
|
---|
| 775 | begin
|
---|
| 776 | ctxContextor.Suspend;
|
---|
| 777 | mnuFileResumeContext.Visible := True;
|
---|
| 778 | mnuFileBreakContext.Visible := True;
|
---|
| 779 | mnuFileBreakContext.Enabled := False;
|
---|
| 780 | end;
|
---|
| 781 | except
|
---|
| 782 | on exc : EOleException do
|
---|
| 783 | begin
|
---|
| 784 | FCCOWInstalled := False;
|
---|
| 785 | pnlCCOW.Visible := False;
|
---|
| 786 | mnuFileResumeContext.Visible := False;
|
---|
| 787 | mnuFileBreakContext.Visible := False;
|
---|
| 788 | end;
|
---|
| 789 | end;
|
---|
| 790 | end; // on exc
|
---|
| 791 | end; // try/except
|
---|
| 792 |
|
---|
| 793 | LoadUserPreferences;
|
---|
| 794 | GetBAStatus(User.DUZ,Encounter.Location);
|
---|
| 795 | mnuFileOpenClick(Self);
|
---|
| 796 | Enabled := True;
|
---|
| 797 | // If TimedOut, Close has already been called.
|
---|
| 798 | if not TimedOut and (Patient.DFN = '') then Close;
|
---|
| 799 | end;
|
---|
| 800 |
|
---|
| 801 | procedure TfrmFrame.FormDestroy(Sender: TObject);
|
---|
| 802 | { free core objects used by CPRS }
|
---|
| 803 | begin
|
---|
| 804 | Application.OnActivate := FOldActivate;
|
---|
| 805 | FNextButtonBitmap.Free;
|
---|
| 806 | uTabList.Free;
|
---|
| 807 | FlaggedPTList.Free;
|
---|
| 808 | RemoteSites.Free;
|
---|
| 809 | RemoteReports.Free;
|
---|
| 810 | Notifications.Free;
|
---|
| 811 | Changes.Free;
|
---|
| 812 | Encounter.Free;
|
---|
| 813 | Patient.Free;
|
---|
| 814 | User.Free;
|
---|
| 815 | SizeHolder.Free;
|
---|
| 816 | end;
|
---|
| 817 |
|
---|
| 818 | procedure TfrmFrame.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
---|
| 819 | { cancels close if the user cancels the ReviewChanges screen }
|
---|
| 820 | var
|
---|
| 821 | Reason: string;
|
---|
| 822 | begin
|
---|
| 823 | if (FCreateProgress < FCP_FINISH) then Exit;
|
---|
| 824 | if User.IsReportsOnly then // Reports Only tab.
|
---|
| 825 | exit;
|
---|
| 826 | if TimedOut then
|
---|
| 827 | begin
|
---|
| 828 | if Changes.RequireReview then ReviewChanges(TimedOut);
|
---|
| 829 | Exit;
|
---|
| 830 | end;
|
---|
| 831 | if not AllowContextChangeAll(Reason) then CanClose := False;
|
---|
| 832 | end;
|
---|
| 833 |
|
---|
| 834 | procedure TfrmFrame.SetUserTools;
|
---|
| 835 | const
|
---|
| 836 | TX_M_NOT_CONFIG = 'Tools/Options menu on M side not configured properly -'+
|
---|
| 837 | ' please notify your IRM support immediately';
|
---|
| 838 | TC_M_NOT_CONFIG = 'Warning: Check Tools/Options Menu in M';
|
---|
| 839 | var
|
---|
| 840 | ToolItems: TToolItemList;
|
---|
| 841 | i: Integer;
|
---|
| 842 | UserTool: TMenuItem;
|
---|
| 843 | MaxedOut: boolean;
|
---|
| 844 | // OptionsClick: TNotifyEvent;
|
---|
| 845 | begin
|
---|
| 846 | if User.IsReportsOnly then // Reports Only tab.
|
---|
| 847 | begin
|
---|
| 848 | mnuTools.Clear; // Remove all current items.
|
---|
| 849 | UserTool := TMenuItem.Create(Self);
|
---|
| 850 | UserTool.Caption := 'Options...';
|
---|
| 851 | UserTool.Hint := 'Options';
|
---|
| 852 | UserTool.OnClick := mnuToolsOptionsClick;
|
---|
| 853 | mnuTools.Add(UserTool); // Add back the "Options" menu.
|
---|
| 854 | exit;
|
---|
| 855 | end;
|
---|
| 856 | if User.GECStatus then
|
---|
| 857 | begin
|
---|
| 858 | UserTool := TMenuItem.Create(self);
|
---|
| 859 | UserTool.Caption := 'GEC Referral Status Display';
|
---|
| 860 | UserTool.Hint := 'GEC Referral Status Display';
|
---|
| 861 | UserTool.OnClick := mnuGECStatusClick;
|
---|
| 862 | mnuTools.Add(UserTool); // Add back the "Options" menu.
|
---|
| 863 | //exit;
|
---|
| 864 | end;
|
---|
| 865 | GetToolMenu(ToolItems, MaxedOut); // For all other users, proceed normally with creation of Tools menu:
|
---|
| 866 | for i := Low(ToolItems) to High(ToolItems) do
|
---|
| 867 | begin
|
---|
| 868 | if (AnsiCompareText(ToolItems[i].Caption, 'Event Capture Interface') = 0 ) and
|
---|
| 869 | (not uECSReport.ECSPermit) then
|
---|
| 870 | begin
|
---|
| 871 | ToolItems[i].Caption := '';
|
---|
| 872 | ToolItems[i].Action := '';
|
---|
| 873 | Break;
|
---|
| 874 | end;
|
---|
| 875 | end;
|
---|
| 876 | if MaxedOut then
|
---|
| 877 | begin
|
---|
| 878 | uToolsMaxed := True;
|
---|
| 879 | uToolsWarned := False;
|
---|
| 880 | end;
|
---|
| 881 | for i := 0 to MAX_TOOLITEMS do with ToolItems[i] do if Length(Caption) > 0 then
|
---|
| 882 | begin
|
---|
| 883 | UserTool := TMenuItem.Create(Self);
|
---|
| 884 | UserTool.Caption := Caption;
|
---|
| 885 | UserTool.Hint := Action;
|
---|
| 886 | UserTool.OnClick := ToolClick;
|
---|
| 887 | if i < mnuTools.Count then
|
---|
| 888 | mnuTools.Insert(i, UserTool)
|
---|
| 889 | else
|
---|
| 890 | begin
|
---|
| 891 | mnuTools.Add(UserTool);
|
---|
| 892 | InfoBox(TX_M_NOT_CONFIG, TC_M_NOT_CONFIG, MB_ICONWARNING or MB_OK)
|
---|
| 893 | end;
|
---|
| 894 | end;
|
---|
| 895 | end;
|
---|
| 896 |
|
---|
| 897 | procedure TfrmFrame.mnuToolsClick(Sender: TObject);
|
---|
| 898 | const
|
---|
| 899 | TX_TOO_MANY_TOOLS = 'Some defined items may not be shown';
|
---|
| 900 | TC_TOO_MANY_TOOLS = 'Tool Menu Limit Exceeded';
|
---|
| 901 | begin
|
---|
| 902 | if uToolsMaxed and (not uToolsWarned) then
|
---|
| 903 | begin
|
---|
| 904 | InfoBox(TX_TOO_MANY_TOOLS, TC_TOO_MANY_TOOLS, MB_ICONWARNING or MB_OK);
|
---|
| 905 | uToolsWarned := True;
|
---|
| 906 | end;
|
---|
| 907 | end;
|
---|
| 908 |
|
---|
| 909 | procedure TfrmFrame.UpdateECSParameter(var CmdParameter: string); //ECS
|
---|
| 910 | var
|
---|
| 911 | vstID,AccVer,Svr,SvrPort,VUser: string;
|
---|
| 912 | begin
|
---|
| 913 | AccVer := '';
|
---|
| 914 | Svr := '';
|
---|
| 915 | SvrPort := '';
|
---|
| 916 | VUser := '';
|
---|
| 917 | if RPCBrokerV <> nil then
|
---|
| 918 | begin
|
---|
| 919 | AccVer := RPCBrokerV.AccessVerifyCodes;
|
---|
| 920 | Svr := RPCBrokerV.Server;
|
---|
| 921 | SvrPort := IntToStr(RPCBrokerV.ListenerPort);
|
---|
| 922 | VUser := RPCBrokerV.User.DUZ;
|
---|
| 923 | end;
|
---|
| 924 | vstID := GetVisitID;
|
---|
| 925 | CmdParameter :=' Svr=' +Svr
|
---|
| 926 | +' SvrPort='+SvrPort
|
---|
| 927 | +' VUser='+ VUser
|
---|
| 928 | +' PtIEN='+ Patient.DFN
|
---|
| 929 | +' PdIEN='+IntToStr(Encounter.Provider)
|
---|
| 930 | +' vstIEN='+vstID
|
---|
| 931 | +' locIEN='+IntToStr(Encounter.Location)
|
---|
| 932 | +' Date=0'
|
---|
| 933 | +' Division='+GetDivisionID;
|
---|
| 934 |
|
---|
| 935 | end;
|
---|
| 936 |
|
---|
| 937 | function TfrmFrame.ValidECSUser: boolean; //ECS
|
---|
| 938 | var
|
---|
| 939 | isTrue: boolean;
|
---|
| 940 | begin
|
---|
| 941 | Result := True;
|
---|
| 942 | with RPCBrokerV do
|
---|
| 943 | begin
|
---|
| 944 | ShowErrorMsgs := semQuiet;
|
---|
| 945 | Connected := True;
|
---|
| 946 | try
|
---|
| 947 | isTrue := CreateContext(TX_ECSOPT);
|
---|
| 948 | if not isTrue then
|
---|
| 949 | Result := False;
|
---|
| 950 | ShowErrorMsgs := semRaise;
|
---|
| 951 | except
|
---|
| 952 | on E: Exception do
|
---|
| 953 | begin
|
---|
| 954 | ShowErrorMsgs := semRaise;
|
---|
| 955 | Result := False;
|
---|
| 956 | end;
|
---|
| 957 | end;
|
---|
| 958 | end;
|
---|
| 959 | end;
|
---|
| 960 |
|
---|
| 961 | procedure TfrmFrame.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 962 | //var
|
---|
| 963 | // i: Integer;
|
---|
| 964 | // UserTool: TMenuItem;
|
---|
| 965 | begin
|
---|
| 966 | FClosing := TRUE;
|
---|
| 967 | if FCreateProgress < FCP_FINISH then FTerminate := True;
|
---|
| 968 |
|
---|
| 969 | FlushNotifierBuffer;
|
---|
| 970 | if FCreateProgress = FCP_FINISH then NotifyOtherApps(NAE_CLOSE, '');
|
---|
| 971 | TerminateOtherAppNotification;
|
---|
| 972 |
|
---|
| 973 | // unhook the timeout hooks
|
---|
| 974 | ShutDownTimeOut;
|
---|
| 975 | // clearing changes will unlock notes
|
---|
| 976 | if FCreateProgress = FCP_FINISH then Changes.Clear;
|
---|
| 977 | // clear server side flag global tmp
|
---|
| 978 | ClearFlag;
|
---|
| 979 | // save user preferences
|
---|
| 980 | if FCreateProgress = FCP_FINISH then SaveUserPreferences;
|
---|
| 981 | // call close for each page in case there is any special processing
|
---|
| 982 | if FCreateProgress > FCP_FORMS then
|
---|
| 983 | begin
|
---|
| 984 | mnuFrame.Merge(nil);
|
---|
| 985 | frmCover.Close; //frmCover.Release;
|
---|
| 986 | frmProblems.Close; //frmProblems.Release;
|
---|
| 987 | frmMeds.Close; //frmMeds.Release;
|
---|
| 988 | frmOrders.Close; //frmOrders.Release;
|
---|
| 989 | frmNotes.Close; //frmNotes.Release;
|
---|
| 990 | frmConsults.Close; //frmConsults.Release;
|
---|
| 991 | frmDCSumm.Close; //frmDCSumm.Release;
|
---|
| 992 | if Assigned(frmSurgery) then frmSurgery.Close; //frmSurgery.Release;
|
---|
| 993 | frmLabs.Close; //frmLabs.Release;
|
---|
| 994 | frmReports.Close; //frmReports.Release;
|
---|
| 995 | end;
|
---|
| 996 | // with mnuTools do for i := Count - 1 downto 0 do
|
---|
| 997 | // begin
|
---|
| 998 | // UserTool := Items[i];
|
---|
| 999 | // if UserTool <> nil then
|
---|
| 1000 | // begin
|
---|
| 1001 | // Delete(i);
|
---|
| 1002 | // UserTool.Free;
|
---|
| 1003 | // end;
|
---|
| 1004 | // end;
|
---|
| 1005 | //Application.ProcessMessages; // so everything finishes closing
|
---|
| 1006 | // if < FCP_FINISH we came here from inside FormCreate, so need to call terminate
|
---|
| 1007 | if FCreateProgress < FCP_FINISH then Application.Terminate;
|
---|
| 1008 | end;
|
---|
| 1009 |
|
---|
| 1010 | procedure TfrmFrame.SetDebugMenu;
|
---|
| 1011 | var
|
---|
| 1012 | IsProgrammer: Boolean;
|
---|
| 1013 | begin
|
---|
| 1014 | IsProgrammer := User.HasKey('XUPROGMODE');
|
---|
| 1015 | mnuHelpBroker.Visible := IsProgrammer;
|
---|
| 1016 | mnuHelpLists.Visible := IsProgrammer;
|
---|
| 1017 | mnuHelpSymbols.Visible := IsProgrammer;
|
---|
| 1018 | Z6.Visible := IsProgrammer;
|
---|
| 1019 | end;
|
---|
| 1020 |
|
---|
| 1021 | { Updates posted to MainForm --------------------------------------------------------------- }
|
---|
| 1022 |
|
---|
| 1023 | procedure TfrmFrame.UMNewOrder(var Message: TMessage);
|
---|
| 1024 | { post a notice of change in orders to all TPages, wParam=OrderAction, lParam=TOrder }
|
---|
| 1025 | var
|
---|
| 1026 | OrderAct: string;
|
---|
| 1027 | begin
|
---|
| 1028 | with Message do
|
---|
| 1029 | begin
|
---|
| 1030 | frmCover.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1031 | frmProblems.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1032 | frmMeds.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1033 | frmOrders.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1034 | frmNotes.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1035 | frmConsults.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1036 | frmDCSumm.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1037 | if Assigned(frmSurgery) then frmSurgery.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1038 | frmLabs.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1039 | frmReports.NotifyOrder(WParam, TOrder(LParam));
|
---|
| 1040 | lblPtCWAD.Caption := GetCWADInfo(Patient.DFN);
|
---|
| 1041 | if Length(lblPtCWAD.Caption) > 0
|
---|
| 1042 | then lblPtPostings.Caption := 'Postings'
|
---|
| 1043 | else lblPtPostings.Caption := 'No Postings';
|
---|
| 1044 | pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
|
---|
| 1045 | OrderAct := '';
|
---|
| 1046 | case WParam of
|
---|
| 1047 | ORDER_NEW: OrderAct := 'NW';
|
---|
| 1048 | ORDER_DC: OrderAct := 'DC';
|
---|
| 1049 | ORDER_RENEW: OrderAct := 'RN';
|
---|
| 1050 | ORDER_HOLD: OrderAct := 'HD';
|
---|
| 1051 | ORDER_EDIT: OrderAct := 'XX';
|
---|
| 1052 | ORDER_ACT: OrderAct := 'AC';
|
---|
| 1053 | end;
|
---|
| 1054 | if Length(OrderAct) > 0 then NotifyOtherApps(NAE_ORDER, OrderAct + U + TOrder(LParam).ID); // add FillerID
|
---|
| 1055 | end;
|
---|
| 1056 | end;
|
---|
| 1057 |
|
---|
| 1058 | { Tab Selection (navigate between pages) --------------------------------------------------- }
|
---|
| 1059 |
|
---|
| 1060 | procedure TfrmFrame.WMSetFocus(var Message: TMessage);
|
---|
| 1061 | begin
|
---|
| 1062 | if (FLastPage <> nil) and (not TimedOut) and
|
---|
| 1063 | (not (csDestroying in FLastPage.ComponentState)) and FLastPage.Visible
|
---|
| 1064 | then FLastPage.FocusFirstControl;
|
---|
| 1065 | end;
|
---|
| 1066 |
|
---|
| 1067 | procedure TfrmFrame.UMShowPage(var Message: TMessage);
|
---|
| 1068 | { shows a page when the UM_SHOWPAGE message is received }
|
---|
| 1069 | begin
|
---|
| 1070 | if FCCOWDrivedChange then FCCOWDrivedChange := False;
|
---|
| 1071 | if FLastPage <> nil then FLastPage.DisplayPage;
|
---|
| 1072 | FChangeSource := CC_CLICK; // reset to click so we're only dealing with exceptions to click
|
---|
| 1073 | if assigned(FTabChanged) then
|
---|
| 1074 | FTabChanged(Self);
|
---|
| 1075 | end;
|
---|
| 1076 |
|
---|
| 1077 | procedure TfrmFrame.SwitchToPage(NewForm: TfrmPage);
|
---|
| 1078 | { unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code }
|
---|
| 1079 | begin
|
---|
| 1080 | if FLastPage = NewForm then
|
---|
| 1081 | begin
|
---|
| 1082 | if Notifications.Active then PostMessage(Handle, UM_SHOWPAGE, 0, 0);
|
---|
| 1083 | Exit;
|
---|
| 1084 | end;
|
---|
| 1085 | if (FLastPage <> nil) then
|
---|
| 1086 | begin
|
---|
| 1087 | mnuFrame.Unmerge(FLastPage.Menu);
|
---|
| 1088 | FLastPage.Hide;
|
---|
| 1089 | end;
|
---|
| 1090 | if Assigned(NewForm) then
|
---|
| 1091 | begin
|
---|
| 1092 | {if ((FLastPage = frmOrders) and (NewForm.Name <> frmMeds.Name))
|
---|
| 1093 | or ((FLastPage = frmMeds) and (NewForm.Name <> frmOrders.Name)) then
|
---|
| 1094 | begin
|
---|
| 1095 | if not CloseOrdering then
|
---|
| 1096 | Exit;
|
---|
| 1097 | end;}
|
---|
| 1098 | mnuFrame.Merge(NewForm.Menu);
|
---|
| 1099 | NewForm.Show;
|
---|
| 1100 | end;
|
---|
| 1101 | lstCIRNLocations.Visible := False;
|
---|
| 1102 | pnlCIRN.BevelOuter := bvRaised;
|
---|
| 1103 | lstCIRNLocations.SendToBack;
|
---|
| 1104 | mnuFilePrint.Enabled := False; // let individual page enable this
|
---|
| 1105 | mnuFilePrintSetup.Enabled := False; // let individual page enable this
|
---|
| 1106 | mnuFilePrintSelectedItems.Enabled := False;
|
---|
| 1107 | FLastPage := NewForm;
|
---|
| 1108 | if NewForm <> nil then
|
---|
| 1109 | begin
|
---|
| 1110 | if NewForm.Name = frmNotes.Name then frmNotes.Align := alClient
|
---|
| 1111 | else frmNotes.Align := alNone;
|
---|
| 1112 | if NewForm.Name = frmConsults.Name then frmConsults.Align := alClient
|
---|
| 1113 | else frmConsults.Align := alNone;
|
---|
| 1114 | if NewForm.Name = frmDCSumm.Name then frmDCSumm.Align := alClient
|
---|
| 1115 | else frmDCSumm.Align := alNone;
|
---|
| 1116 | if Assigned(frmSurgery) then
|
---|
| 1117 | if NewForm.Name = frmSurgery.Name then frmSurgery.Align := alclient
|
---|
| 1118 | else frmSurgery.Align := alNone;
|
---|
| 1119 | NewForm.BringToFront; // to cause tab switch to happen immediately
|
---|
| 1120 | NewForm.FocusFirstControl;
|
---|
| 1121 | Application.ProcessMessages;
|
---|
| 1122 | PostMessage(Handle, UM_SHOWPAGE, 0, 0); // this calls DisplayPage for the form
|
---|
| 1123 | end;
|
---|
| 1124 | end;
|
---|
| 1125 |
|
---|
| 1126 | procedure TfrmFrame.mnuChartTabClick(Sender: TObject);
|
---|
| 1127 | { use the Tag property of the menu item to switch to proper page }
|
---|
| 1128 | begin
|
---|
| 1129 | with Sender as TMenuItem do tabPage.TabIndex := PageIDToTab(Tag);
|
---|
| 1130 | LastTab := TabToPageID(tabPage.TabIndex) ;
|
---|
| 1131 | tabPageChange(tabPage);
|
---|
| 1132 | end;
|
---|
| 1133 |
|
---|
| 1134 | procedure TfrmFrame.tabPageChange(Sender: TObject);
|
---|
| 1135 | { switches to form linked to NewTab }
|
---|
| 1136 | begin
|
---|
| 1137 |
|
---|
| 1138 | if (not User.IsReportsOnly) then
|
---|
| 1139 | begin
|
---|
| 1140 | case TabToPageID((sender as TTabControl).TabIndex) of
|
---|
| 1141 | CT_NOPAGE: SwitchToPage(nil);
|
---|
| 1142 | CT_COVER: SwitchToPage(frmCover);
|
---|
| 1143 | CT_PROBLEMS: SwitchToPage(frmProblems);
|
---|
| 1144 | CT_MEDS: SwitchToPage(frmMeds);
|
---|
| 1145 | CT_ORDERS: SwitchToPage(frmOrders);
|
---|
| 1146 | CT_NOTES: SwitchToPage(frmNotes);
|
---|
| 1147 | CT_CONSULTS: SwitchToPage(frmConsults);
|
---|
| 1148 | CT_DCSUMM: SwitchToPage(frmDCSumm);
|
---|
| 1149 | CT_SURGERY: SwitchToPage(frmSurgery);
|
---|
| 1150 | CT_LABS: SwitchToPage(frmLabs);
|
---|
| 1151 | CT_REPORTS: SwitchToPage(frmReports);
|
---|
| 1152 | end; {case}
|
---|
| 1153 | end
|
---|
| 1154 | else // Reports Only tab.
|
---|
| 1155 | SwitchToPage(frmReports);
|
---|
| 1156 |
|
---|
| 1157 | end;
|
---|
| 1158 |
|
---|
| 1159 | function TfrmFrame.PageIDToTab(PageID: Integer): Integer;
|
---|
| 1160 | { returns the tab index that corresponds to a given PageID }
|
---|
| 1161 | VAR
|
---|
| 1162 | i: integer;
|
---|
| 1163 | begin
|
---|
| 1164 | i := uTabList.IndexOf(IntToStr(PageID));
|
---|
| 1165 | Result := i;
|
---|
| 1166 | //Result := uTabList.IndexOf(IntToStr(PageID));
|
---|
| 1167 | (*
|
---|
| 1168 | Result := -1;
|
---|
| 1169 | case PageID of
|
---|
| 1170 | CT_NOPAGE: Result := -1;
|
---|
| 1171 | CT_COVER: Result := 0;
|
---|
| 1172 | CT_PROBLEMS: Result := 1;
|
---|
| 1173 | CT_MEDS: Result := 2;
|
---|
| 1174 | CT_ORDERS: Result := 3;
|
---|
| 1175 | {CT_HP: Result := 4;}
|
---|
| 1176 | CT_NOTES: Result := 4;
|
---|
| 1177 | CT_CONSULTS: Result := 5;
|
---|
| 1178 | CT_DCSUMM: Result := 6;
|
---|
| 1179 | CT_LABS: Result := 7;
|
---|
| 1180 | CT_REPORTS: Result := 8;
|
---|
| 1181 | end;*)
|
---|
| 1182 | end;
|
---|
| 1183 |
|
---|
| 1184 | function TfrmFrame.TabToPageID(Tab: Integer): Integer;
|
---|
| 1185 | { returns the constant that identifies the page given a TabIndex }
|
---|
| 1186 | begin
|
---|
| 1187 | if (Tab > -1) and (Tab < uTabList.Count) then
|
---|
| 1188 | Result := StrToIntDef(uTabList[Tab], CT_UNKNOWN)
|
---|
| 1189 | else
|
---|
| 1190 | Result := CT_NOPAGE;
|
---|
| 1191 | (* case Tab of
|
---|
| 1192 | -1: Result := CT_NOPAGE;
|
---|
| 1193 | 0: Result := CT_COVER;
|
---|
| 1194 | 1: Result := CT_PROBLEMS;
|
---|
| 1195 | 2: Result := CT_MEDS;
|
---|
| 1196 | 3: Result := CT_ORDERS;
|
---|
| 1197 | {4: Result := CT_HP;}
|
---|
| 1198 | 4: Result := CT_NOTES;
|
---|
| 1199 | 5: Result := CT_CONSULTS;
|
---|
| 1200 | 6: Result := CT_DCSUMM;
|
---|
| 1201 | 7: Result := CT_LABS;
|
---|
| 1202 | 8: Result := CT_REPORTS;
|
---|
| 1203 | end;*)
|
---|
| 1204 | end;
|
---|
| 1205 |
|
---|
| 1206 | { File Menu Events ------------------------------------------------------------------------- }
|
---|
| 1207 |
|
---|
| 1208 | procedure TfrmFrame.SetupPatient(AFlaggedList : TStringList);
|
---|
| 1209 | var
|
---|
| 1210 | AMsg, SelectMsg: string;
|
---|
| 1211 | begin
|
---|
| 1212 | with Patient do
|
---|
| 1213 | begin
|
---|
| 1214 | ClearPatient; // must be called to avoid leaving previous patient's information visible!
|
---|
| 1215 | Visible := True;
|
---|
| 1216 | Application.ProcessMessages;
|
---|
| 1217 | lblPtName.Caption := Name;
|
---|
| 1218 | lblPtSSN.Caption := SSN;
|
---|
| 1219 | lblPtAge.Caption := FormatFMDateTime('mmm dd,yyyy', DOB) + ' (' + IntToStr(Age) + ')';
|
---|
| 1220 | pnlPatient.Caption := lblPtName.Caption + ' ' + lblPtSSN.Caption + ' ' + lblPtAge.Caption;
|
---|
| 1221 | if Length(CWAD) > 0
|
---|
| 1222 | then lblPtPostings.Caption := 'Postings'
|
---|
| 1223 | else lblPtPostings.Caption := 'No Postings';
|
---|
| 1224 | lblPtCWAD.Caption := CWAD;
|
---|
| 1225 | pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
|
---|
| 1226 | if (Length(PrimaryTeam) > 0) or (Length(PrimaryProvider) > 0)
|
---|
| 1227 | then lblPtCare.Caption := PrimaryTeam + ' / ' + MixedCase(PrimaryProvider);
|
---|
| 1228 | if Length(Attending) > 0 then lblPtAttending.Caption := 'Attending: ' + MixedCase(Attending);
|
---|
| 1229 | pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption;
|
---|
| 1230 | SetUpCIRN;
|
---|
| 1231 | DisplayEncounterText;
|
---|
| 1232 | SetShareNode(DFN, Handle);
|
---|
| 1233 | with Patient do
|
---|
| 1234 | NotifyOtherApps(NAE_NEWPT, SSN + U + FloatToStr(DOB) + U + Name);
|
---|
| 1235 | SelectMsg := '';
|
---|
| 1236 | if (not FRefreshing) then
|
---|
| 1237 | begin
|
---|
| 1238 | if not Assigned(AFlaggedList) then ShowFlags
|
---|
| 1239 | else if (AFlaggedList.IndexOf(Patient.DFN) < 0) then ShowFlags;
|
---|
| 1240 | end;
|
---|
| 1241 | if MeansTestRequired(Patient.DFN, AMsg) then SelectMsg := AMsg;
|
---|
| 1242 | if HasLegacyData(Patient.DFN, AMsg) then SelectMsg := SelectMsg + CRLF + AMsg;
|
---|
| 1243 | HasActiveFlg(FlagList, HasFlag, Patient.DFN);
|
---|
| 1244 | if FPrevPtID <> patient.DFN then
|
---|
| 1245 | begin
|
---|
| 1246 | if HasFlag then
|
---|
| 1247 | begin
|
---|
| 1248 | pnlFlag.Enabled := True;
|
---|
| 1249 | lblFlag.Font.Color := clMaroon;
|
---|
| 1250 | lblFlag.Enabled := True;
|
---|
| 1251 | if not FReFreshing then
|
---|
| 1252 | ShowFlags;
|
---|
| 1253 | end else
|
---|
| 1254 | begin
|
---|
| 1255 | pnlFlag.Enabled := False;
|
---|
| 1256 | lblFlag.Font.Color := clBtnFace;
|
---|
| 1257 | lblFlag.Enabled := False;
|
---|
| 1258 | end;
|
---|
| 1259 | FPrevPtID := patient.DFN;
|
---|
| 1260 | end;
|
---|
| 1261 |
|
---|
| 1262 | ProcessPatientChangeEventHook;
|
---|
| 1263 | if Length(SelectMsg) > 0 then ShowPatientSelectMessages(SelectMsg);
|
---|
| 1264 | end;
|
---|
| 1265 | end;
|
---|
| 1266 |
|
---|
| 1267 | procedure TfrmFrame.mnuFileNextClick(Sender: TObject);
|
---|
| 1268 | var
|
---|
| 1269 | SaveDFN, NewDFN: string; // *DFN*
|
---|
| 1270 | NextIndex: Integer;
|
---|
| 1271 | Reason: string;
|
---|
| 1272 | begin
|
---|
| 1273 | SaveDFN := Patient.DFN;
|
---|
| 1274 | Notifications.Next;
|
---|
| 1275 | if Notifications.Active then
|
---|
| 1276 | begin
|
---|
| 1277 | NewDFN := Notifications.DFN;
|
---|
| 1278 | //Patient.DFN := Notifications.DFN;
|
---|
| 1279 | //if SaveDFN <> Patient.DFN then
|
---|
| 1280 | if SaveDFN <> NewDFN then
|
---|
| 1281 | begin
|
---|
| 1282 | // newdfn does not have new patient.co information for CCOW call
|
---|
| 1283 | if (AllowContextChangeAll(Reason)) then
|
---|
| 1284 | begin
|
---|
| 1285 | RemindersStarted := FALSE;
|
---|
| 1286 | Patient.DFN := NewDFN;
|
---|
| 1287 | Encounter.Clear;
|
---|
| 1288 | Changes.Clear;
|
---|
| 1289 | if Assigned(FlagList) then
|
---|
| 1290 | begin
|
---|
| 1291 | FlagList.Clear;
|
---|
| 1292 | HasFlag := False;
|
---|
| 1293 | HasActiveFlg(FlagList, HasFlag, NewDFN);
|
---|
| 1294 | end;
|
---|
| 1295 | if (FCCOWInstalled and (ctxContextor.State = csSuspended)) or (AllowCCOWContextChange(Patient.DFN)) then
|
---|
| 1296 | begin
|
---|
| 1297 | if Patient.Inpatient then
|
---|
| 1298 | begin
|
---|
| 1299 | Encounter.Inpatient := True;
|
---|
| 1300 | Encounter.Location := Patient.Location;
|
---|
| 1301 | Encounter.DateTime := Patient.AdmitTime;
|
---|
| 1302 | Encounter.VisitCategory := 'H';
|
---|
| 1303 | end;
|
---|
| 1304 | if User.IsProvider then Encounter.Provider := User.DUZ;
|
---|
| 1305 | SetupPatient(FlaggedPTList);
|
---|
| 1306 | if (FlaggedPTList.IndexOf(Patient.DFN) < 0) then
|
---|
| 1307 | FlaggedPTList.Add(Patient.DFN);
|
---|
| 1308 | end
|
---|
| 1309 | else
|
---|
| 1310 | begin
|
---|
| 1311 | Patient.DFN := SaveDFN;
|
---|
| 1312 | if Assigned(FlagList) then
|
---|
| 1313 | begin
|
---|
| 1314 | FlagList.Clear;
|
---|
| 1315 | HasFlag := False;
|
---|
| 1316 | HasActiveFlg(FlagList, HasFlag, NewDFN);
|
---|
| 1317 | end;
|
---|
| 1318 | Notifications.Prior;
|
---|
| 1319 | Exit;
|
---|
| 1320 | end;
|
---|
| 1321 | end else
|
---|
| 1322 | begin
|
---|
| 1323 | Patient.DFN := SaveDFN;
|
---|
| 1324 | Notifications.Prior;
|
---|
| 1325 | Exit;
|
---|
| 1326 | end;
|
---|
| 1327 | end;
|
---|
| 1328 | stsArea.Panels.Items[1].Text := Notifications.Text;
|
---|
| 1329 | FChangeSource := CC_NOTIFICATION;
|
---|
| 1330 | NextIndex := PageIDToTab(CT_COVER);
|
---|
| 1331 | tabPage.TabIndex := CT_NOPAGE;
|
---|
| 1332 | tabPageChange(tabPage);
|
---|
| 1333 | mnuFileNotifRemove.Enabled := Notifications.Followup in [NF_FLAGGED_ORDERS,
|
---|
| 1334 | NF_ORDER_REQUIRES_ELEC_SIGNATURE,
|
---|
| 1335 | NF_MEDICATIONS_EXPIRING,
|
---|
| 1336 | NF_UNVERIFIED_MEDICATION_ORDER,
|
---|
| 1337 | NF_UNVERIFIED_ORDER,
|
---|
| 1338 | NF_FLAGGED_OI_EXP_INPT,
|
---|
| 1339 | NF_FLAGGED_OI_EXP_OUTPT];
|
---|
| 1340 | case Notifications.FollowUp of
|
---|
| 1341 | NF_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
|
---|
| 1342 | NF_FLAGGED_ORDERS : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1343 | NF_ORDER_REQUIRES_ELEC_SIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1344 | NF_ABNORMAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
|
---|
| 1345 | NF_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
|
---|
| 1346 | NF_CONSULT_REQUEST_RESOLUTION : NextIndex := PageIDToTab(CT_CONSULTS);
|
---|
| 1347 | NF_ABNORMAL_IMAGING_RESULTS : NextIndex := PageIDToTab(CT_REPORTS);
|
---|
| 1348 | NF_IMAGING_REQUEST_CANCEL_HELD : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1349 | NF_NEW_SERVICE_CONSULT_REQUEST : NextIndex := PageIDToTab(CT_CONSULTS);
|
---|
| 1350 | NF_CONSULT_REQUEST_CANCEL_HOLD : NextIndex := PageIDToTab(CT_CONSULTS);
|
---|
| 1351 | NF_SITE_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1352 | NF_ORDERER_FLAGGED_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1353 | NF_ORDER_REQUIRES_COSIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1354 | NF_LAB_ORDER_CANCELED : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1355 | NF_STAT_RESULTS :
|
---|
| 1356 | if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'LRCH' then
|
---|
| 1357 | NextIndex := PageIDToTab(CT_LABS)
|
---|
| 1358 | else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'GMRC' then
|
---|
| 1359 | NextIndex := PageIDToTab(CT_CONSULTS)
|
---|
| 1360 | else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'RA' then
|
---|
| 1361 | NextIndex := PageIDToTab(CT_REPORTS);
|
---|
| 1362 | NF_DNR_EXPIRING : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1363 | NF_MEDICATIONS_EXPIRING : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1364 | NF_UNVERIFIED_MEDICATION_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1365 | NF_NEW_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1366 | NF_IMAGING_RESULTS_AMENDED : NextIndex := PageIDToTab(CT_REPORTS);
|
---|
| 1367 | NF_CRITICAL_LAB_RESULTS : NextIndex := PageIDToTab(CT_LABS);
|
---|
| 1368 | NF_UNVERIFIED_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1369 | NF_FLAGGED_OI_RESULTS : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1370 | NF_FLAGGED_OI_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1371 | NF_DC_ORDER : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1372 | NF_CONSULT_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_CONSULTS);
|
---|
| 1373 | NF_DCSUMM_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_DCSUMM);
|
---|
| 1374 | NF_NOTES_UNSIGNED_NOTE : NextIndex := PageIDToTab(CT_NOTES);
|
---|
| 1375 | NF_CONSULT_REQUEST_UPDATED : NextIndex := PageIDToTab(CT_CONSULTS);
|
---|
| 1376 | NF_FLAGGED_OI_EXP_INPT : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1377 | NF_FLAGGED_OI_EXP_OUTPT : NextIndex := PageIDToTab(CT_ORDERS);
|
---|
| 1378 | NF_CONSULT_PROC_INTERPRETATION : NextIndex := PageIDToTab(CT_CONSULTS);
|
---|
| 1379 | NF_IMAGING_REQUEST_CHANGED :
|
---|
| 1380 | begin
|
---|
| 1381 | ReportBox(GetNotificationFollowUpText(Patient.DFN, Notifications.FollowUp, Notifications.AlertData), Pieces(Piece(Notifications.RecordID, U, 1), ':', 2, 3), True);
|
---|
| 1382 | Notifications.Delete;
|
---|
| 1383 | end;
|
---|
| 1384 | NF_LAB_THRESHOLD_EXCEEDED : NextIndex := PageIDToTab(CT_LABS);
|
---|
| 1385 | NF_SURGERY_UNSIGNED_NOTE : if TabExists(CT_SURGERY) then
|
---|
| 1386 | NextIndex := PageIDToTab(CT_SURGERY)
|
---|
| 1387 | else
|
---|
| 1388 | InfoBox(TX_NO_SURG_NOTIF, TC_NO_SURG_NOTIF, MB_OK);
|
---|
| 1389 | //NextIndex := PageIDToTab(CT_NOTES);
|
---|
| 1390 | else InfoBox(TX_UNK_NOTIF, TC_UNK_NOTIF, MB_OK);
|
---|
| 1391 | end;
|
---|
| 1392 | tabPage.TabIndex := NextIndex;
|
---|
| 1393 | tabPageChange(tabPage);
|
---|
| 1394 | end
|
---|
| 1395 | else mnuFileOpenClick(mnuFileNext);
|
---|
| 1396 | end;
|
---|
| 1397 |
|
---|
| 1398 |
|
---|
| 1399 | procedure TfrmFrame.SetBADxList;
|
---|
| 1400 | var
|
---|
| 1401 | i: smallint;
|
---|
| 1402 | begin
|
---|
| 1403 | if not Assigned(UBAGlobals.tempDxList) then
|
---|
| 1404 | begin
|
---|
| 1405 | UBAGlobals.tempDxList := TList.Create;
|
---|
| 1406 | UBAGlobals.tempDxList.Count := 0;
|
---|
| 1407 | Application.ProcessMessages;
|
---|
| 1408 | end
|
---|
| 1409 | else
|
---|
| 1410 | begin
|
---|
| 1411 | //Kill the old Dx list
|
---|
| 1412 | for i := 0 to pred(UBAGlobals.tempDxList.Count) do
|
---|
| 1413 | TObject(UBAGlobals.tempDxList[i]).Free;
|
---|
| 1414 |
|
---|
| 1415 | UBAGlobals.tempDxList.Clear;
|
---|
| 1416 | Application.ProcessMessages;
|
---|
| 1417 |
|
---|
| 1418 | //Create new Dx list for newly selected patient
|
---|
| 1419 | if not Assigned(UBAGlobals.tempDxList) then
|
---|
| 1420 | begin
|
---|
| 1421 | UBAGlobals.tempDxList := TList.Create;
|
---|
| 1422 | UBAGlobals.tempDxList.Count := 0;
|
---|
| 1423 | Application.ProcessMessages;
|
---|
| 1424 | end;
|
---|
| 1425 | end;
|
---|
| 1426 | end;
|
---|
| 1427 |
|
---|
| 1428 | procedure TfrmFrame.mnuFileOpenClick(Sender: TObject);
|
---|
| 1429 | { select a new patient & update the header displays (patient id, encounter, postings) }
|
---|
| 1430 | var
|
---|
| 1431 | SaveDFN, Reason: string;
|
---|
| 1432 | //NextTab: Integer; // moved up for visibility - v23.4 rV
|
---|
| 1433 | ok, OldRemindersStarted: boolean;
|
---|
| 1434 | //i: smallint;
|
---|
| 1435 | begin
|
---|
| 1436 | DetermineNextTab;
|
---|
| 1437 | (* if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
|
---|
| 1438 | NextTab := TabToPageID(tabPage.TabIndex)
|
---|
| 1439 | else
|
---|
| 1440 | NextTab := User.InitialTab;
|
---|
| 1441 | if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
|
---|
| 1442 | if User.IsReportsOnly then // Reports Only tab.
|
---|
| 1443 | NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
|
---|
| 1444 | if not TabExists(NextTab) then NextTab := CT_COVER;
|
---|
| 1445 | if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
|
---|
| 1446 | if NextTab = CT_ORDERS then
|
---|
| 1447 | if frmOrders <> nil then with frmOrders do
|
---|
| 1448 | begin
|
---|
| 1449 | if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
|
---|
| 1450 | PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
|
---|
| 1451 | end;*)
|
---|
| 1452 | if not AllowContextChangeAll(Reason) then Exit;
|
---|
| 1453 |
|
---|
| 1454 | // update status text here
|
---|
| 1455 | stsArea.Panels.Items[1].Text := '';
|
---|
| 1456 | if (not User.IsReportsOnly) then
|
---|
| 1457 | begin
|
---|
| 1458 | if not FRefreshing then
|
---|
| 1459 | begin
|
---|
| 1460 | Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
|
---|
| 1461 | if Notifications.Active then
|
---|
| 1462 | begin
|
---|
| 1463 | if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
|
---|
| 1464 | begin
|
---|
| 1465 | Notifications.Prior;
|
---|
| 1466 | Exit;
|
---|
| 1467 | end;
|
---|
| 1468 | end;
|
---|
| 1469 | if Notifications.Active then Notifications.Prior;
|
---|
| 1470 | end;
|
---|
| 1471 | end;
|
---|
| 1472 |
|
---|
| 1473 | SaveDFN := Patient.DFN;
|
---|
| 1474 | OldRemindersStarted := RemindersStarted;
|
---|
| 1475 | RemindersStarted := FALSE;
|
---|
| 1476 | try
|
---|
| 1477 | if FRefreshing then
|
---|
| 1478 | begin
|
---|
| 1479 | UpdatePtInfoOnRefresh;
|
---|
| 1480 | ok := TRUE;
|
---|
| 1481 | end
|
---|
| 1482 | else
|
---|
| 1483 | begin
|
---|
| 1484 | ok := FALSE;
|
---|
| 1485 | if (not User.IsReportsOnly) then
|
---|
| 1486 | begin
|
---|
| 1487 | if FCCOWInstalled and (ctxContextor.State = csParticipating) then
|
---|
| 1488 | begin
|
---|
| 1489 | UpdateCCOWContext;
|
---|
| 1490 | if not FCCOWError then
|
---|
| 1491 | begin
|
---|
| 1492 | FCCOWIconName := 'BMP_CCOW_LINKED';
|
---|
| 1493 | pnlCCOW.Hint := TX_CCOW_LINKED;
|
---|
| 1494 | imgCCOW.Picture.Bitmap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 1495 | end;
|
---|
| 1496 | end
|
---|
| 1497 | else
|
---|
| 1498 | begin
|
---|
| 1499 | FCCOWIconName := 'BMP_CCOW_BROKEN';
|
---|
| 1500 | pnlCCOW.Hint := TX_CCOW_BROKEN;
|
---|
| 1501 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 1502 | end;
|
---|
| 1503 | if (Patient.DFN = '') or (Sender = mnuFileOpen) or (Sender = mnuFileNext) or (Sender = mnuViewDemo) then
|
---|
| 1504 | SelectPatient(SHOW_NOTIFICATIONS, Font.Size);
|
---|
| 1505 | ShowEverything;
|
---|
| 1506 | DisplayEncounterText;
|
---|
| 1507 | FPrevInPatient := Patient.Inpatient;
|
---|
| 1508 | if Notifications.Active then
|
---|
| 1509 | begin
|
---|
| 1510 | // display 'next notification' button
|
---|
| 1511 | FNextButtonActive := True;
|
---|
| 1512 | with stsArea.Panels[2] do
|
---|
| 1513 | begin
|
---|
| 1514 | //Text := 'Next ->';
|
---|
| 1515 | Bevel := pbRaised;
|
---|
| 1516 | end;
|
---|
| 1517 | mnuFileNext.Enabled := True;
|
---|
| 1518 | mnuFileNextClick(Self);
|
---|
| 1519 | end
|
---|
| 1520 | else
|
---|
| 1521 | begin
|
---|
| 1522 | // hide the 'next notification' button
|
---|
| 1523 | FNextButtonActive := False;
|
---|
| 1524 | with stsArea.Panels[2] do
|
---|
| 1525 | begin
|
---|
| 1526 | //Text := '';
|
---|
| 1527 | Bevel := pbLowered;
|
---|
| 1528 | end;
|
---|
| 1529 | mnuFileNext.Enabled := False;
|
---|
| 1530 | mnuFileNotifRemove.Enabled := False;
|
---|
| 1531 | if Patient.DFN <> SaveDFN then
|
---|
| 1532 | ok := TRUE;
|
---|
| 1533 | end
|
---|
| 1534 | end
|
---|
| 1535 | else
|
---|
| 1536 | begin
|
---|
| 1537 | Notifications.Clear;
|
---|
| 1538 | SelectPatient(False, Font.Size); // Call Pt. Sel. w/o notifications.
|
---|
| 1539 | ShowEverything;
|
---|
| 1540 | DisplayEncounterText;
|
---|
| 1541 | FPrevInPatient := Patient.Inpatient;
|
---|
| 1542 | ok := TRUE;
|
---|
| 1543 | end;
|
---|
| 1544 | end;
|
---|
| 1545 | if ok then
|
---|
| 1546 | begin
|
---|
| 1547 | if FCCOWInstalled and (ctxContextor.State = csParticipating) and (not FRefreshing) then
|
---|
| 1548 | begin
|
---|
| 1549 | if (AllowCCOWContextChange(Patient.DFN)) then
|
---|
| 1550 | begin
|
---|
| 1551 | SetupPatient;
|
---|
| 1552 | tabPage.TabIndex := PageIDToTab(NextTab);
|
---|
| 1553 | tabPageChange(tabPage);
|
---|
| 1554 | end
|
---|
| 1555 | else
|
---|
| 1556 | begin
|
---|
| 1557 | Patient.DFN := SaveDFN;
|
---|
| 1558 | SetupPatient;
|
---|
| 1559 | tabPage.TabIndex := PageIDToTab(NextTab);
|
---|
| 1560 | tabPageChange(tabPage);
|
---|
| 1561 | end;
|
---|
| 1562 | end
|
---|
| 1563 | else
|
---|
| 1564 | begin
|
---|
| 1565 | SetupPatient;
|
---|
| 1566 | tabPage.TabIndex := PageIDToTab(NextTab);
|
---|
| 1567 | tabPageChange(tabPage);
|
---|
| 1568 | end;
|
---|
| 1569 | end;
|
---|
| 1570 | finally
|
---|
| 1571 | if (not FRefreshing) and (Patient.DFN = SaveDFN) then
|
---|
| 1572 | RemindersStarted := OldRemindersStarted;
|
---|
| 1573 | FFirstLoad := False;
|
---|
| 1574 | end;
|
---|
| 1575 | {Begin BillingAware}
|
---|
| 1576 | if BILLING_AWARE then frmFrame.SetBADxList; //end IsBillingAware
|
---|
| 1577 | {End BillingAware}
|
---|
| 1578 |
|
---|
| 1579 | end;
|
---|
| 1580 |
|
---|
| 1581 | procedure TfrmFrame.DetermineNextTab;
|
---|
| 1582 | begin
|
---|
| 1583 | if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
|
---|
| 1584 | begin
|
---|
| 1585 | if (tabPage.TabIndex < 0) then
|
---|
| 1586 | NextTab := LastTab
|
---|
| 1587 | else
|
---|
| 1588 | NextTab := TabToPageID(tabPage.TabIndex);
|
---|
| 1589 | end
|
---|
| 1590 | else
|
---|
| 1591 | NextTab := User.InitialTab;
|
---|
| 1592 | if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
|
---|
| 1593 | if User.IsReportsOnly then // Reports Only tab.
|
---|
| 1594 | NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
|
---|
| 1595 | if not TabExists(NextTab) then NextTab := CT_COVER;
|
---|
| 1596 | if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
|
---|
| 1597 | if NextTab = CT_ORDERS then
|
---|
| 1598 | if frmOrders <> nil then with frmOrders do
|
---|
| 1599 | begin
|
---|
| 1600 | if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
|
---|
| 1601 | PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
|
---|
| 1602 | end;
|
---|
| 1603 | end;
|
---|
| 1604 |
|
---|
| 1605 | procedure TfrmFrame.mnuFileEncounterClick(Sender: TObject);
|
---|
| 1606 | { displays encounter window and updates encounter display in case encounter was updated }
|
---|
| 1607 | begin
|
---|
| 1608 | UpdateEncounter(NPF_ALL); {*KCM*}
|
---|
| 1609 | DisplayEncounterText;
|
---|
| 1610 | end;
|
---|
| 1611 |
|
---|
| 1612 | procedure TfrmFrame.mnuFileReviewClick(Sender: TObject);
|
---|
| 1613 | { displays the Review Changes window (which resets the Encounter object) }
|
---|
| 1614 | var
|
---|
| 1615 | EventChanges: boolean;
|
---|
| 1616 | NameNeedLook: string;
|
---|
| 1617 | begin
|
---|
| 1618 | EventChanges := False;
|
---|
| 1619 | NameNeedLook := '';
|
---|
| 1620 | UpdatePtInfoOnRefresh;
|
---|
| 1621 | if Changes.Count > 0 then
|
---|
| 1622 | begin
|
---|
| 1623 | if (frmOrders <> nil) and (frmOrders.TheCurrentView <> nil) and ( frmOrders.TheCurrentView.EventDelay.EventIFN>0) then
|
---|
| 1624 | begin
|
---|
| 1625 | EventChanges := True;
|
---|
| 1626 | NameNeedLook := frmOrders.TheCurrentView.ViewName;
|
---|
| 1627 | frmOrders.PtEvtCompleted(frmOrders.TheCurrentView.EventDelay.PtEventIFN, frmOrders.TheCurrentView.EventDelay.EventName);
|
---|
| 1628 | end;
|
---|
| 1629 | ReviewChanges(TimedOut, EventChanges);
|
---|
| 1630 | if TabToPageID(tabPage.TabIndex)= CT_MEDS then
|
---|
| 1631 | begin
|
---|
| 1632 | frmOrders.InitOrderSheets2(NameNeedLook);
|
---|
| 1633 | end;
|
---|
| 1634 | end
|
---|
| 1635 | else InfoBox('No new changes to review/sign.', 'Review Changes', MB_OK);
|
---|
| 1636 | end;
|
---|
| 1637 |
|
---|
| 1638 | procedure TfrmFrame.mnuFileExitClick(Sender: TObject);
|
---|
| 1639 | { see the CloseQuery event }
|
---|
| 1640 | var
|
---|
| 1641 | i: smallint;
|
---|
| 1642 | begin
|
---|
| 1643 | try
|
---|
| 1644 | if BILLING_AWARE then
|
---|
| 1645 | begin
|
---|
| 1646 | if Assigned(tempDxList) then
|
---|
| 1647 | for i := 0 to pred(UBAGlobals.tempDxList.Count) do
|
---|
| 1648 | TObject(UBAGlobals.tempDxList[i]).Free;
|
---|
| 1649 |
|
---|
| 1650 | UBAGlobals.tempDxList.Clear;
|
---|
| 1651 | Application.ProcessMessages;
|
---|
| 1652 | end; //end IsBillingAware
|
---|
| 1653 | except
|
---|
| 1654 | on EAccessViolation do
|
---|
| 1655 | begin
|
---|
| 1656 | {$ifdef debug}ShowMessage('Access Violation in procedure TfrmFrame.mnuFileExitClick()');{$endif}
|
---|
| 1657 | raise;
|
---|
| 1658 | end;
|
---|
| 1659 | on E: Exception do
|
---|
| 1660 | begin
|
---|
| 1661 | {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmFrame.mnuFileExitClick()');{$endif}
|
---|
| 1662 | raise;
|
---|
| 1663 | end;
|
---|
| 1664 | end;
|
---|
| 1665 |
|
---|
| 1666 | Close;
|
---|
| 1667 | end;
|
---|
| 1668 |
|
---|
| 1669 | { View Menu Events ------------------------------------------------------------------------- }
|
---|
| 1670 |
|
---|
| 1671 | procedure TfrmFrame.mnuViewDemoClick(Sender: TObject);
|
---|
| 1672 | { displays patient inquiry report (which optionally allows new patient to be selected) }
|
---|
| 1673 | var
|
---|
| 1674 | SelectNew: Boolean;
|
---|
| 1675 | begin
|
---|
| 1676 | StatusText(TX_PTINQ);
|
---|
| 1677 | PatientInquiry(SelectNew);
|
---|
| 1678 | if Assigned(FLastPage) then
|
---|
| 1679 | FLastPage.FocusFirstControl;
|
---|
| 1680 | StatusText('');
|
---|
| 1681 | if SelectNew then mnuFileOpenClick(mnuViewDemo);
|
---|
| 1682 | end;
|
---|
| 1683 |
|
---|
| 1684 | procedure TfrmFrame.mnuViewPostingsClick(Sender: TObject);
|
---|
| 1685 | { displays the window that shows crisis notes, warnings, allergies, & advance directives }
|
---|
| 1686 | begin
|
---|
| 1687 | ShowCWAD;
|
---|
| 1688 | end;
|
---|
| 1689 |
|
---|
| 1690 | { Tool Menu Events ------------------------------------------------------------------------- }
|
---|
| 1691 |
|
---|
| 1692 | function TfrmFrame.ExpandCommand(x: string): string;
|
---|
| 1693 | { look for 'macros' on the command line and expand them using current context }
|
---|
| 1694 |
|
---|
| 1695 | procedure Substitute(const Key, Data: string);
|
---|
| 1696 | var
|
---|
| 1697 | Stop, Start: Integer;
|
---|
| 1698 | begin
|
---|
| 1699 | Stop := Pos(Key, x) - 1;
|
---|
| 1700 | Start := Stop + Length(Key) + 1;
|
---|
| 1701 | x := Copy(x, 1, Stop) + Data + Copy(x, Start, Length(x));
|
---|
| 1702 | end;
|
---|
| 1703 |
|
---|
| 1704 | begin
|
---|
| 1705 | if Pos('%MREF', x) > 0 then Substitute('%MREF',
|
---|
| 1706 | '^TMP(''ORWCHART'',' + MScalar('$J') + ',''' + DottedIPStr + ''',' + IntToHex(Handle, 8) + ')');
|
---|
| 1707 | if Pos('%SRV', x) > 0 then Substitute('%SRV', RPCBrokerV.Server);
|
---|
| 1708 | if Pos('%PORT', x) > 0 then Substitute('%PORT', IntToStr(RPCBrokerV.ListenerPort));
|
---|
| 1709 | if Pos('%DFN', x) > 0 then Substitute('%DFN', Patient.DFN); //*DFN*
|
---|
| 1710 | if Pos('%DUZ', x) > 0 then Substitute('%DUZ', IntToStr(User.DUZ));
|
---|
| 1711 | Result := x;
|
---|
| 1712 | end;
|
---|
| 1713 |
|
---|
| 1714 | procedure TfrmFrame.ToolClick(Sender: TObject);
|
---|
| 1715 | { executes the program associated with an item on the Tools menu, the command line is stored
|
---|
| 1716 | in the item's hint property }
|
---|
| 1717 | const
|
---|
| 1718 | TXT_ECS_NOTFOUND = 'The ECS application is not found at the default directory,' + #13 + 'would you like manually search it?';
|
---|
| 1719 | TC_ECS_NOTFOUND = 'Application Not Found';
|
---|
| 1720 | var
|
---|
| 1721 | x, AFile, Param, MenuCommand, ECSAppend, CapNm, curPath : string;
|
---|
| 1722 | IsECSInterface: boolean;
|
---|
| 1723 |
|
---|
| 1724 | function TakeOutAmps(AString: string): string;
|
---|
| 1725 | var
|
---|
| 1726 | S1,S2: string;
|
---|
| 1727 | begin
|
---|
| 1728 | if Pos('&',AString)=0 then
|
---|
| 1729 | begin
|
---|
| 1730 | Result := AString;
|
---|
| 1731 | Exit;
|
---|
| 1732 | end;
|
---|
| 1733 | S1 := Piece(AString,'&',1);
|
---|
| 1734 | S2 := Piece(AString,'&',2);
|
---|
| 1735 | Result := S1 + S2;
|
---|
| 1736 | end;
|
---|
| 1737 |
|
---|
| 1738 | function ExcuteEC(AFile,APara: string): boolean;
|
---|
| 1739 | begin
|
---|
| 1740 | if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL) > 32 ) then Result := True
|
---|
| 1741 | else
|
---|
| 1742 | begin
|
---|
| 1743 | if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
|
---|
| 1744 | begin
|
---|
| 1745 | if OROpenDlg.Execute then
|
---|
| 1746 | begin
|
---|
| 1747 | AFile := OROpenDlg.FileName;
|
---|
| 1748 | if Pos('ecs gui.exe',lowerCase(AFile))<1 then
|
---|
| 1749 | begin
|
---|
| 1750 | ShowMessage('This is not a valid ECS application.');
|
---|
| 1751 | Result := True;
|
---|
| 1752 | end else
|
---|
| 1753 | begin
|
---|
| 1754 | if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL)<32) then Result := False
|
---|
| 1755 | else Result := True;
|
---|
| 1756 | end;
|
---|
| 1757 | end
|
---|
| 1758 | else Result := True;
|
---|
| 1759 | end else Result := True;
|
---|
| 1760 | end;
|
---|
| 1761 | end;
|
---|
| 1762 |
|
---|
| 1763 | function ExcuteECS(AFile, APara: string; var currPath: string): boolean;
|
---|
| 1764 | var
|
---|
| 1765 | commandline,RPCHandle: string;
|
---|
| 1766 | StartupInfo: TStartupInfo;
|
---|
| 1767 | ProcessInfo: TProcessInformation;
|
---|
| 1768 | begin
|
---|
| 1769 | FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
|
---|
| 1770 | with StartupInfo do
|
---|
| 1771 | begin
|
---|
| 1772 | cb := SizeOf(TStartupInfo);
|
---|
| 1773 | dwFlags := STARTF_USESHOWWINDOW;
|
---|
| 1774 | wShowWindow := SW_SHOWNORMAL;
|
---|
| 1775 | end;
|
---|
| 1776 | commandline := AFile + Param;
|
---|
| 1777 | RPCHandle := GetAppHandle(RPCBrokerV);
|
---|
| 1778 | commandline := commandline + ' H=' + RPCHandle;
|
---|
| 1779 | if CreateProcess(nil, PChar(commandline), nil, nil, False,
|
---|
| 1780 | NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then Result := True
|
---|
| 1781 | else
|
---|
| 1782 | begin
|
---|
| 1783 | if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
|
---|
| 1784 | begin
|
---|
| 1785 | if OROpenDlg.Execute then
|
---|
| 1786 | begin
|
---|
| 1787 | AFile := OROpenDlg.FileName;
|
---|
| 1788 | if Pos('ecs gui.exe',lowerCase(AFile))<1 then
|
---|
| 1789 | begin
|
---|
| 1790 | ShowMessage('This is not a valid ECS application.');
|
---|
| 1791 | Result := True;
|
---|
| 1792 | end else
|
---|
| 1793 | begin
|
---|
| 1794 | SaveUserPath('Event Capture Interface='+AFile, currPath);
|
---|
| 1795 | FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
|
---|
| 1796 | with StartupInfo do
|
---|
| 1797 | begin
|
---|
| 1798 | cb := SizeOf(TStartupInfo);
|
---|
| 1799 | dwFlags := STARTF_USESHOWWINDOW;
|
---|
| 1800 | wShowWindow := SW_SHOWNORMAL;
|
---|
| 1801 | end;
|
---|
| 1802 | commandline := AFile + Param;
|
---|
| 1803 | RPCHandle := GetAppHandle(RPCBrokerV);
|
---|
| 1804 | commandline := commandline + ' H=' + RPCHandle;
|
---|
| 1805 | if not CreateProcess(nil, PChar(commandline), nil, nil, False,
|
---|
| 1806 | NORMAL_PRIORITY_CLASS, nil, nil,StartupInfo,ProcessInfo) then Result := False
|
---|
| 1807 | else Result := True;
|
---|
| 1808 | end;
|
---|
| 1809 | end
|
---|
| 1810 | else Result := True;
|
---|
| 1811 | end else Result := True;
|
---|
| 1812 | end;
|
---|
| 1813 | end;
|
---|
| 1814 |
|
---|
| 1815 | begin
|
---|
| 1816 | MenuCommand := '';
|
---|
| 1817 | ECSAppend := '';
|
---|
| 1818 | IsECSInterface := False;
|
---|
| 1819 | curPath := '';
|
---|
| 1820 | CapNm := LowerCase(TMenuItem(Sender).Caption);
|
---|
| 1821 | CapNm := TakeOutAmps(CapNm);
|
---|
| 1822 | if AnsiCompareText('event capture interface',CapNm)=0 then
|
---|
| 1823 | begin
|
---|
| 1824 | IsECSInterface := True;
|
---|
| 1825 | if FECSAuthUser then UpdateECSParameter(ECSAppend)
|
---|
| 1826 | else begin
|
---|
| 1827 | ShowMessage('You don''t have permission to use ECS.');
|
---|
| 1828 | exit;
|
---|
| 1829 | end;
|
---|
| 1830 | end;
|
---|
| 1831 | MenuCommand := TMenuItem(Sender).Hint + ECSAppend;
|
---|
| 1832 | x := ExpandCommand(MenuCommand);
|
---|
| 1833 | if CharAt(x, 1) = '"' then
|
---|
| 1834 | begin
|
---|
| 1835 | x := Copy(x, 2, Length(x));
|
---|
| 1836 | AFile := Copy(x, 1, Pos('"',x)-1);
|
---|
| 1837 | Param := Copy(x, Pos('"',x)+1, Length(x));
|
---|
| 1838 | end else
|
---|
| 1839 | begin
|
---|
| 1840 | AFile := Piece(x, ' ', 1);
|
---|
| 1841 | Param := Copy(x, Length(AFile)+1, Length(x));
|
---|
| 1842 | end;
|
---|
| 1843 | if IsECSInterface then
|
---|
| 1844 | begin
|
---|
| 1845 | if not ExcuteECS(AFile,Param,curPath) then
|
---|
| 1846 | ExcuteECS(AFile,Param,curPath);
|
---|
| 1847 | if Length(curPath)>0 then
|
---|
| 1848 | TMenuItem(Sender).Hint := curPath;
|
---|
| 1849 | end
|
---|
| 1850 | else if (Pos('ecs',LowerCase(AFile))>0) and (not IsECSInterface) then
|
---|
| 1851 | begin
|
---|
| 1852 | if not ExcuteEC(AFile,Param) then
|
---|
| 1853 | ExcuteEC(AFile,Param);
|
---|
| 1854 | end else
|
---|
| 1855 | begin
|
---|
| 1856 | ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL);
|
---|
| 1857 | end;
|
---|
| 1858 | end;
|
---|
| 1859 |
|
---|
| 1860 | { Help Menu Events ------------------------------------------------------------------------- }
|
---|
| 1861 |
|
---|
| 1862 | procedure TfrmFrame.mnuHelpBrokerClick(Sender: TObject);
|
---|
| 1863 | { used for debugging - shows last n broker calls }
|
---|
| 1864 | begin
|
---|
| 1865 | ShowBroker;
|
---|
| 1866 | end;
|
---|
| 1867 |
|
---|
| 1868 | procedure TfrmFrame.mnuHelpListsClick(Sender: TObject);
|
---|
| 1869 | { used for debugging - shows internal contents of TORListBox }
|
---|
| 1870 | begin
|
---|
| 1871 | if Screen.ActiveControl is TListBox
|
---|
| 1872 | then DebugListItems(TListBox(Screen.ActiveControl))
|
---|
| 1873 | else InfoBox('Focus control is not a listbox', 'ListBox Data', MB_OK);
|
---|
| 1874 | end;
|
---|
| 1875 |
|
---|
| 1876 | procedure TfrmFrame.mnuHelpSymbolsClick(Sender: TObject);
|
---|
| 1877 | { used for debugging - shows current symbol table }
|
---|
| 1878 | begin
|
---|
| 1879 | DebugShowServer;
|
---|
| 1880 | end;
|
---|
| 1881 |
|
---|
| 1882 | procedure TfrmFrame.mnuHelpAboutClick(Sender: TObject);
|
---|
| 1883 | { displays the about screen }
|
---|
| 1884 | begin
|
---|
| 1885 | ShowAbout;
|
---|
| 1886 | end;
|
---|
| 1887 |
|
---|
| 1888 | { Status Bar Methods }
|
---|
| 1889 |
|
---|
| 1890 | procedure TfrmFrame.UMStatusText(var Message: TMessage);
|
---|
| 1891 | { displays status bar text (using the pointer to a text buffer passed in LParam) }
|
---|
| 1892 | begin
|
---|
| 1893 | stsArea.Panels.Items[0].Text := StrPas(PChar(Message.LParam));
|
---|
| 1894 | stsArea.Refresh;
|
---|
| 1895 | end;
|
---|
| 1896 |
|
---|
| 1897 | procedure TfrmFrame.stsAreaMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 1898 | Shift: TShiftState; X, Y: Integer);
|
---|
| 1899 | begin
|
---|
| 1900 | if (FNextButtonActive) and (X > FNextButtonL) and (X < FNextButtonR) then
|
---|
| 1901 | begin
|
---|
| 1902 | stsArea.Panels[2].Bevel := pbLowered;
|
---|
| 1903 | popAlerts.AutoPopup := TRUE;
|
---|
| 1904 | end;
|
---|
| 1905 | end;
|
---|
| 1906 |
|
---|
| 1907 | procedure TfrmFrame.stsAreaMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 1908 | Shift: TShiftState; X, Y: Integer);
|
---|
| 1909 | begin
|
---|
| 1910 | if FNextButtonActive then
|
---|
| 1911 | begin
|
---|
| 1912 | stsArea.Panels[2].Bevel := pbRaised;
|
---|
| 1913 | popAlerts.AutoPopup := FALSE;
|
---|
| 1914 | if (X > FNextButtonL) and (X < FNextButtonR) then
|
---|
| 1915 | if Button = mbLeft then mnuFileNextClick(Self);
|
---|
| 1916 | end;
|
---|
| 1917 | end;
|
---|
| 1918 |
|
---|
| 1919 | procedure TfrmFrame.stsAreaDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
|
---|
| 1920 | const Rect: TRect);
|
---|
| 1921 | begin
|
---|
| 1922 | if FNextButtonActive then with StatusBar.Canvas do
|
---|
| 1923 | begin
|
---|
| 1924 | Draw(Rect.Left + 2, Rect.Top, FNextButtonBitmap); { draw bitmap }
|
---|
| 1925 | TextOut(Rect.Left + 20, Rect.Top + 2, 'Next'); { draw text to the right of the bitmap }
|
---|
| 1926 | end;
|
---|
| 1927 | end;
|
---|
| 1928 |
|
---|
| 1929 | { Toolbar Methods (make panels act like buttons) ------------------------------------------- }
|
---|
| 1930 |
|
---|
| 1931 | procedure TfrmFrame.pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 1932 | Shift: TShiftState; X, Y: Integer);
|
---|
| 1933 | { emulate a button press in the patient identification panel }
|
---|
| 1934 | begin
|
---|
| 1935 | pnlPatient.BevelOuter := bvLowered;
|
---|
| 1936 | with lblPtName do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1937 | with lblPtSSN do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1938 | with lblPtAge do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1939 | end;
|
---|
| 1940 |
|
---|
| 1941 | procedure TfrmFrame.pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 1942 | Shift: TShiftState; X, Y: Integer);
|
---|
| 1943 | { emulate the button raising in the patient identification panel & call Patient Inquiry }
|
---|
| 1944 | begin
|
---|
| 1945 | pnlPatient.BevelOuter := bvRaised;
|
---|
| 1946 | with lblPtName do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1947 | with lblPtSSN do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1948 | with lblPtAge do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1949 | end;
|
---|
| 1950 |
|
---|
| 1951 | procedure TfrmFrame.pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 1952 | Shift: TShiftState; X, Y: Integer);
|
---|
| 1953 | { emulate a button press in the encounter panel }
|
---|
| 1954 | begin
|
---|
| 1955 | if User.IsReportsOnly then
|
---|
| 1956 | exit;
|
---|
| 1957 | pnlVisit.BevelOuter := bvLowered;
|
---|
| 1958 | //with lblStLocation do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1959 | with lblPtLocation do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1960 | with lblPtProvider do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1961 | end;
|
---|
| 1962 |
|
---|
| 1963 | procedure TfrmFrame.pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 1964 | Shift: TShiftState; X, Y: Integer);
|
---|
| 1965 | { emulate a button raising in the encounter panel and call Update Provider/Location }
|
---|
| 1966 | begin
|
---|
| 1967 | if User.IsReportsOnly then
|
---|
| 1968 | exit;
|
---|
| 1969 | pnlVisit.BevelOuter := bvRaised;
|
---|
| 1970 | //with lblStLocation do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1971 | with lblPtLocation do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1972 | with lblPtProvider do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1973 | end;
|
---|
| 1974 |
|
---|
| 1975 | procedure TfrmFrame.pnlPrimaryCareMouseDown(Sender: TObject;
|
---|
| 1976 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 1977 | begin
|
---|
| 1978 | pnlPrimaryCare.BevelOuter := bvLowered;
|
---|
| 1979 | with lblPtCare do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1980 | with lblPtAttending do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1981 | end;
|
---|
| 1982 |
|
---|
| 1983 | procedure TfrmFrame.pnlPrimaryCareMouseUp(Sender: TObject;
|
---|
| 1984 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 1985 | begin
|
---|
| 1986 | pnlPrimaryCare.BevelOuter := bvRaised;
|
---|
| 1987 | with lblPtCare do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1988 | with lblPtAttending do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 1989 | end;
|
---|
| 1990 |
|
---|
| 1991 | procedure TfrmFrame.pnlPostingsMouseDown(Sender: TObject;
|
---|
| 1992 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 1993 | { emulate a button press in the postings panel }
|
---|
| 1994 | begin
|
---|
| 1995 | pnlPostings.BevelOuter := bvLowered;
|
---|
| 1996 | with lblPtPostings do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1997 | with lblPtCWAD do SetBounds(Left+2, Top+2, Width, Height);
|
---|
| 1998 | end;
|
---|
| 1999 |
|
---|
| 2000 | procedure TfrmFrame.pnlPostingsMouseUp(Sender: TObject;
|
---|
| 2001 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 2002 | { emulate a button raising in the posting panel and call Postings }
|
---|
| 2003 | begin
|
---|
| 2004 | pnlPostings.BevelOuter := bvRaised;
|
---|
| 2005 | with lblPtPostings do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 2006 | with lblPtCWAD do SetBounds(Left-2, Top-2, Width, Height);
|
---|
| 2007 | end;
|
---|
| 2008 |
|
---|
| 2009 | { Resize and Font-Change procedures -------------------------------------------------------- }
|
---|
| 2010 |
|
---|
| 2011 | procedure TfrmFrame.LoadSizesForUser;
|
---|
| 2012 | var
|
---|
| 2013 | s1, s2, s3, s4, Dummy: integer;
|
---|
| 2014 |
|
---|
| 2015 | panelBottom, panelMedIn : integer;
|
---|
| 2016 |
|
---|
| 2017 | begin
|
---|
| 2018 | ChangeFont(UserFontSize);
|
---|
| 2019 | SetUserBounds(TControl(frmFrame));
|
---|
| 2020 | SetUserWidths(TControl(frmProblems.pnlLeft));
|
---|
| 2021 | //SetUserWidths(TControl(frmMeds.pnlLeft));
|
---|
| 2022 | SetUserWidths(TControl(frmOrders.pnlLeft));
|
---|
| 2023 | SetUserWidths(TControl(frmNotes.pnlLeft));
|
---|
| 2024 | SetUserWidths(TControl(frmConsults.pnlLeft));
|
---|
| 2025 | SetUserWidths(TControl(frmDCSumm.pnlLeft));
|
---|
| 2026 | if Assigned(frmSurgery) then SetUserWidths(TControl(frmSurgery.pnlLeft));
|
---|
| 2027 | SetUserWidths(TControl(frmLabs.pnlLeft));
|
---|
| 2028 | SetUserWidths(TControl(frmReports.pnlLeft));
|
---|
| 2029 | SetUserColumns(TControl(frmOrders.hdrOrders));
|
---|
| 2030 | SetUserColumns(TControl(frmMeds.hdrMedsIn)); // still need conversion
|
---|
| 2031 | SetUserColumns(TControl(frmMeds.hdrMedsOut));
|
---|
| 2032 | SetUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight);
|
---|
| 2033 | SetUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight);
|
---|
| 2034 | SetUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, Dummy ,Dummy);
|
---|
| 2035 | SetUserBounds2(DrawerSplitters,s1, s2, s3, Dummy);
|
---|
| 2036 | frmNotes.Drawers.LastOpenSize := s1;
|
---|
| 2037 | frmConsults.Drawers.LastOpenSize := s2;
|
---|
| 2038 | frmDCSumm.Drawers.LastOpenSize := s3;
|
---|
| 2039 |
|
---|
| 2040 | with frmMeds do
|
---|
| 2041 | begin
|
---|
| 2042 | SetUserBounds2(frmMeds.Name+'Split', panelBottom, panelMedIn, Dummy, Dummy);
|
---|
| 2043 | if (panelBottom > frmMeds.Height-50) then panelBottom := frmMeds.Height-50;
|
---|
| 2044 | if (panelMedIn > panelBottom-50) then panelMedIn := panelBottom-50;
|
---|
| 2045 | frmMeds.pnlBottom.Height := panelBottom;
|
---|
| 2046 | frmMeds.pnlMedIn.Height := panelMedIn;
|
---|
| 2047 | end;
|
---|
| 2048 |
|
---|
| 2049 | frmCover.DisableAlign;
|
---|
| 2050 | try
|
---|
| 2051 | SetUserBounds2(CoverSplitters1, s1, s2, s3, s4);
|
---|
| 2052 | if s1 > 0 then
|
---|
| 2053 | frmCover.pnl_1.Width := LowerOf( frmCover.pnl_not3.ClientWidth - 5, s1);
|
---|
| 2054 | if s2 > 0 then
|
---|
| 2055 | frmCover.pnl_3.Width := LowerOf( frmCover.pnlTop.ClientWidth - 5, s2);
|
---|
| 2056 | if s3 > 0 then
|
---|
| 2057 | frmCover.pnlTop.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s3);
|
---|
| 2058 | if s4 > 0 then
|
---|
| 2059 | frmCover.pnl_4.Width := LowerOf( frmCover.pnlMiddle.ClientWidth - 5, s4);
|
---|
| 2060 |
|
---|
| 2061 | SetUserBounds2(CoverSplitters2, s1, s2, s3, Dummy);
|
---|
| 2062 | if s1 > 0 then
|
---|
| 2063 | frmCover.pnlBottom.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s1);
|
---|
| 2064 | if s2 > 0 then
|
---|
| 2065 | frmCover.pnl_6.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s2);
|
---|
| 2066 | if s3 > 0 then
|
---|
| 2067 | frmCover.pnl_8.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s3);
|
---|
| 2068 |
|
---|
| 2069 | finally
|
---|
| 2070 | frmCover.EnableAlign;
|
---|
| 2071 | end;
|
---|
| 2072 | if ParamSearch('rez') = '640' then SetBounds(Left, Top, 648, 488); // for testing
|
---|
| 2073 | end;
|
---|
| 2074 |
|
---|
| 2075 | procedure TfrmFrame.SaveSizesForUser;
|
---|
| 2076 | var
|
---|
| 2077 | SizeList: TStringList;
|
---|
| 2078 | begin
|
---|
| 2079 | SaveUserFontSize(MainFontSize);
|
---|
| 2080 | SizeList := TStringList.Create;
|
---|
| 2081 | try
|
---|
| 2082 | with SizeList do
|
---|
| 2083 | begin
|
---|
| 2084 | Add(StrUserBounds(frmFrame));
|
---|
| 2085 | Add(StrUserWidth(frmProblems.pnlLeft));
|
---|
| 2086 | //Add(StrUserWidth(frmMeds.pnlLeft));
|
---|
| 2087 | Add(StrUserWidth(frmOrders.pnlLeft));
|
---|
| 2088 | Add(StrUserWidth(frmNotes.pnlLeft));
|
---|
| 2089 | Add(StrUserWidth(frmConsults.pnlLeft));
|
---|
| 2090 | Add(StrUserWidth(frmDCSumm.pnlLeft));
|
---|
| 2091 | if Assigned(frmSurgery) then Add(StrUserWidth(frmSurgery.pnlLeft));
|
---|
| 2092 | Add(StrUserWidth(frmLabs.pnlLeft));
|
---|
| 2093 | Add(StrUserWidth(frmReports.pnlLeft));
|
---|
| 2094 | Add(StrUserColumns(frmOrders.hdrOrders));
|
---|
| 2095 | Add(StrUserColumns(frmMeds.hdrMedsIn));
|
---|
| 2096 | Add(StrUserColumns(frmMeds.hdrMedsOut));
|
---|
| 2097 | Add(StrUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight));
|
---|
| 2098 | Add(StrUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight));
|
---|
| 2099 | Add(StrUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, 0 ,0));
|
---|
| 2100 | Add(StrUserBounds2(DrawerSplitters, frmNotes.Drawers.LastOpenSize,
|
---|
| 2101 | frmConsults.Drawers.LastOpenSize,
|
---|
| 2102 | frmDCSumm.Drawers.LastOpenSize,0));
|
---|
| 2103 | Add(StrUserBounds2(CoverSplitters1,
|
---|
| 2104 | frmCover.pnl_1.Width,
|
---|
| 2105 | frmCover.pnl_3.Width,
|
---|
| 2106 | frmCover.pnlTop.Height,
|
---|
| 2107 | frmCover.pnl_4.Width));
|
---|
| 2108 | Add(StrUserBounds2(CoverSplitters2,
|
---|
| 2109 | frmCover.pnlBottom.Height,
|
---|
| 2110 | frmCover.pnl_6.Width,
|
---|
| 2111 | frmCover.pnl_8.Width,
|
---|
| 2112 | 0));
|
---|
| 2113 |
|
---|
| 2114 | //Meds Tab Splitters
|
---|
| 2115 | Add(StrUserBounds2(frmMeds.Name+'Split',frmMeds.pnlBottom.Height,frmMeds.pnlMedIn.Height,0,0));
|
---|
| 2116 |
|
---|
| 2117 | if EnduringPtSelSplitterPos <> 0 then
|
---|
| 2118 | Add(StrUserBounds2('frmPtSel.sptVert', EnduringPtSelSplitterPos, 0, 0, 0));
|
---|
| 2119 | end;
|
---|
| 2120 | //Add sizes for forms that used SaveUserBounds() to save thier positions
|
---|
| 2121 | SizeHolder.AddSizesToStrList(SizeList);
|
---|
| 2122 | //Send the SizeList to the Database
|
---|
| 2123 | SaveUserSizes(SizeList);
|
---|
| 2124 | finally
|
---|
| 2125 | SizeList.Free;
|
---|
| 2126 | end;
|
---|
| 2127 | end;
|
---|
| 2128 |
|
---|
| 2129 | procedure TfrmFrame.FormResize(Sender: TObject);
|
---|
| 2130 | { need to resize tab forms specifically since they don't inherit resize event (because they
|
---|
| 2131 | are derived from TForm itself) }
|
---|
| 2132 | begin
|
---|
| 2133 | if FTerminate or FClosing then Exit;
|
---|
| 2134 | if csDestroying in ComponentState then Exit;
|
---|
| 2135 | MoveWindow(frmCover.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2136 | MoveWindow(frmProblems.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2137 | MoveWindow(frmMeds.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2138 | MoveWindow(frmOrders.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2139 | MoveWindow(frmNotes.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2140 | MoveWindow(frmConsults.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2141 | MoveWindow(frmDCSumm.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2142 | if Assigned(frmSurgery) then MoveWindow(frmSurgery.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2143 | MoveWindow(frmLabs.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2144 | MoveWindow(frmReports.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
|
---|
| 2145 | with stsArea do
|
---|
| 2146 | begin
|
---|
| 2147 | Panels[1].Width := stsArea.Width - FFixedStatusWidth;
|
---|
| 2148 | FNextButtonL := Panels[0].Width + Panels[1].Width;
|
---|
| 2149 | FNextButtonR := FNextButtonL + Panels[2].Width;
|
---|
| 2150 | end;
|
---|
| 2151 | lstCIRNLocations.Left := FNextButtonL - ScrollBarWidth - 100;
|
---|
| 2152 | lstCIRNLocations.Width := ClientWidth - lstCIRNLocations.Left;
|
---|
| 2153 | Self.Repaint;
|
---|
| 2154 | end;
|
---|
| 2155 |
|
---|
| 2156 | procedure TfrmFrame.ChangeFont(NewFontSize: Integer);
|
---|
| 2157 | { Makes changes in all components whenever the font size is changed. This is hardcoded and
|
---|
| 2158 | based on MS Sans Serif for now, as only the font size may be selected. Courier New is used
|
---|
| 2159 | wherever non-proportional fonts are required. }
|
---|
| 2160 | const
|
---|
| 2161 | TAB_VOFFSET = 7;
|
---|
| 2162 | var
|
---|
| 2163 | OldFont: TFont;
|
---|
| 2164 | begin
|
---|
| 2165 | // Ho ho! ResizeAnchoredFormToFont(self) doesn't work here because the
|
---|
| 2166 | // Form size is aliased with MainFormSize.
|
---|
| 2167 | OldFont := TFont.Create;
|
---|
| 2168 | try
|
---|
| 2169 | DisableAlign;
|
---|
| 2170 | try
|
---|
| 2171 | OldFont.Assign(Font);
|
---|
| 2172 | with Self do Font.Size := NewFontSize;
|
---|
| 2173 | with lblPtName do Font.Size := NewFontSize; // must change BOLDED labels by hand
|
---|
| 2174 | with lblPtSSN do Font.Size := NewFontSize;
|
---|
| 2175 | with lblPtAge do Font.Size := NewFontSize;
|
---|
| 2176 | with lblPtLocation do Font.Size := NewFontSize;
|
---|
| 2177 | with lblPtProvider do Font.Size := NewFontSize;
|
---|
| 2178 | with lblPtPostings do Font.Size := NewFontSize;
|
---|
| 2179 | with lblPtCare do Font.Size := NewFontSize;
|
---|
| 2180 | with lblPtAttending do Font.Size := NewFontSize;
|
---|
| 2181 | with lblFlag do Font.Size := NewFontSize;
|
---|
| 2182 | with lblPtCWAD do Font.Size := NewFontSize;
|
---|
| 2183 | with lblCIRN do Font.Size := NewFontSize;
|
---|
| 2184 | with lblCIRNData do Font.Size := NewFontSize;
|
---|
| 2185 | with lstCIRNLocations do Font.Size := NewFontSize;
|
---|
| 2186 | with tabPage do Font.Size := NewFontSize;
|
---|
| 2187 |
|
---|
| 2188 | tabPage.Height := MainFontHeight + TAB_VOFFSET; // resize tab selector
|
---|
| 2189 | FitToolbar; // resize toolbar
|
---|
| 2190 | stsArea.Font.Size := NewFontSize;
|
---|
| 2191 | stsArea.Height := MainFontHeight + TAB_VOFFSET;
|
---|
| 2192 | stsArea.Panels[0].Width := ResizeWidth( OldFont, Font, stsArea.Panels[0].Width);
|
---|
| 2193 | stsArea.Panels[2].Width := ResizeWidth( OldFont, Font, stsArea.Panels[2].Width);
|
---|
| 2194 | RefreshFixedStatusWidth;
|
---|
| 2195 | FormResize( self );
|
---|
| 2196 | finally
|
---|
| 2197 | EnableAlign;
|
---|
| 2198 | end;
|
---|
| 2199 | finally
|
---|
| 2200 | OldFont.Free;
|
---|
| 2201 | end;
|
---|
| 2202 |
|
---|
| 2203 | //remove CWAD color if using high-contrast colors
|
---|
| 2204 | if ColorToRGB(clWindowText) <> ColorToRGB(clBlack) then
|
---|
| 2205 | begin
|
---|
| 2206 | lblPtCWAD.Font.Color := clWindowText;
|
---|
| 2207 | lblFlag.Font.Color := clWindowText;
|
---|
| 2208 | end;
|
---|
| 2209 |
|
---|
| 2210 | //Now that the form elements are resized, the pages will know what size to take.
|
---|
| 2211 | frmCover.SetFontSize(NewFontSize); // child pages lack a ParentFont property
|
---|
| 2212 | frmProblems.SetFontSize(NewFontSize);
|
---|
| 2213 | frmMeds.SetFontSize(NewFontSize);
|
---|
| 2214 | frmOrders.SetFontSize(NewFontSize);
|
---|
| 2215 | frmNotes.SetFontSize(NewFontSize);
|
---|
| 2216 | frmConsults.SetFontSize(NewFontSize);
|
---|
| 2217 | frmDCSumm.SetFontSize(NewFontSize);
|
---|
| 2218 | if Assigned(frmSurgery) then frmSurgery.SetFontSize(NewFontSize);
|
---|
| 2219 | frmLabs.SetFontSize(NewFontSize);
|
---|
| 2220 | frmReports.SetFontSize(NewFontSize);
|
---|
| 2221 | TfrmIconLegend.SetFontSize(NewFontSize);
|
---|
| 2222 | uOrders.SetFontSize(NewFontSize);
|
---|
| 2223 | if Assigned(frmRemDlg) then frmRemDlg.SetFontSize;
|
---|
| 2224 | if Assigned(frmReminderTree) then frmReminderTree.SetFontSize(NewFontSize);
|
---|
| 2225 | end;
|
---|
| 2226 |
|
---|
| 2227 | procedure TfrmFrame.FitToolBar;
|
---|
| 2228 | { resizes and repositions the panels & labels used in the toolbar }
|
---|
| 2229 | const
|
---|
| 2230 | PATIENT_WIDTH = 29;
|
---|
| 2231 | VISIT_WIDTH = 36;
|
---|
| 2232 | POSTING_WIDTH = 11.5;
|
---|
| 2233 | FLAG_WIDTH =5;
|
---|
| 2234 | CIRN_WIDTH = 7;
|
---|
| 2235 | LINES_HIGH = 2;
|
---|
| 2236 | M_HORIZ = 4;
|
---|
| 2237 | M_MIDDLE = 2;
|
---|
| 2238 | M_NVERT = 4;
|
---|
| 2239 | M_WVERT = 6;
|
---|
| 2240 | TINY_MARGIN = 2;
|
---|
| 2241 | var
|
---|
| 2242 | WidthNeeded: integer;
|
---|
| 2243 | begin
|
---|
| 2244 | pnlToolbar.Height := (LINES_HIGH * lblPtName.Height) + M_HORIZ + M_MIDDLE + M_HORIZ;
|
---|
| 2245 | pnlPatient.Width := HigherOf(PATIENT_WIDTH * MainFontWidth, lblPtName.Width + (M_WVERT * 2));
|
---|
| 2246 | lblPtSSN.Top := M_HORIZ + lblPtName.Height + M_MIDDLE;
|
---|
| 2247 | lblPtAge.Top := lblPtSSN.Top;
|
---|
| 2248 | lblPtAge.Left := pnlPatient.Width - lblPtAge.Width - M_WVERT;
|
---|
| 2249 | pnlVisit.Width := HigherOf(LowerOf(VISIT_WIDTH * MainFontWidth,
|
---|
| 2250 | HigherOf(lblPtProvider.Width + (M_WVERT * 2),
|
---|
| 2251 | lblPtLocation.Width + (M_WVERT * 2))),
|
---|
| 2252 | PATIENT_WIDTH * MainFontWidth);
|
---|
| 2253 | lblPtProvider.Top := lblPtSSN.Top;
|
---|
| 2254 | lblPtAttending.Top := lblPtSSN.Top;
|
---|
| 2255 | lblCIRNData.Top := lblPtSSN.Top;
|
---|
| 2256 | pnlPostings.Width := Round(POSTING_WIDTH * MainFontWidth);
|
---|
| 2257 | pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
|
---|
| 2258 | pnlFlag.Width := Round(FLAG_WIDTH * MainFontWidth);
|
---|
| 2259 | pnlCIRN.Width := Round(CIRN_WIDTH * MainFontWidth) + M_WVERT;
|
---|
| 2260 | with lblPtPostings do
|
---|
| 2261 | SetBounds(M_WVERT, M_HORIZ, pnlPostings.Width-M_WVERT-M_WVERT, lblPtName.Height);
|
---|
| 2262 | with lblPtCWAD do
|
---|
| 2263 | SetBounds(M_WVERT, lblPtSSN.Top, lblPtPostings.Width, lblPtName.Height);
|
---|
| 2264 | //Low resolution handling: First, try to fit everything on by shrinking fields
|
---|
| 2265 | if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
|
---|
| 2266 | begin
|
---|
| 2267 | lblPtAge.Left := lblPtAge.Left - (lblPtName.Left - TINY_MARGIN);
|
---|
| 2268 | lblPtName.Left := TINY_MARGIN;
|
---|
| 2269 | lblPTSSN.Left := TINY_MARGIN;
|
---|
| 2270 | pnlPatient.Width := HigherOf( lblPtName.Left + lblPtName.Width, lblPtAge.Left + lblPtAge.Width)+ TINY_MARGIN;
|
---|
| 2271 | lblPtLocation.Left := TINY_MARGIN;
|
---|
| 2272 | lblPtProvider.Left := TINY_MARGIN;
|
---|
| 2273 | pnlVisit.Width := HigherOf( lblPtLocation.Left + lblPtLocation.Width, lblPtProvider.Left + lblPtProvider.Width)+ TINY_MARGIN;
|
---|
| 2274 | end;
|
---|
| 2275 | //If that is not enough, add scroll bars to form
|
---|
| 2276 | if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
|
---|
| 2277 | begin
|
---|
| 2278 | WidthNeeded := HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN - pnlPrimaryCare.Width;
|
---|
| 2279 | HorzScrollBar.Range := ClientWidth + WidthNeeded;
|
---|
| 2280 | Width := Width + WidthNeeded;
|
---|
| 2281 | end
|
---|
| 2282 | else
|
---|
| 2283 | HorzScrollBar.Range := 0;
|
---|
| 2284 | end;
|
---|
| 2285 |
|
---|
| 2286 | { Temporary Calls -------------------------------------------------------------------------- }
|
---|
| 2287 |
|
---|
| 2288 | procedure TfrmFrame.mnuFontSizeClick(Sender: TObject);
|
---|
| 2289 | begin
|
---|
| 2290 | if (frmRemDlg <> nil) then
|
---|
| 2291 | ShowMessage('Please close the reminder dialog before changing font sizes.')
|
---|
| 2292 | else if (dlgProbs <> nil) then
|
---|
| 2293 | ShowMessage('Font size cannot be changed while adding or editing a problem.')
|
---|
| 2294 | else
|
---|
| 2295 | with Sender as TMenuItem do ChangeFont(Tag);
|
---|
| 2296 | end;
|
---|
| 2297 |
|
---|
| 2298 | procedure TfrmFrame.mnuEditClick(Sender: TObject);
|
---|
| 2299 | var
|
---|
| 2300 | IsReadOnly: Boolean;
|
---|
| 2301 | begin
|
---|
| 2302 | FEditCtrl := nil;
|
---|
| 2303 | if Screen.ActiveControl is TCustomEdit then FEditCtrl := TCustomEdit(Screen.ActiveControl);
|
---|
| 2304 | if FEditCtrl <> nil then
|
---|
| 2305 | begin
|
---|
| 2306 | if FEditCtrl is TMemo then IsReadOnly := TMemo(FEditCtrl).ReadOnly
|
---|
| 2307 | else if FEditCtrl is TEdit then IsReadOnly := TEdit(FEditCtrl).ReadOnly
|
---|
| 2308 | else if FEditCtrl is TRichEdit then IsReadOnly := TRichEdit(FEditCtrl).ReadOnly
|
---|
| 2309 | else IsReadOnly := True;
|
---|
| 2310 | mnuEditUndo.Enabled := FEditCtrl.Perform(EM_CANUNDO, 0, 0) <> 0;
|
---|
| 2311 | mnuEditCut.Enabled := FEditCtrl.SelLength > 0;
|
---|
| 2312 | mnuEditCopy.Enabled := mnuEditCut.Enabled;
|
---|
| 2313 | mnuEditPaste.Enabled := (IsReadOnly = False) and Clipboard.HasFormat(CF_TEXT);
|
---|
| 2314 | end else
|
---|
| 2315 | begin
|
---|
| 2316 | mnuEditUndo.Enabled := False;
|
---|
| 2317 | mnuEditCut.Enabled := False;
|
---|
| 2318 | mnuEditCopy.Enabled := False;
|
---|
| 2319 | mnuEditPaste.Enabled := False;
|
---|
| 2320 | end;
|
---|
| 2321 | end;
|
---|
| 2322 |
|
---|
| 2323 | procedure TfrmFrame.mnuEditUndoClick(Sender: TObject);
|
---|
| 2324 | begin
|
---|
| 2325 | FEditCtrl.Perform(EM_UNDO, 0, 0);
|
---|
| 2326 | end;
|
---|
| 2327 |
|
---|
| 2328 | procedure TfrmFrame.mnuEditCutClick(Sender: TObject);
|
---|
| 2329 | begin
|
---|
| 2330 | FEditCtrl.CutToClipboard;
|
---|
| 2331 | end;
|
---|
| 2332 |
|
---|
| 2333 | procedure TfrmFrame.mnuEditCopyClick(Sender: TObject);
|
---|
| 2334 | begin
|
---|
| 2335 | FEditCtrl.CopyToClipboard;
|
---|
| 2336 | end;
|
---|
| 2337 |
|
---|
| 2338 | procedure TfrmFrame.mnuEditPasteClick(Sender: TObject);
|
---|
| 2339 | begin
|
---|
| 2340 | FEditCtrl.SelText := Clipboard.AsText;
|
---|
| 2341 | //FEditCtrl.PasteFromClipboard; // use AsText to prevent formatting from being pasted
|
---|
| 2342 | end;
|
---|
| 2343 |
|
---|
| 2344 | procedure TfrmFrame.mnuFilePrintClick(Sender: TObject);
|
---|
| 2345 | begin
|
---|
| 2346 | case mnuFilePrint.Tag of
|
---|
| 2347 | CT_NOTES: frmNotes.RequestPrint;
|
---|
| 2348 | CT_CONSULTS: frmConsults.RequestPrint;
|
---|
| 2349 | CT_DCSUMM: frmDCSumm.RequestPrint;
|
---|
| 2350 | CT_REPORTS: frmReports.RequestPrint;
|
---|
| 2351 | CT_LABS: frmLabs.RequestPrint;
|
---|
| 2352 | CT_ORDERS: frmOrders.RequestPrint;
|
---|
| 2353 | CT_PROBLEMS: frmProblems.RequestPrint;
|
---|
| 2354 | CT_SURGERY: if Assigned(frmSurgery) then frmSurgery.RequestPrint;
|
---|
| 2355 | end;
|
---|
| 2356 | end;
|
---|
| 2357 |
|
---|
| 2358 | function TfrmFrame.FormHelp(Command: Word; Data: Integer;
|
---|
| 2359 | var CallHelp: Boolean): Boolean;
|
---|
| 2360 | var
|
---|
| 2361 | ActiveForm: TForm;
|
---|
| 2362 | begin
|
---|
| 2363 | inherited;
|
---|
| 2364 | if Screen.ActiveForm <> nil then
|
---|
| 2365 | begin
|
---|
| 2366 | if Screen.ActiveForm.ActiveControl <> nil then
|
---|
| 2367 | begin
|
---|
| 2368 | if Screen.ActiveForm.ActiveControl is TForm then
|
---|
| 2369 | ActiveForm := TForm(Screen.ActiveForm.ActiveControl)
|
---|
| 2370 | else if Screen.ActiveForm.ActiveControl.Owner is TForm then
|
---|
| 2371 | ActiveForm := TForm(Screen.ActiveForm.ActiveControl.Owner)
|
---|
| 2372 | else
|
---|
| 2373 | ActiveForm := Screen.ActiveForm;
|
---|
| 2374 | end
|
---|
| 2375 | else
|
---|
| 2376 | ActiveForm := Screen.ActiveForm;
|
---|
| 2377 | HelpFile := ActiveForm.HelpFile;
|
---|
| 2378 | end ;
|
---|
| 2379 | Result := True;
|
---|
| 2380 | end;
|
---|
| 2381 |
|
---|
| 2382 | procedure TfrmFrame.WMSysCommand(var Message: TMessage);
|
---|
| 2383 | begin
|
---|
| 2384 | case TabToPageID(tabPage.TabIndex) of
|
---|
| 2385 | CT_NOTES:
|
---|
| 2386 | if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
|
---|
| 2387 | with Message do
|
---|
| 2388 | begin
|
---|
| 2389 | SendMessage(frmNotes.Handle, Msg, WParam, LParam);
|
---|
| 2390 | Result := 0;
|
---|
| 2391 | end
|
---|
| 2392 | else
|
---|
| 2393 | inherited;
|
---|
| 2394 | CT_DCSUMM:
|
---|
| 2395 | if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboAttending') then
|
---|
| 2396 | with Message do
|
---|
| 2397 | begin
|
---|
| 2398 | SendMessage(frmDCSumm.Handle, Msg, WParam, lParam);
|
---|
| 2399 | Result := 0;
|
---|
| 2400 | end
|
---|
| 2401 | else
|
---|
| 2402 | inherited;
|
---|
| 2403 | CT_CONSULTS:
|
---|
| 2404 | if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
|
---|
| 2405 | with Message do
|
---|
| 2406 | begin
|
---|
| 2407 | SendMessage(frmConsults.Handle, Msg, WParam, lParam);
|
---|
| 2408 | Result := 0;
|
---|
| 2409 | end
|
---|
| 2410 | else
|
---|
| 2411 | inherited;
|
---|
| 2412 | else
|
---|
| 2413 | inherited;
|
---|
| 2414 | end;
|
---|
| 2415 | end;
|
---|
| 2416 |
|
---|
| 2417 | procedure TfrmFrame.mnuViewRemindersClick(Sender: TObject);
|
---|
| 2418 | begin
|
---|
| 2419 | ViewReminderTree;
|
---|
| 2420 | end;
|
---|
| 2421 |
|
---|
| 2422 | procedure TfrmFrame.RemindersChanged(Sender: TObject);
|
---|
| 2423 | var
|
---|
| 2424 | ImgName: string;
|
---|
| 2425 |
|
---|
| 2426 | begin
|
---|
| 2427 | pnlReminders.tag := HAVE_REMINDERS;
|
---|
| 2428 | pnlReminders.Hint := 'Click to display reminders';
|
---|
| 2429 | case GetReminderStatus of
|
---|
| 2430 | rsUnknown:
|
---|
| 2431 | begin
|
---|
| 2432 | ImgName := 'BMP_REMINDERS_UNKNOWN';
|
---|
| 2433 | pnlReminders.Caption := 'Reminders';
|
---|
| 2434 | end;
|
---|
| 2435 | rsDue:
|
---|
| 2436 | begin
|
---|
| 2437 | ImgName := 'BMP_REMINDERS_DUE';
|
---|
| 2438 | pnlReminders.Caption := 'Due Reminders';
|
---|
| 2439 | end;
|
---|
| 2440 | rsApplicable:
|
---|
| 2441 | begin
|
---|
| 2442 | ImgName := 'BMP_REMINDERS_APPLICABLE';
|
---|
| 2443 | pnlReminders.Caption := 'Applicable Reminders';
|
---|
| 2444 | end;
|
---|
| 2445 | rsNotApplicable:
|
---|
| 2446 | begin
|
---|
| 2447 | ImgName := 'BMP_REMINDERS_OTHER';
|
---|
| 2448 | pnlReminders.Caption := 'Other Reminders';
|
---|
| 2449 | end;
|
---|
| 2450 | else
|
---|
| 2451 | begin
|
---|
| 2452 | ImgName := 'BMP_REMINDERS_NONE';
|
---|
| 2453 | pnlReminders.Hint := 'There are currently no reminders available';
|
---|
| 2454 | pnlReminders.Caption := pnlReminders.Hint;
|
---|
| 2455 | pnlReminders.tag := NO_REMINDERS;
|
---|
| 2456 | end;
|
---|
| 2457 | end;
|
---|
| 2458 | if(RemindersEvaluatingInBackground) then
|
---|
| 2459 | begin
|
---|
| 2460 | if(anmtRemSearch.ResName = '') then
|
---|
| 2461 | begin
|
---|
| 2462 | TORExposedAnimate(anmtRemSearch).OnMouseDown := pnlRemindersMouseDown;
|
---|
| 2463 | TORExposedAnimate(anmtRemSearch).OnMouseUp := pnlRemindersMouseUp;
|
---|
| 2464 | anmtRemSearch.ResHandle := 0;
|
---|
| 2465 | anmtRemSearch.ResName := 'REMSEARCHAVI';
|
---|
| 2466 | end;
|
---|
| 2467 | imgReminder.Visible := FALSE;
|
---|
| 2468 | anmtRemSearch.Active := TRUE;
|
---|
| 2469 | anmtRemSearch.Visible := TRUE;
|
---|
| 2470 | if(pnlReminders.Hint <> '') then
|
---|
| 2471 | pnlReminders.Hint := CRLF + pnlReminders.Hint + '.';
|
---|
| 2472 | pnlReminders.Hint := 'Evaluating Reminders... ' + pnlReminders.Hint;
|
---|
| 2473 | pnlReminders.Caption := pnlReminders.Hint;
|
---|
| 2474 | end
|
---|
| 2475 | else
|
---|
| 2476 | begin
|
---|
| 2477 | anmtRemSearch.Visible := FALSE;
|
---|
| 2478 | imgReminder.Visible := TRUE;
|
---|
| 2479 | imgReminder.Picture.Bitmap.LoadFromResourceName(hInstance, ImgName);
|
---|
| 2480 | anmtRemSearch.Active := FALSE;
|
---|
| 2481 | end;
|
---|
| 2482 | mnuViewReminders.Enabled := (pnlReminders.tag = HAVE_REMINDERS);
|
---|
| 2483 | end;
|
---|
| 2484 |
|
---|
| 2485 | procedure TfrmFrame.pnlRemindersMouseDown(Sender: TObject;
|
---|
| 2486 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 2487 | begin
|
---|
| 2488 | if(not InitialRemindersLoaded) then
|
---|
| 2489 | StartupReminders;
|
---|
| 2490 | if(pnlReminders.tag = HAVE_REMINDERS) then
|
---|
| 2491 | pnlReminders.BevelOuter := bvLowered;
|
---|
| 2492 | end;
|
---|
| 2493 |
|
---|
| 2494 | procedure TfrmFrame.pnlRemindersMouseUp(Sender: TObject;
|
---|
| 2495 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 2496 | begin
|
---|
| 2497 | pnlReminders.BevelOuter := bvRaised;
|
---|
| 2498 | if(pnlReminders.tag = HAVE_REMINDERS) then
|
---|
| 2499 | mnuViewRemindersClick(Self);
|
---|
| 2500 | end;
|
---|
| 2501 |
|
---|
| 2502 | //--------------------- CIRN-related procedures --------------------------------
|
---|
| 2503 |
|
---|
| 2504 | procedure TfrmFrame.SetUpCIRN;
|
---|
| 2505 | var
|
---|
| 2506 | i: integer;
|
---|
| 2507 | ASite: TRemoteSite;
|
---|
| 2508 | begin
|
---|
| 2509 | with RemoteSites do
|
---|
| 2510 | begin
|
---|
| 2511 | ChangePatient(Patient.DFN);
|
---|
| 2512 | if RemoteDataExists and (RemoteSites.Count > 0) then
|
---|
| 2513 | begin
|
---|
| 2514 | lblCIRN.Enabled := True;
|
---|
| 2515 | lblCIRNData.Enabled := True;
|
---|
| 2516 | pnlCIRN.TabStop := True;
|
---|
| 2517 | if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
|
---|
| 2518 | begin
|
---|
| 2519 | lblCIRN.Font.Color := clBlue;
|
---|
| 2520 | lblCIRNData.Font.Color := clBlue;
|
---|
| 2521 | lstCIRNLocations.Font.Color := clBlue;
|
---|
| 2522 | end
|
---|
| 2523 | else
|
---|
| 2524 | begin
|
---|
| 2525 | lblCIRN.Font.Color := clWindowText;
|
---|
| 2526 | lblCIRNData.Font.Color := clWindowText;
|
---|
| 2527 | lstCIRNLocations.Font.Color := clWindowText;
|
---|
| 2528 | end;
|
---|
| 2529 | pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
|
---|
| 2530 | if RemoteSites.Count > 0 then
|
---|
| 2531 | lstCIRNLocations.Items.Add('0' + U + 'All Available Sites');
|
---|
| 2532 | for i := 0 to RemoteSites.Count - 1 do
|
---|
| 2533 | begin
|
---|
| 2534 | ASite := TRemoteSite(SiteList[i]);
|
---|
| 2535 | lstCIRNLocations.Items.Add(ASite.SiteID + U + ASite.SiteName + U +
|
---|
| 2536 | FormatFMDateTime('mmm dd yyyy hh:nn', ASite.LastDate));
|
---|
| 2537 | end;
|
---|
| 2538 | end
|
---|
| 2539 | else
|
---|
| 2540 | begin
|
---|
| 2541 | lblCIRN.Font.Color := clWindowText;
|
---|
| 2542 | lblCIRNData.Font.Color := clWindowText;
|
---|
| 2543 | lblCIRN.Enabled := False;
|
---|
| 2544 | lblCIRNData.Enabled := False;
|
---|
| 2545 | pnlCIRN.TabStop := False;
|
---|
| 2546 | pnlCIRN.Hint := NoDataReason;
|
---|
| 2547 | end;
|
---|
| 2548 | end;
|
---|
| 2549 | end;
|
---|
| 2550 |
|
---|
| 2551 | procedure TfrmFrame.pnlCIRNClick(Sender: TObject);
|
---|
| 2552 | begin
|
---|
| 2553 | if not RemoteSites.RemoteDataExists then Exit;
|
---|
| 2554 | if (not lstCIRNLocations.Visible) then
|
---|
| 2555 | begin
|
---|
| 2556 | pnlCIRN.BevelOuter := bvLowered;
|
---|
| 2557 | lstCIRNLocations.Visible := True;
|
---|
| 2558 | lstCIRNLocations.BringToFront;
|
---|
| 2559 | lstCIRNLocations.SetFocus;
|
---|
| 2560 | pnlCIRN.Hint := 'Click to close list.';
|
---|
| 2561 | end
|
---|
| 2562 | else
|
---|
| 2563 | begin
|
---|
| 2564 | pnlCIRN.BevelOuter := bvRaised;
|
---|
| 2565 | lstCIRNLocations.Visible := False;
|
---|
| 2566 | lstCIRNLocations.SendToBack;
|
---|
| 2567 | pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
|
---|
| 2568 | end
|
---|
| 2569 | end;
|
---|
| 2570 |
|
---|
| 2571 | procedure TfrmFrame.lstCIRNLocationsClick(Sender: TObject);
|
---|
| 2572 | const
|
---|
| 2573 | DGSR_FAIL = -1;
|
---|
| 2574 | DGSR_NONE = 0;
|
---|
| 2575 | DGSR_SHOW = 1;
|
---|
| 2576 | DGSR_ASK = 2;
|
---|
| 2577 | DGSR_DENY = 3;
|
---|
| 2578 | var
|
---|
| 2579 | iIndex,j,iAll,iCur: integer;
|
---|
| 2580 | aMsg,s: string;
|
---|
| 2581 | AccessStatus: integer;
|
---|
| 2582 | begin
|
---|
| 2583 | iAll := 0;
|
---|
| 2584 | AccessStatus := 0;
|
---|
| 2585 | if not CheckHL7TCPLink then
|
---|
| 2586 | begin
|
---|
| 2587 | InfoBox('Local HL7 TCP Link is down.' + CRLF + 'Unable to retrieve remote data.', TC_DGSR_ERR, MB_OK);
|
---|
| 2588 | lstCIRNLocations.Checked[lstCIRNLocations.ItemIndex] := false;
|
---|
| 2589 | Exit;
|
---|
| 2590 | end;
|
---|
| 2591 | if lstCIRNLocations.Items.Count > 0 then
|
---|
| 2592 | if piece(lstCIRNLocations.Items[0],'^',1) = '0' then
|
---|
| 2593 | iAll := 1;
|
---|
| 2594 | iIndex := lstCIRNLocations.ItemIndex;
|
---|
| 2595 | with frmReports do
|
---|
| 2596 | if piece(uRemoteType,'^',2) = 'V' then
|
---|
| 2597 | begin
|
---|
| 2598 | lvReports.Items.BeginUpdate;
|
---|
| 2599 | lvReports.Items.Clear;
|
---|
| 2600 | lvReports.Columns.Clear;
|
---|
| 2601 | lvReports.Items.EndUpdate;
|
---|
| 2602 | end;
|
---|
| 2603 | uReportInstruction := '';
|
---|
| 2604 | frmReports.TabControl1.Tabs.Clear;
|
---|
| 2605 | frmLabs.TabControl1.Tabs.Clear;
|
---|
| 2606 | frmReports.TabControl1.Tabs.AddObject('Local',nil);
|
---|
| 2607 | frmLabs.TabControl1.Tabs.AddObject('Local',nil);
|
---|
| 2608 | StatusText('Checking Remote Sites...');
|
---|
| 2609 | if piece(lstCIRNLocations.Items[iIndex],'^',1) = '0' then // All sites have been clicked
|
---|
| 2610 | if lstCIRNLocations.Checked[iIndex] = false then // All selection is being turned off
|
---|
| 2611 | begin
|
---|
| 2612 | with RemoteSites.SiteList do
|
---|
| 2613 | for j := 0 to Count - 1 do
|
---|
| 2614 | if lstCIRNLocations.Checked[j+1] = true then
|
---|
| 2615 | begin
|
---|
| 2616 | lstCIRNLocations.Checked[j+1] := false;
|
---|
| 2617 | TRemoteSite(RemoteSites.SiteList[j]).Selected := false;
|
---|
| 2618 | TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
|
---|
| 2619 | TRemoteSite(RemoteSites.SiteList[j]).LabClear;
|
---|
| 2620 | end;
|
---|
| 2621 | end
|
---|
| 2622 | else
|
---|
| 2623 | begin
|
---|
| 2624 | with RemoteSites.SiteList do
|
---|
| 2625 | for j := 0 to Count - 1 do
|
---|
| 2626 | begin
|
---|
| 2627 | Screen.Cursor := crHourGlass;
|
---|
| 2628 | {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[j]).SiteID,
|
---|
| 2629 | AccessStatus);}
|
---|
| 2630 | Screen.Cursor := crDefault;
|
---|
| 2631 | aMsg := aMsg + ' at site: ' + TRemoteSite(Items[j]).SiteName;
|
---|
| 2632 | s := lstCIRNLocations.Items[j+1];
|
---|
| 2633 | lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3);
|
---|
| 2634 | case AccessStatus of
|
---|
| 2635 | DGSR_FAIL: begin
|
---|
| 2636 | if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
|
---|
| 2637 | begin
|
---|
| 2638 | lstCIRNLocations.Checked[j+1] := true;
|
---|
| 2639 | TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
|
---|
| 2640 | TRemoteSite(RemoteSites.SiteList[j]).LabClear;
|
---|
| 2641 | TRemoteSite(Items[j]).Selected := true;
|
---|
| 2642 | end
|
---|
| 2643 | else
|
---|
| 2644 | begin
|
---|
| 2645 | InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
|
---|
| 2646 | lstCIRNLocations.Checked[j+1] := false;
|
---|
| 2647 | lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
|
---|
| 2648 | TRemoteSite(Items[j]).Selected := false;
|
---|
| 2649 | Continue;
|
---|
| 2650 | end;
|
---|
| 2651 | end;
|
---|
| 2652 | DGSR_NONE: begin
|
---|
| 2653 | lstCIRNLocations.Checked[j+1] := true;
|
---|
| 2654 | TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
|
---|
| 2655 | TRemoteSite(RemoteSites.SiteList[j]).LabClear;
|
---|
| 2656 | TRemoteSite(Items[j]).Selected := true;
|
---|
| 2657 | end;
|
---|
| 2658 | DGSR_SHOW: begin
|
---|
| 2659 | InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
|
---|
| 2660 | lstCIRNLocations.Checked[j+1] := true;
|
---|
| 2661 | TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
|
---|
| 2662 | TRemoteSite(RemoteSites.SiteList[j]).LabClear;
|
---|
| 2663 | TRemoteSite(Items[j]).Selected := true;
|
---|
| 2664 | end;
|
---|
| 2665 | DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
|
---|
| 2666 | MB_DEFBUTTON2) = IDYES then
|
---|
| 2667 | begin
|
---|
| 2668 | lstCIRNLocations.Checked[j+1] := true;
|
---|
| 2669 | TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
|
---|
| 2670 | TRemoteSite(RemoteSites.SiteList[j]).LabClear;
|
---|
| 2671 | TRemoteSite(Items[j]).Selected := true;
|
---|
| 2672 | end
|
---|
| 2673 | else
|
---|
| 2674 | begin
|
---|
| 2675 | lstCIRNLocations.Checked[j+1] := false;
|
---|
| 2676 | lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
|
---|
| 2677 | TRemoteSite(Items[j]).Selected := false;
|
---|
| 2678 | Continue;
|
---|
| 2679 | end;
|
---|
| 2680 | else begin
|
---|
| 2681 | InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
|
---|
| 2682 | lstCIRNLocations.Checked[j+1] := false;
|
---|
| 2683 | lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
|
---|
| 2684 | TRemoteSite(Items[j]).Selected := false;
|
---|
| 2685 | Continue;
|
---|
| 2686 | end;
|
---|
| 2687 | end;
|
---|
| 2688 | end;
|
---|
| 2689 | end
|
---|
| 2690 | else
|
---|
| 2691 | begin
|
---|
| 2692 | if iIndex > -1 then
|
---|
| 2693 | begin
|
---|
| 2694 | iCur := iIndex - iAll;
|
---|
| 2695 | TRemoteSite(RemoteSites.SiteList[iCur]).Selected :=
|
---|
| 2696 | lstCIRNLocations.Checked[iIndex];
|
---|
| 2697 | if lstCIRNLocations.Checked[iIndex] = true then
|
---|
| 2698 | with RemoteSites.SiteList do
|
---|
| 2699 | begin
|
---|
| 2700 | Screen.Cursor := crHourGlass;
|
---|
| 2701 | {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[iCur]).SiteID,
|
---|
| 2702 | AccessStatus);}
|
---|
| 2703 | Screen.Cursor := crDefault;
|
---|
| 2704 | aMsg := aMsg + ' at site: ' + TRemoteSite(Items[iCur]).SiteName;
|
---|
| 2705 | s := lstCIRNLocations.Items[iIndex];
|
---|
| 2706 | lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3);
|
---|
| 2707 | case AccessStatus of
|
---|
| 2708 | DGSR_FAIL: begin
|
---|
| 2709 | if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
|
---|
| 2710 | begin
|
---|
| 2711 | lstCIRNLocations.Checked[iIndex] := true;
|
---|
| 2712 | TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
|
---|
| 2713 | TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
|
---|
| 2714 | TRemoteSite(Items[iCur]).Selected := true;
|
---|
| 2715 | end
|
---|
| 2716 | else
|
---|
| 2717 | begin
|
---|
| 2718 | InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
|
---|
| 2719 | lstCIRNLocations.Checked[iIndex] := false;
|
---|
| 2720 | lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
|
---|
| 2721 | TRemoteSite(Items[iCur]).Selected := false;
|
---|
| 2722 | end;
|
---|
| 2723 | end;
|
---|
| 2724 | DGSR_NONE: begin
|
---|
| 2725 | lstCIRNLocations.Checked[iIndex] := true;
|
---|
| 2726 | TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
|
---|
| 2727 | TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
|
---|
| 2728 | TRemoteSite(Items[iCur]).Selected := true;
|
---|
| 2729 | end;
|
---|
| 2730 | DGSR_SHOW: begin
|
---|
| 2731 | InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
|
---|
| 2732 | lstCIRNLocations.Checked[iIndex] := true;
|
---|
| 2733 | TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
|
---|
| 2734 | TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
|
---|
| 2735 | TRemoteSite(Items[iCur]).Selected := true;
|
---|
| 2736 | end;
|
---|
| 2737 | DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
|
---|
| 2738 | MB_DEFBUTTON2) = IDYES then
|
---|
| 2739 | begin
|
---|
| 2740 | lstCIRNLocations.Checked[iIndex] := true;
|
---|
| 2741 | TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
|
---|
| 2742 | TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
|
---|
| 2743 | TRemoteSite(Items[iCur]).Selected := true;
|
---|
| 2744 | end
|
---|
| 2745 | else
|
---|
| 2746 | begin
|
---|
| 2747 | lstCIRNLocations.Checked[iIndex] := false;
|
---|
| 2748 | lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
|
---|
| 2749 | end;
|
---|
| 2750 | else begin
|
---|
| 2751 | InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
|
---|
| 2752 | lstCIRNLocations.Checked[iIndex] := false;
|
---|
| 2753 | lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
|
---|
| 2754 | TRemoteSite(Items[iCur]).Selected := false;
|
---|
| 2755 | end;
|
---|
| 2756 | end;
|
---|
| 2757 | with frmReports do
|
---|
| 2758 | if piece(uRemoteType,'^',1) = '1' then
|
---|
| 2759 | if not(piece(uRemoteType,'^',2) = 'V') then
|
---|
| 2760 | begin
|
---|
| 2761 | TabControl1.Visible := true;
|
---|
| 2762 | pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
|
---|
| 2763 | end;
|
---|
| 2764 | with frmLabs do
|
---|
| 2765 | if lstReports.ItemIndex > -1 then
|
---|
| 2766 | if piece(lstReports.Items[lstReports.ItemIndex],'^',3) = '1' then
|
---|
| 2767 | if not(piece(lstReports.Items[lstReports.ItemIndex],'^',5) = 'V') then
|
---|
| 2768 | TabControl1.Visible := true;
|
---|
| 2769 | end;
|
---|
| 2770 | end;
|
---|
| 2771 | end;
|
---|
| 2772 | with RemoteSites.SiteList do
|
---|
| 2773 | for j := 0 to Count - 1 do
|
---|
| 2774 | if TRemoteSite(Items[j]).Selected then
|
---|
| 2775 | begin
|
---|
| 2776 | frmReports.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
|
---|
| 2777 | TRemoteSite(Items[j]));
|
---|
| 2778 | frmLabs.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
|
---|
| 2779 | TRemoteSite(Items[j]));
|
---|
| 2780 | end;
|
---|
| 2781 | frmLabs.TabControl1.OnChange(nil);
|
---|
| 2782 | frmReports.TabControl1.OnChange(nil);
|
---|
| 2783 | StatusText('');
|
---|
| 2784 | end;
|
---|
| 2785 |
|
---|
| 2786 | procedure TfrmFrame.popCIRNCloseClick(Sender: TObject);
|
---|
| 2787 | begin
|
---|
| 2788 | lstCIRNLocations.Visible := False;
|
---|
| 2789 | lstCirnLocations.SendToBack;
|
---|
| 2790 | pnlCIRN.BevelOuter := bvRaised;
|
---|
| 2791 | end;
|
---|
| 2792 |
|
---|
| 2793 | procedure TfrmFrame.popCIRNSelectAllClick(Sender: TObject);
|
---|
| 2794 |
|
---|
| 2795 | begin
|
---|
| 2796 | lstCIRNLocations.ItemIndex := 0;
|
---|
| 2797 | lstCIRNLocations.Checked[0] := true;
|
---|
| 2798 | lstCIRNLocations.OnClick(Self);
|
---|
| 2799 | end;
|
---|
| 2800 |
|
---|
| 2801 | procedure TfrmFrame.popCIRNSelectNoneClick(Sender: TObject);
|
---|
| 2802 |
|
---|
| 2803 | begin
|
---|
| 2804 | lstCIRNLocations.ItemIndex := 0;
|
---|
| 2805 | lstCIRNLocations.Checked[0] := false;
|
---|
| 2806 | lstCIRNLocations.OnClick(Self);
|
---|
| 2807 | end;
|
---|
| 2808 |
|
---|
| 2809 | procedure TfrmFrame.mnuFilePrintSetupClick(Sender: TObject);
|
---|
| 2810 | var
|
---|
| 2811 | CurrPrt: string;
|
---|
| 2812 | begin
|
---|
| 2813 | CurrPrt := SelectDevice(Self, Encounter.Location, True,'');
|
---|
| 2814 | User.CurrentPrinter := Piece(CurrPrt, U, 1);
|
---|
| 2815 | end;
|
---|
| 2816 |
|
---|
| 2817 | procedure TfrmFrame.lstCIRNLocationsChange(Sender: TObject);
|
---|
| 2818 | begin
|
---|
| 2819 | if lstCIRNLocations.ItemIndex > -1 then
|
---|
| 2820 | if (lstCIRNLocations.Selected[lstCIRNLocations.ItemIndex] = true) and (uUpdateStat = false) then
|
---|
| 2821 | if not (piece(lstCIRNLocations.Items[0],'^',1) = '0') then
|
---|
| 2822 | lstCIRNLocations.OnClick(nil);
|
---|
| 2823 | end;
|
---|
| 2824 |
|
---|
| 2825 | procedure TfrmFrame.LabInfo1Click(Sender: TObject);
|
---|
| 2826 | begin
|
---|
| 2827 | ExecuteLabInfo;
|
---|
| 2828 | end;
|
---|
| 2829 |
|
---|
| 2830 | procedure TfrmFrame.mnuFileNotifRemoveClick(Sender: TObject);
|
---|
| 2831 | const
|
---|
| 2832 | TC_REMOVE_ALERT = 'Remove Current Alert';
|
---|
| 2833 | TX_REMOVE_ALERT1 = 'This action will delete the alert you are currently processing; the alert will ' + CRLF +
|
---|
| 2834 | 'disappear automatically when all orders have been acted on, but this action may' + CRLF +
|
---|
| 2835 | 'be used to remove the alert if some orders are to be left unchanged.' + CRLF + CRLF +
|
---|
| 2836 | 'Your ';
|
---|
| 2837 | TX_REMOVE_ALERT2 = ' alert for ';
|
---|
| 2838 | TX_REMOVE_ALERT3 = ' will be deleted!' + CRLF + CRLF + 'Are you sure?';
|
---|
| 2839 | var
|
---|
| 2840 | AlertMsg, AlertType: string;
|
---|
| 2841 |
|
---|
| 2842 | procedure StopProcessingNotifs;
|
---|
| 2843 | begin
|
---|
| 2844 | Notifications.Clear;
|
---|
| 2845 | FNextButtonActive := False;
|
---|
| 2846 | stsArea.Panels[2].Bevel := pbLowered;
|
---|
| 2847 | mnuFileNext.Enabled := False;
|
---|
| 2848 | mnuFileNotifRemove.Enabled := False;
|
---|
| 2849 | end;
|
---|
| 2850 |
|
---|
| 2851 | begin
|
---|
| 2852 | if not Notifications.Active then Exit;
|
---|
| 2853 | case Notifications.Followup of
|
---|
| 2854 | NF_MEDICATIONS_EXPIRING : AlertType := 'Expiring Medications';
|
---|
| 2855 | NF_ORDER_REQUIRES_ELEC_SIGNATURE: AlertType := 'Unsigned Orders';
|
---|
| 2856 | NF_FLAGGED_ORDERS : AlertType := 'Flagged Orders (for clarification)';
|
---|
| 2857 | NF_UNVERIFIED_MEDICATION_ORDER : AlertType := 'Unverified Medication Order';
|
---|
| 2858 | NF_UNVERIFIED_ORDER : AlertType := 'Unverified Order';
|
---|
| 2859 | NF_FLAGGED_OI_EXP_INPT : AlertType := 'Flagged Orderable Item (INPT)';
|
---|
| 2860 | NF_FLAGGED_OI_EXP_OUTPT : AlertType := 'Flagged Orderable Item (OUTPT)';
|
---|
| 2861 | else
|
---|
| 2862 | Exit;
|
---|
| 2863 | end;
|
---|
| 2864 | AlertMsg := TX_REMOVE_ALERT1 + AlertType + TX_REMOVE_ALERT2 + Patient.Name + TX_REMOVE_ALERT3;
|
---|
| 2865 | if InfoBox(AlertMsg, TC_REMOVE_ALERT, MB_YESNO) = ID_YES then
|
---|
| 2866 | begin
|
---|
| 2867 | Notifications.DeleteForCurrentUser;
|
---|
| 2868 | Notifications.Next; // avoid prompt if no more alerts selected to process {v14a RV}
|
---|
| 2869 | if Notifications.Active then
|
---|
| 2870 | begin
|
---|
| 2871 | if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
|
---|
| 2872 | begin
|
---|
| 2873 | Notifications.Prior;
|
---|
| 2874 | mnuFileNextClick(Self);
|
---|
| 2875 | end
|
---|
| 2876 | else
|
---|
| 2877 | StopProcessingNotifs;
|
---|
| 2878 | end
|
---|
| 2879 | else
|
---|
| 2880 | StopProcessingNotifs;
|
---|
| 2881 | end;
|
---|
| 2882 | end;
|
---|
| 2883 |
|
---|
| 2884 | procedure TfrmFrame.mnuToolsOptionsClick(Sender: TObject);
|
---|
| 2885 | // personal preferences - changes may need to be applied to chart
|
---|
| 2886 | var
|
---|
| 2887 | i: integer;
|
---|
| 2888 | begin
|
---|
| 2889 | i := 0;
|
---|
| 2890 | DialogOptions(i);
|
---|
| 2891 | end;
|
---|
| 2892 |
|
---|
| 2893 | procedure TfrmFrame.LoadUserPreferences;
|
---|
| 2894 | begin
|
---|
| 2895 | LoadSizesForUser;
|
---|
| 2896 | // LoadUserVitalPreferences;
|
---|
| 2897 | GetUserTemplateDefaults(TRUE);
|
---|
| 2898 | end;
|
---|
| 2899 |
|
---|
| 2900 | procedure TfrmFrame.SaveUserPreferences;
|
---|
| 2901 | begin
|
---|
| 2902 | SaveSizesForUser; // position & size settings
|
---|
| 2903 | // SaveUserVitalPreferences; // save Vitals metric setting
|
---|
| 2904 | SaveUserTemplateDefaults;
|
---|
| 2905 | end;
|
---|
| 2906 |
|
---|
| 2907 | procedure TfrmFrame.mnuFileRefreshClick(Sender: TObject);
|
---|
| 2908 | begin
|
---|
| 2909 | FRefreshing := TRUE;
|
---|
| 2910 | try
|
---|
| 2911 | mnuFileOpenClick(Self);
|
---|
| 2912 | finally
|
---|
| 2913 | FRefreshing := FALSE;
|
---|
| 2914 | end;
|
---|
| 2915 | end;
|
---|
| 2916 |
|
---|
| 2917 | procedure TfrmFrame.AppActivated(Sender: TObject);
|
---|
| 2918 | begin
|
---|
| 2919 | if assigned(FOldActivate) then
|
---|
| 2920 | FOldActivate(Sender);
|
---|
| 2921 | SetActiveWindow(Application.Handle);
|
---|
| 2922 | end;
|
---|
| 2923 |
|
---|
| 2924 | // close Treatment Factor hint window if alt-tab pressed.
|
---|
| 2925 | procedure TfrmFrame.AppDeActivated(Sender: TObject);
|
---|
| 2926 | begin
|
---|
| 2927 | if FRVTFhintWindowActive then
|
---|
| 2928 | begin
|
---|
| 2929 | FRVTFHintWindow.ReleaseHandle;
|
---|
| 2930 | FRVTFHintWindowActive := False;
|
---|
| 2931 | end
|
---|
| 2932 | else
|
---|
| 2933 | if FOSTFHintWndActive then
|
---|
| 2934 | begin
|
---|
| 2935 | FOSTFhintWindow.ReleaseHandle;
|
---|
| 2936 | FOSTFHintWndActive := False ;
|
---|
| 2937 |
|
---|
| 2938 | end;
|
---|
| 2939 | end;
|
---|
| 2940 |
|
---|
| 2941 | (*procedure TfrmFrame.CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
|
---|
| 2942 | begin
|
---|
| 2943 | AnInstance := TPage.Create(Self);
|
---|
| 2944 | TPage(AnInstance).Parent := pnlPage;
|
---|
| 2945 | TPage(AnInstance).Show;
|
---|
| 2946 | uTabList.Add(IntToStr(ATabID));
|
---|
| 2947 | tabPage.Tabs.Add(ALabel);
|
---|
| 2948 | end;*)
|
---|
| 2949 |
|
---|
| 2950 | procedure TfrmFrame.CreateTab(ATabID: integer; ALabel: string);
|
---|
| 2951 | begin
|
---|
| 2952 | // old comment - try making owner self (instead of application) to see if solves TMenuItem.Insert bug
|
---|
| 2953 | case ATabID of
|
---|
| 2954 | CT_PROBLEMS : begin
|
---|
| 2955 | frmProblems := TfrmProblems.Create(Self);
|
---|
| 2956 | frmProblems.Parent := pnlPage;
|
---|
| 2957 | end;
|
---|
| 2958 | CT_MEDS : begin
|
---|
| 2959 | frmMeds := TfrmMeds.Create(Self);
|
---|
| 2960 | frmMeds.Parent := pnlPage;
|
---|
| 2961 | frmMeds.InitfMedsSize;
|
---|
| 2962 | end;
|
---|
| 2963 | CT_ORDERS : begin
|
---|
| 2964 | frmOrders := TfrmOrders.Create(Self);
|
---|
| 2965 | frmOrders.Parent := pnlPage;
|
---|
| 2966 | end;
|
---|
| 2967 | CT_HP : begin
|
---|
| 2968 | // not yet
|
---|
| 2969 | end;
|
---|
| 2970 | CT_NOTES : begin
|
---|
| 2971 | frmNotes := TfrmNotes.Create(Self);
|
---|
| 2972 | frmNotes.Parent := pnlPage;
|
---|
| 2973 | end;
|
---|
| 2974 | CT_CONSULTS : begin
|
---|
| 2975 | frmConsults := TfrmConsults.Create(Self);
|
---|
| 2976 | frmConsults.Parent := pnlPage;
|
---|
| 2977 | end;
|
---|
| 2978 | CT_DCSUMM : begin
|
---|
| 2979 | frmDCSumm := TfrmDCSumm.Create(Self);
|
---|
| 2980 | frmDCSumm.Parent := pnlPage;
|
---|
| 2981 | end;
|
---|
| 2982 | CT_LABS : begin
|
---|
| 2983 | frmLabs := TfrmLabs.Create(Self);
|
---|
| 2984 | frmLabs.Parent := pnlPage;
|
---|
| 2985 | end;
|
---|
| 2986 | CT_REPORTS : begin
|
---|
| 2987 | frmReports := TfrmReports.Create(Self);
|
---|
| 2988 | frmReports.Parent := pnlPage;
|
---|
| 2989 | end;
|
---|
| 2990 | CT_SURGERY : begin
|
---|
| 2991 | frmSurgery := TfrmSurgery.Create(Self);
|
---|
| 2992 | frmSurgery.Parent := pnlPage;
|
---|
| 2993 | end;
|
---|
| 2994 | CT_COVER : begin
|
---|
| 2995 | frmCover := TfrmCover.Create(Self);
|
---|
| 2996 | frmCover.Parent := pnlPage;
|
---|
| 2997 | end;
|
---|
| 2998 | else
|
---|
| 2999 | Exit;
|
---|
| 3000 | end;
|
---|
| 3001 | if ATabID = CT_COVER then
|
---|
| 3002 | begin
|
---|
| 3003 | uTabList.Insert(0, IntToStr(ATabID));
|
---|
| 3004 | tabPage.Tabs.Insert(0, ALabel);
|
---|
| 3005 | tabPage.TabIndex := 0;
|
---|
| 3006 | end
|
---|
| 3007 | else
|
---|
| 3008 | begin
|
---|
| 3009 | uTabList.Add(IntToStr(ATabID));
|
---|
| 3010 | tabPage.Tabs.Add(ALabel);
|
---|
| 3011 | end;
|
---|
| 3012 | end;
|
---|
| 3013 |
|
---|
| 3014 | procedure TfrmFrame.ShowHideChartTabMenus(AMenuItem: TMenuItem);
|
---|
| 3015 | var
|
---|
| 3016 | i: integer;
|
---|
| 3017 | begin
|
---|
| 3018 | for i := 0 to AMenuItem.Count - 1 do
|
---|
| 3019 | AMenuItem.Items[i].Visible := TabExists(AMenuItem.Items[i].Tag);
|
---|
| 3020 | end;
|
---|
| 3021 |
|
---|
| 3022 | function TfrmFrame.TabExists(ATabID: integer): boolean;
|
---|
| 3023 | begin
|
---|
| 3024 | Result := (uTabList.IndexOf(IntToStr(ATabID)) > -1)
|
---|
| 3025 | end;
|
---|
| 3026 |
|
---|
| 3027 | procedure TfrmFrame.ReportsOnlyDisplay;
|
---|
| 3028 | begin
|
---|
| 3029 |
|
---|
| 3030 | // Configure "Edit" menu:
|
---|
| 3031 | menuHideAllBut(mnuEdit, mnuEditPref); // Hide everything under Edit menu except Preferences.
|
---|
| 3032 | menuHideAllBut(mnuEditPref, Prefs1); // Hide everything under Preferences menu except Fonts.
|
---|
| 3033 |
|
---|
| 3034 | // Remaining pull-down menus:
|
---|
| 3035 | mnuView.visible := false;
|
---|
| 3036 | mnuFileRefresh.visible := false;
|
---|
| 3037 | mnuFileEncounter.visible := false;
|
---|
| 3038 | mnuFileReview.visible := false;
|
---|
| 3039 | mnuFileNext.visible := false;
|
---|
| 3040 | mnuFileNotifRemove.visible := false;
|
---|
| 3041 | mnuHelpBroker.visible := false;
|
---|
| 3042 | mnuHelpLists.visible := false;
|
---|
| 3043 | mnuHelpSymbols.visible := false;
|
---|
| 3044 |
|
---|
| 3045 | // Top panel components:
|
---|
| 3046 | //pnlVisit.visible := false;
|
---|
| 3047 | pnlVisit.hint := 'Provider/Location';
|
---|
| 3048 | pnlVisit.onMouseDown := nil;
|
---|
| 3049 | pnlVisit.onMouseUp := nil;
|
---|
| 3050 | //pnlPrimaryCare.visible := false;
|
---|
| 3051 | //pnlPostings.visible := false;
|
---|
| 3052 | //lblPtCWAD.visible := false;
|
---|
| 3053 | //lblPtPostings.visible := false;
|
---|
| 3054 | //pnlReminders.visible := false;
|
---|
| 3055 | //anmtRemSearch.visible := false;
|
---|
| 3056 |
|
---|
| 3057 | // Forms for other tabs:
|
---|
| 3058 | frmCover.visible := false;
|
---|
| 3059 | frmProblems.visible := false;
|
---|
| 3060 | frmMeds.visible := false;
|
---|
| 3061 | frmOrders.visible := false;
|
---|
| 3062 | frmNotes.visible := false;
|
---|
| 3063 | frmConsults.visible := false;
|
---|
| 3064 | frmDCSumm.visible := false;
|
---|
| 3065 | if Assigned(frmSurgery) then
|
---|
| 3066 | frmSurgery.visible := false;
|
---|
| 3067 | frmLabs.visible := false;
|
---|
| 3068 |
|
---|
| 3069 | // Other tabs (so to speak):
|
---|
| 3070 | tabPage.tabs.clear;
|
---|
| 3071 | tabPage.tabs.add('Reports');
|
---|
| 3072 |
|
---|
| 3073 | end;
|
---|
| 3074 |
|
---|
| 3075 | procedure TfrmFrame.UpdatePtInfoOnRefresh;
|
---|
| 3076 | var
|
---|
| 3077 | tmpDFN: string;
|
---|
| 3078 | begin
|
---|
| 3079 | tmpDFN := Patient.DFN;
|
---|
| 3080 | Patient.Clear;
|
---|
| 3081 | Patient.DFN := tmpDFN;
|
---|
| 3082 |
|
---|
| 3083 | if (FPrevInPatient and Patient.Inpatient) then //transfering inside hospital
|
---|
| 3084 | Encounter.Location := Patient.Location
|
---|
| 3085 | else if (FPrevInPatient and (not Patient.Inpatient)) then //patient was discharged
|
---|
| 3086 | begin
|
---|
| 3087 | Encounter.Inpatient := False;
|
---|
| 3088 | Encounter.Location := 0;
|
---|
| 3089 | FPrevInPatient := False;
|
---|
| 3090 | end
|
---|
| 3091 | else if ((not FPrevInPatient) and Patient.Inpatient) then //patient was admitted
|
---|
| 3092 | begin
|
---|
| 3093 | Encounter.Inpatient := True;
|
---|
| 3094 | Encounter.Location := Patient.Location;
|
---|
| 3095 | Encounter.DateTime := Patient.AdmitTime;
|
---|
| 3096 | Encounter.VisitCategory := 'H';
|
---|
| 3097 | FPrevInPatient := True;
|
---|
| 3098 | end;
|
---|
| 3099 | //if User.IsProvider then Encounter.Provider := ;
|
---|
| 3100 | DisplayEncounterText;
|
---|
| 3101 | end;
|
---|
| 3102 |
|
---|
| 3103 | procedure TfrmFrame.FormKeyDown(Sender: TObject; var Key: Word;
|
---|
| 3104 | Shift: TShiftState);
|
---|
| 3105 | var
|
---|
| 3106 | NewTabIndex: integer;
|
---|
| 3107 | begin
|
---|
| 3108 | //CQ2844: Toggle Remote Data button using Alt+R
|
---|
| 3109 | case Key of
|
---|
| 3110 | 82,114: begin
|
---|
| 3111 | if (ssAlt in Shift) then
|
---|
| 3112 | frmFrame.pnlCIRNClick(Sender);
|
---|
| 3113 | end;
|
---|
| 3114 | end;
|
---|
| 3115 |
|
---|
| 3116 | if (Key = VK_TAB) then begin
|
---|
| 3117 | if (ssCtrl in Shift) then begin
|
---|
| 3118 | if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
|
---|
| 3119 | NewTabIndex := tabPage.TabIndex;
|
---|
| 3120 | if ssShift in Shift then
|
---|
| 3121 | dec(NewTabIndex)
|
---|
| 3122 | else
|
---|
| 3123 | inc(NewTabIndex);
|
---|
| 3124 | if NewTabIndex >= tabPage.Tabs.Count then
|
---|
| 3125 | dec(NewTabIndex,tabPage.Tabs.Count)
|
---|
| 3126 | else if NewTabIndex < 0 then
|
---|
| 3127 | inc(NewTabIndex,tabPage.Tabs.Count);
|
---|
| 3128 | tabPage.TabIndex := NewTabIndex;
|
---|
| 3129 | tabPageChange(tabPage);
|
---|
| 3130 | Key := 0;
|
---|
| 3131 | end;
|
---|
| 3132 | end;
|
---|
| 3133 | end;
|
---|
| 3134 | end;
|
---|
| 3135 |
|
---|
| 3136 | procedure TfrmFrame.FormActivate(Sender: TObject);
|
---|
| 3137 | begin
|
---|
| 3138 | if Assigned(FLastPage) then
|
---|
| 3139 | FLastPage.FocusFirstControl;
|
---|
| 3140 | end;
|
---|
| 3141 |
|
---|
| 3142 | procedure TfrmFrame.pnlPrimaryCareEnter(Sender: TObject);
|
---|
| 3143 | begin
|
---|
| 3144 | with Sender as TPanel do
|
---|
| 3145 | if (ControlCount > 0) and (Controls[0] is TSpeedButton) and (TSpeedButton(Controls[0]).Down)
|
---|
| 3146 | then
|
---|
| 3147 | BevelInner := bvLowered
|
---|
| 3148 | else
|
---|
| 3149 | BevelInner := bvRaised;
|
---|
| 3150 | end;
|
---|
| 3151 |
|
---|
| 3152 | procedure TfrmFrame.pnlPrimaryCareExit(Sender: TObject);
|
---|
| 3153 | var
|
---|
| 3154 | ShiftIsDown,TabIsDown : boolean;
|
---|
| 3155 | begin
|
---|
| 3156 | with Sender as TPanel do begin
|
---|
| 3157 | BevelInner := bvNone;
|
---|
| 3158 | //Make the lstCIRNLocations act as if between pnlCIRN & pnlReminders
|
---|
| 3159 | //in the Tab Order
|
---|
| 3160 | if (lstCIRNLocations.CanFocus) then
|
---|
| 3161 | begin
|
---|
| 3162 | ShiftIsDown := Boolean(Hi(GetKeyState(VK_SHIFT)));
|
---|
| 3163 | TabIsDown := Boolean(Hi(GetKeyState(VK_TAB)));
|
---|
| 3164 | if TabIsDown then
|
---|
| 3165 | if (ShiftIsDown) and (Name = 'pnlReminders') then
|
---|
| 3166 | lstCIRNLocations.SetFocus
|
---|
| 3167 | else if Not (ShiftIsDown) and (Name = 'pnlCIRN') then
|
---|
| 3168 | lstCIRNLocations.SetFocus;
|
---|
| 3169 | end;
|
---|
| 3170 | end;
|
---|
| 3171 | end;
|
---|
| 3172 |
|
---|
| 3173 | procedure TfrmFrame.pnlPatientClick(Sender: TObject);
|
---|
| 3174 | begin
|
---|
| 3175 | mnuViewDemoClick(Self);
|
---|
| 3176 | end;
|
---|
| 3177 |
|
---|
| 3178 | procedure TfrmFrame.pnlVisitClick(Sender: TObject);
|
---|
| 3179 | begin
|
---|
| 3180 | if (not User.IsReportsOnly) then // Reports Only tab.
|
---|
| 3181 | mnuFileEncounterClick(Self);
|
---|
| 3182 | end;
|
---|
| 3183 |
|
---|
| 3184 | procedure TfrmFrame.pnlPrimaryCareClick(Sender: TObject);
|
---|
| 3185 | begin
|
---|
| 3186 | ReportBox(DetailPrimaryCare(Patient.DFN), 'Primary Care', True);
|
---|
| 3187 | end;
|
---|
| 3188 |
|
---|
| 3189 | procedure TfrmFrame.pnlRemindersClick(Sender: TObject);
|
---|
| 3190 | begin
|
---|
| 3191 | if(pnlReminders.tag = HAVE_REMINDERS) then
|
---|
| 3192 | mnuViewRemindersClick(Self);
|
---|
| 3193 | end;
|
---|
| 3194 |
|
---|
| 3195 | procedure TfrmFrame.pnlPostingsClick(Sender: TObject);
|
---|
| 3196 | begin
|
---|
| 3197 | mnuViewPostingsClick(Self);
|
---|
| 3198 | end;
|
---|
| 3199 |
|
---|
| 3200 | //=========================== CCOW main changes ========================
|
---|
| 3201 |
|
---|
| 3202 | procedure TfrmFrame.HandleCCOWError(AMessage: string);
|
---|
| 3203 | begin
|
---|
| 3204 | {$ifdef DEBUG}
|
---|
| 3205 | ShowMessage(AMessage);
|
---|
| 3206 | {$endif}
|
---|
| 3207 | InfoBox(TX_CCOW_ERROR, TC_CCOW_ERROR, MB_ICONERROR or MB_OK);
|
---|
| 3208 | FCCOWInstalled := False;
|
---|
| 3209 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_BROKEN');
|
---|
| 3210 | pnlCCOW.Hint := TX_CCOW_BROKEN;
|
---|
| 3211 | mnuFileResumeContext.Visible := True;
|
---|
| 3212 | mnuFileResumeContext.Enabled := False;
|
---|
| 3213 | mnuFileBreakContext.Visible := True;
|
---|
| 3214 | mnuFileBreakContext.Enabled := False;
|
---|
| 3215 | FCCOWError := True;
|
---|
| 3216 | end;
|
---|
| 3217 |
|
---|
| 3218 | function TfrmFrame.AllowCCOWContextChange(NewDFN: string): boolean;
|
---|
| 3219 | var
|
---|
| 3220 | PtData : IContextItemCollection;
|
---|
| 3221 | PtDataItem2, PtDataItem3, PtDataItem4 : IContextItem;
|
---|
| 3222 | response : UserResponse;
|
---|
| 3223 | StationNumber: string;
|
---|
| 3224 | IsProdAcct: boolean;
|
---|
| 3225 | begin
|
---|
| 3226 | Result := False;
|
---|
| 3227 | response := 0;
|
---|
| 3228 | try
|
---|
| 3229 | // Start a context change transaction
|
---|
| 3230 | if FCCOWInstalled then
|
---|
| 3231 | begin
|
---|
| 3232 | FCCOWError := False;
|
---|
| 3233 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
|
---|
| 3234 | pnlCCOW.Hint := TX_CCOW_CHANGING;
|
---|
| 3235 | try
|
---|
| 3236 | ctxContextor.StartContextChange();
|
---|
| 3237 | except
|
---|
| 3238 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3239 | end;
|
---|
| 3240 | if FCCOWError then
|
---|
| 3241 | begin
|
---|
| 3242 | Result := False;
|
---|
| 3243 | Exit;
|
---|
| 3244 | end;
|
---|
| 3245 | // Set the new proposed context data.
|
---|
| 3246 | PtData := CoContextItemCollection.Create();
|
---|
| 3247 | StationNumber := User.StationNumber;
|
---|
| 3248 | IsProdAcct := User.IsProductionAccount;
|
---|
| 3249 |
|
---|
| 3250 | PtDataItem2 := CoContextItem.Create();
|
---|
| 3251 | PtDataItem2.Set_Name('Patient.co.PatientName'); // Patient.Name
|
---|
| 3252 | PtDataItem2.Set_Value(Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^');
|
---|
| 3253 | PtData.Add(PtDataItem2);
|
---|
| 3254 |
|
---|
| 3255 | PtDataItem3 := CoContextItem.Create();
|
---|
| 3256 | if not IsProdAcct then
|
---|
| 3257 | PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber + '_TEST') // Patient.DFN
|
---|
| 3258 | else
|
---|
| 3259 | PtDataItem3.Set_Name('Patient.id.MRN.DFN_' + StationNumber); // Patient.DFN
|
---|
| 3260 | PtDataItem3.Set_Value(Patient.DFN);
|
---|
| 3261 | PtData.Add(PtDataItem3);
|
---|
| 3262 |
|
---|
| 3263 | if Patient.ICN <> '' then
|
---|
| 3264 | begin
|
---|
| 3265 | PtDataItem4 := CoContextItem.Create();
|
---|
| 3266 | if not IsProdAcct then
|
---|
| 3267 | PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber_TEST') // Patient.ICN
|
---|
| 3268 | else
|
---|
| 3269 | PtDataItem4.Set_Name('Patient.id.MRN.NationalIDNumber'); // Patient.ICN
|
---|
| 3270 | PtDataItem4.Set_Value(Patient.ICN);
|
---|
| 3271 | PtData.Add(PtDataItem4);
|
---|
| 3272 | end;
|
---|
| 3273 |
|
---|
| 3274 | // End the context change transaction.
|
---|
| 3275 | FCCOWError := False;
|
---|
| 3276 | try
|
---|
| 3277 | response := ctxContextor.EndContextChange(true, PtData);
|
---|
| 3278 | except
|
---|
| 3279 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3280 | end;
|
---|
| 3281 | if FCCOWError then
|
---|
| 3282 | begin
|
---|
| 3283 | HideEverything;
|
---|
| 3284 | Result := False;
|
---|
| 3285 | Exit;
|
---|
| 3286 | end;
|
---|
| 3287 | end
|
---|
| 3288 | else
|
---|
| 3289 | //response := urBreak;
|
---|
| 3290 | begin
|
---|
| 3291 | Result := True;
|
---|
| 3292 | Exit;
|
---|
| 3293 | end;
|
---|
| 3294 |
|
---|
| 3295 | if (response = UrCommit) then
|
---|
| 3296 | begin
|
---|
| 3297 | // New context is committed.
|
---|
| 3298 | //ShowMessage('Response was Commit');
|
---|
| 3299 | mnuFileResumeContext.Enabled := False;
|
---|
| 3300 | mnuFileBreakContext.Enabled := True;
|
---|
| 3301 | FCCOWIconName := 'BMP_CCOW_LINKED';
|
---|
| 3302 | pnlCCOW.Hint := TX_CCOW_LINKED;
|
---|
| 3303 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3304 | Result := True;
|
---|
| 3305 | end
|
---|
| 3306 | else if (response = UrCancel) then
|
---|
| 3307 | begin
|
---|
| 3308 | // Proposed context change is canceled. Return to the current context.
|
---|
| 3309 | PtData.RemoveAll;
|
---|
| 3310 | mnuFileResumeContext.Enabled := False;
|
---|
| 3311 | mnuFileBreakContext.Enabled := True;
|
---|
| 3312 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3313 | Result := False;
|
---|
| 3314 | end
|
---|
| 3315 | else if (response = UrBreak) then
|
---|
| 3316 | begin
|
---|
| 3317 | // The contextor has broken the link by suspending. This app should
|
---|
| 3318 | // update the Clinical Link icon, enable the Resume menu item, and
|
---|
| 3319 | // disable the Suspend menu item.
|
---|
| 3320 | PtData.RemoveAll;
|
---|
| 3321 | mnuFileResumeContext.Enabled := True;
|
---|
| 3322 | mnuFileBreakContext.Enabled := False;
|
---|
| 3323 | FCCOWIconName := 'BMP_CCOW_BROKEN';
|
---|
| 3324 | pnlCCOW.Hint := TX_CCOW_BROKEN;
|
---|
| 3325 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3326 | if Patient.Inpatient then
|
---|
| 3327 | begin
|
---|
| 3328 | Encounter.Inpatient := True;
|
---|
| 3329 | Encounter.Location := Patient.Location;
|
---|
| 3330 | Encounter.DateTime := Patient.AdmitTime;
|
---|
| 3331 | Encounter.VisitCategory := 'H';
|
---|
| 3332 | end;
|
---|
| 3333 | if User.IsProvider then Encounter.Provider := User.DUZ;
|
---|
| 3334 | SetupPatient;
|
---|
| 3335 | tabPage.TabIndex := PageIDToTab(User.InitialTab);
|
---|
| 3336 | tabPageChange(tabPage);
|
---|
| 3337 | Result := False;
|
---|
| 3338 | end;
|
---|
| 3339 | except
|
---|
| 3340 | on exc : EOleException do
|
---|
| 3341 | //ShowMessage('EOleException: ' + exc.Message + ' - ' + string(exc.ErrorCode) );
|
---|
| 3342 | ShowMessage('EOleException: ' + exc.Message);
|
---|
| 3343 | end;
|
---|
| 3344 | end;
|
---|
| 3345 |
|
---|
| 3346 | procedure TfrmFrame.ctxContextorCanceled(Sender: TObject);
|
---|
| 3347 | begin
|
---|
| 3348 | // Application should maintain its state as the current (existing) context.
|
---|
| 3349 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3350 | end;
|
---|
| 3351 |
|
---|
| 3352 | procedure TfrmFrame.ctxContextorPending(Sender: TObject;
|
---|
| 3353 | const aContextItemCollection: IDispatch);
|
---|
| 3354 | var
|
---|
| 3355 | Reason, HyperLinkReason: string;
|
---|
| 3356 | PtChanged: boolean;
|
---|
| 3357 | begin
|
---|
| 3358 | // If the app would lose data, or have other problems changing context at
|
---|
| 3359 | // this time, it should return a message using SetSurveyReponse. Note that the
|
---|
| 3360 | // user may decide to commit the context change anyway.
|
---|
| 3361 | //
|
---|
| 3362 | // if (cannot-change-context-without-a-problem) then
|
---|
| 3363 | // contextor.SetSurveyResponse('Conditional accept reason...');
|
---|
| 3364 | if FCCOWBusy then
|
---|
| 3365 | begin
|
---|
| 3366 | Sleep(10000);
|
---|
| 3367 | end;
|
---|
| 3368 |
|
---|
| 3369 | FCCOWError := False;
|
---|
| 3370 | try
|
---|
| 3371 | CheckForDifferentPatient(aContextItemCollection, PtChanged);
|
---|
| 3372 | except
|
---|
| 3373 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3374 | end;
|
---|
| 3375 | if FCCOWError then
|
---|
| 3376 | begin
|
---|
| 3377 | HideEverything;
|
---|
| 3378 | Exit;
|
---|
| 3379 | end;
|
---|
| 3380 |
|
---|
| 3381 | if PtChanged then
|
---|
| 3382 | begin
|
---|
| 3383 | FCCOWContextChanging := True;
|
---|
| 3384 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, 'BMP_CCOW_CHANGING');
|
---|
| 3385 | pnlCCOW.Hint := TX_CCOW_CHANGING;
|
---|
| 3386 | AllowContextChangeAll(Reason);
|
---|
| 3387 | end;
|
---|
| 3388 | CheckHyperlinkResponse(aContextItemCollection, HyperlinkReason);
|
---|
| 3389 | Reason := HyperlinkReason + Reason;
|
---|
| 3390 | if Pos('COM_OBJECT_ACTIVE', Reason) > 0 then
|
---|
| 3391 | Sleep(12000)
|
---|
| 3392 | else if Length(Reason) > 0 then
|
---|
| 3393 | ctxContextor.SetSurveyResponse(Reason);
|
---|
| 3394 | FCCOWContextChanging := False;
|
---|
| 3395 | end;
|
---|
| 3396 |
|
---|
| 3397 | procedure TfrmFrame.ctxContextorCommitted(Sender: TObject);
|
---|
| 3398 | var
|
---|
| 3399 | Reason: string;
|
---|
| 3400 | PtChanged: boolean;
|
---|
| 3401 | i: integer;
|
---|
| 3402 | begin
|
---|
| 3403 | // Application should now access the new context and update its state.
|
---|
| 3404 | FCCOWError := False;
|
---|
| 3405 | try
|
---|
| 3406 | CheckForDifferentPatient(ctxContextor.CurrentContext, PtChanged);
|
---|
| 3407 | except
|
---|
| 3408 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3409 | end;
|
---|
| 3410 | if FCCOWError then
|
---|
| 3411 | begin
|
---|
| 3412 | HideEverything;
|
---|
| 3413 | Exit;
|
---|
| 3414 | end;
|
---|
| 3415 | if not PtChanged then exit;
|
---|
| 3416 | FCCOWDrivedChange := True;
|
---|
| 3417 | i := 0;
|
---|
| 3418 | while Length(Screen.Forms[i].Name) > 0 do
|
---|
| 3419 | begin
|
---|
| 3420 | if fsModal in Screen.Forms[i].FormState then
|
---|
| 3421 | begin
|
---|
| 3422 | Screen.Forms[i].ModalResult := mrCancel;
|
---|
| 3423 | i := i + 1;
|
---|
| 3424 | end else // the fsModal forms always sequenced prior to the none-fsModal forms
|
---|
| 3425 | Break;
|
---|
| 3426 | end;
|
---|
| 3427 | Reason := 'COMMIT';
|
---|
| 3428 | if AllowContextChangeAll(Reason) then UpdateCCOWContext;
|
---|
| 3429 | FCCOWIconName := 'BMP_CCOW_LINKED';
|
---|
| 3430 | pnlCCOW.Hint := TX_CCOW_LINKED;
|
---|
| 3431 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3432 | end;
|
---|
| 3433 |
|
---|
| 3434 | //function TfrmFrame.FindBestCCOWDFN(var APatientName: string): string;
|
---|
| 3435 | function TfrmFrame.FindBestCCOWDFN: string;
|
---|
| 3436 | var
|
---|
| 3437 | data: IContextItemCollection;
|
---|
| 3438 | anItem: IContextItem;
|
---|
| 3439 | StationNumber, tempDFN: string;
|
---|
| 3440 | IsProdAcct: Boolean;
|
---|
| 3441 |
|
---|
| 3442 | procedure FindNextBestDFN;
|
---|
| 3443 | begin
|
---|
| 3444 | StationNumber := User.StationNumber;
|
---|
| 3445 | if IsProdAcct then
|
---|
| 3446 | anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber)
|
---|
| 3447 | else
|
---|
| 3448 | anItem := data.Present('Patient.id.MRN.DFN_' + StationNumber + '_TEST');
|
---|
| 3449 | if anItem <> nil then tempDFN := anItem.Get_Value();
|
---|
| 3450 | end;
|
---|
| 3451 |
|
---|
| 3452 | begin
|
---|
| 3453 | if uCore.User = nil then
|
---|
| 3454 | begin
|
---|
| 3455 | Result := '';
|
---|
| 3456 | exit;
|
---|
| 3457 | end;
|
---|
| 3458 | IsProdAcct := User.IsProductionAccount;
|
---|
| 3459 | // Get an item collection of the current context
|
---|
| 3460 | FCCOWError := False;
|
---|
| 3461 | try
|
---|
| 3462 | data := ctxContextor.CurrentContext;
|
---|
| 3463 | except
|
---|
| 3464 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3465 | end;
|
---|
| 3466 | if FCCOWError then
|
---|
| 3467 | begin
|
---|
| 3468 | HideEverything;
|
---|
| 3469 | Exit;
|
---|
| 3470 | end;
|
---|
| 3471 | // Retrieve the ContextItem name and value as strings
|
---|
| 3472 | if IsProdAcct then
|
---|
| 3473 | anItem := data.Present('Patient.id.MRN.NationalIDNumber')
|
---|
| 3474 | else
|
---|
| 3475 | anItem := data.Present('Patient.id.MRN.NationalIDNumber_TEST');
|
---|
| 3476 | if anItem <> nil then
|
---|
| 3477 | begin
|
---|
| 3478 | tempDFN := GetDFNFromICN(anItem.Get_Value()); // "Public" RPC call
|
---|
| 3479 | if tempDFN = '-1' then FindNextBestDFN;
|
---|
| 3480 | end
|
---|
| 3481 | else
|
---|
| 3482 | FindNextBestDFN;
|
---|
| 3483 | Result := tempDFN;
|
---|
| 3484 | (* anItem := data.Present('Patient.co.PatientName');
|
---|
| 3485 | if anItem <> nil then APatientName := anItem.Get_Value();*)
|
---|
| 3486 | data := nil;
|
---|
| 3487 | anItem := nil;
|
---|
| 3488 | end;
|
---|
| 3489 |
|
---|
| 3490 | procedure TfrmFrame.UpdateCCOWContext;
|
---|
| 3491 | var
|
---|
| 3492 | PtDFN(*, PtName*): string;
|
---|
| 3493 | begin
|
---|
| 3494 | if not FCCOWInstalled then exit;
|
---|
| 3495 | //PtDFN := FindBestCCOWDFN(PtName);
|
---|
| 3496 | PtDFN := FindBestCCOWDFN;
|
---|
| 3497 | if PtDFN <> '' then
|
---|
| 3498 | begin
|
---|
| 3499 | // Select new patient based on context value
|
---|
| 3500 | if Patient.DFN = PtDFN then exit;
|
---|
| 3501 | Patient.DFN := PtDFN;
|
---|
| 3502 | //if (Patient.Name = '-1') or (PtName <> Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^') then
|
---|
| 3503 | if (Patient.Name = '-1') then
|
---|
| 3504 | begin
|
---|
| 3505 | HideEverything;
|
---|
| 3506 | exit;
|
---|
| 3507 | end
|
---|
| 3508 | else
|
---|
| 3509 | ShowEverything;
|
---|
| 3510 | Encounter.Clear;
|
---|
| 3511 | if Patient.Inpatient then
|
---|
| 3512 | begin
|
---|
| 3513 | Encounter.Inpatient := True;
|
---|
| 3514 | Encounter.Location := Patient.Location;
|
---|
| 3515 | Encounter.DateTime := Patient.AdmitTime;
|
---|
| 3516 | Encounter.VisitCategory := 'H';
|
---|
| 3517 | end;
|
---|
| 3518 | if User.IsProvider then Encounter.Provider := User.DUZ;
|
---|
| 3519 | SetupPatient;
|
---|
| 3520 | DetermineNextTab;
|
---|
| 3521 | tabPage.TabIndex := PageIDToTab(NextTab);
|
---|
| 3522 | tabPageChange(tabPage);
|
---|
| 3523 | end
|
---|
| 3524 | else
|
---|
| 3525 | HideEverything;
|
---|
| 3526 | end;
|
---|
| 3527 |
|
---|
| 3528 | procedure TfrmFrame.mnuFileBreakContextClick(Sender: TObject);
|
---|
| 3529 | begin
|
---|
| 3530 | FCCOWError := False;
|
---|
| 3531 | FCCOWIconName := 'BMP_CCOW_CHANGING';
|
---|
| 3532 | pnlCCOW.Hint := TX_CCOW_CHANGING;
|
---|
| 3533 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3534 | try
|
---|
| 3535 | ctxContextor.Suspend;
|
---|
| 3536 | except
|
---|
| 3537 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3538 | end;
|
---|
| 3539 | if FCCOWError then exit;
|
---|
| 3540 | FCCOWIconName := 'BMP_CCOW_BROKEN';
|
---|
| 3541 | pnlCCOW.Hint := TX_CCOW_BROKEN;
|
---|
| 3542 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3543 | mnuFileResumeContext.Enabled := True;
|
---|
| 3544 | mnuFileBreakContext.Enabled := False;
|
---|
| 3545 | end;
|
---|
| 3546 |
|
---|
| 3547 | procedure TfrmFrame.mnuFileResumeContextGetClick(Sender: TObject);
|
---|
| 3548 | var
|
---|
| 3549 | Reason: string;
|
---|
| 3550 | begin
|
---|
| 3551 | Reason := '';
|
---|
| 3552 | if not AllowContextChangeAll(Reason) then exit;
|
---|
| 3553 | FCCOWIconName := 'BMP_CCOW_CHANGING';
|
---|
| 3554 | pnlCCOW.Hint := TX_CCOW_CHANGING;
|
---|
| 3555 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3556 | FCCOWError := False;
|
---|
| 3557 | try
|
---|
| 3558 | ctxContextor.Resume;
|
---|
| 3559 | except
|
---|
| 3560 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3561 | end;
|
---|
| 3562 | if FCCOWError then exit;
|
---|
| 3563 | UpdateCCOWContext;
|
---|
| 3564 | FCCOWIconName := 'BMP_CCOW_LINKED';
|
---|
| 3565 | pnlCCOW.Hint := TX_CCOW_LINKED;
|
---|
| 3566 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3567 | mnuFileResumeContext.Enabled := False;
|
---|
| 3568 | mnuFileBreakContext.Visible := True;
|
---|
| 3569 | mnuFileBreakContext.Enabled := True;
|
---|
| 3570 | end;
|
---|
| 3571 |
|
---|
| 3572 | procedure TfrmFrame.mnuFileResumeContextSetClick(Sender: TObject);
|
---|
| 3573 | begin
|
---|
| 3574 | FCCOWIconName := 'BMP_CCOW_CHANGING';
|
---|
| 3575 | pnlCCOW.Hint := TX_CCOW_CHANGING;
|
---|
| 3576 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3577 | FCCOWError := False;
|
---|
| 3578 | try
|
---|
| 3579 | ctxContextor.Resume;
|
---|
| 3580 | except
|
---|
| 3581 | on E: Exception do HandleCCOWError(E.Message);
|
---|
| 3582 | end;
|
---|
| 3583 | if FCCOWError then exit;
|
---|
| 3584 | if (AllowCCOWContextChange(Patient.DFN)) then
|
---|
| 3585 | begin
|
---|
| 3586 | mnuFileResumeContext.Enabled := False;
|
---|
| 3587 | mnuFileBreakContext.Visible := True;
|
---|
| 3588 | mnuFileBreakContext.Enabled := True;
|
---|
| 3589 | FCCOWIconName := 'BMP_CCOW_LINKED';
|
---|
| 3590 | pnlCCOW.Hint := TX_CCOW_LINKED;
|
---|
| 3591 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3592 | end
|
---|
| 3593 | else
|
---|
| 3594 | begin
|
---|
| 3595 | mnuFileResumeContext.Enabled := True;
|
---|
| 3596 | mnuFileBreakContext.Enabled := False;
|
---|
| 3597 | FCCOWIconName := 'BMP_CCOW_BROKEN';
|
---|
| 3598 | pnlCCOW.Hint := TX_CCOW_BROKEN;
|
---|
| 3599 | imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
|
---|
| 3600 | end;
|
---|
| 3601 | SetupPatient;
|
---|
| 3602 | tabPage.TabIndex := PageIDToTab(User.InitialTab);
|
---|
| 3603 | tabPageChange(tabPage);
|
---|
| 3604 | end;
|
---|
| 3605 |
|
---|
| 3606 | procedure TfrmFrame.CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
|
---|
| 3607 | var
|
---|
| 3608 | data : IContextItemCollection;
|
---|
| 3609 | anItem : IContextItem;
|
---|
| 3610 | PtDFN, PtName: string;
|
---|
| 3611 | begin
|
---|
| 3612 | if uCore.Patient = nil then
|
---|
| 3613 | begin
|
---|
| 3614 | PtChanged := False;
|
---|
| 3615 | Exit;
|
---|
| 3616 | end;
|
---|
| 3617 | data := IContextItemCollection(aContextItemCollection) ;
|
---|
| 3618 | //PtDFN := FindBestCCOWDFN(PtName);
|
---|
| 3619 | PtDFN := FindBestCCOWDFN;
|
---|
| 3620 | // Retrieve the ContextItem name and value as strings
|
---|
| 3621 | anItem := data.Present('Patient.co.PatientName');
|
---|
| 3622 | if anItem <> nil then PtName := anItem.Get_Value();
|
---|
| 3623 | PtChanged := not ((PtDFN = Patient.DFN) and (PtName = Piece(Patient.Name, ',', 1) + U + Piece(Patient.Name, ',', 2) + '^^^^'));
|
---|
| 3624 | end;
|
---|
| 3625 |
|
---|
| 3626 | procedure TfrmFrame.CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
|
---|
| 3627 | var
|
---|
| 3628 | data : IContextItemCollection;
|
---|
| 3629 | anItem : IContextItem;
|
---|
| 3630 | itemvalue: string;
|
---|
| 3631 | PtSubject: string;
|
---|
| 3632 | begin
|
---|
| 3633 | data := IContextItemCollection(aContextItemCollection) ;
|
---|
| 3634 | anItem := data.Present('[hds_med_va.gov]request.id.name');
|
---|
| 3635 | // Retrieve the ContextItem name and value as strings
|
---|
| 3636 | if anItem <> nil then
|
---|
| 3637 | begin
|
---|
| 3638 | itemValue := anItem.Get_Value();
|
---|
| 3639 | if itemValue = 'GetWindowHandle' then
|
---|
| 3640 | begin
|
---|
| 3641 | PtSubject := 'patient.id.mrn.dfn_' + User.StationNumber;
|
---|
| 3642 | if not User.IsProductionAccount then PtSubject := PtSubject + '_test';
|
---|
| 3643 | if data.Present(PtSubject) <> nil then
|
---|
| 3644 | HyperlinkReason := '!@#$' + IntToStr(Self.Handle) + ':0:'
|
---|
| 3645 | else
|
---|
| 3646 | HyperlinkReason := '';
|
---|
| 3647 | end;
|
---|
| 3648 | end;
|
---|
| 3649 | end;
|
---|
| 3650 |
|
---|
| 3651 | procedure TfrmFrame.HideEverything;
|
---|
| 3652 | begin
|
---|
| 3653 | pnlNoPatientSelected.Visible := True;
|
---|
| 3654 | pnlNoPatientSelected.BringToFront;
|
---|
| 3655 | mnuFileReview.Enabled := False;
|
---|
| 3656 | mnuFilePrint.Enabled := False;
|
---|
| 3657 | mnuFilePrintSelectedItems.Enabled := False;
|
---|
| 3658 | mnuFileEncounter.Enabled := False;
|
---|
| 3659 | mnuFileNext.Enabled := False;
|
---|
| 3660 | mnuFileRefresh.Enabled := False;
|
---|
| 3661 | mnuFilePrintSetup.Enabled := False;
|
---|
| 3662 | mnuFilePrintSelectedItems.Enabled := False;
|
---|
| 3663 | mnuFileNotifRemove.Enabled := False;
|
---|
| 3664 | mnuFileResumeContext.Enabled := False;
|
---|
| 3665 | mnuFileBreakContext.Enabled := False;
|
---|
| 3666 | mnuEdit.Enabled := False;
|
---|
| 3667 | mnuView.Enabled := False;
|
---|
| 3668 | mnuTools.Enabled := False;
|
---|
| 3669 | end;
|
---|
| 3670 |
|
---|
| 3671 | procedure TfrmFrame.ShowEverything;
|
---|
| 3672 | begin
|
---|
| 3673 | pnlNoPatientSelected.Visible := False;
|
---|
| 3674 | pnlNoPatientSelected.SendToBack;
|
---|
| 3675 | mnuFileReview.Enabled := True;
|
---|
| 3676 | mnuFilePrint.Enabled := True;
|
---|
| 3677 | mnuFileEncounter.Enabled := True;
|
---|
| 3678 | mnuFileNext.Enabled := True;
|
---|
| 3679 | mnuFileRefresh.Enabled := True;
|
---|
| 3680 | mnuFilePrintSetup.Enabled := True;
|
---|
| 3681 | mnuFilePrintSelectedItems.Enabled := True;
|
---|
| 3682 | mnuFileNotifRemove.Enabled := True;
|
---|
| 3683 | if FCCOWIconName= 'BMP_CCOW_BROKEN' then
|
---|
| 3684 | begin
|
---|
| 3685 | mnuFileResumeContext.Enabled := True;
|
---|
| 3686 | mnuFileBreakContext.Enabled := False;
|
---|
| 3687 | end else
|
---|
| 3688 | begin
|
---|
| 3689 | mnuFileResumeContext.Enabled := False;
|
---|
| 3690 | mnuFileBreakContext.Enabled := True;
|
---|
| 3691 | end;
|
---|
| 3692 |
|
---|
| 3693 | mnuEdit.Enabled := True;
|
---|
| 3694 | mnuView.Enabled := True;
|
---|
| 3695 | mnuTools.Enabled := True;
|
---|
| 3696 | end;
|
---|
| 3697 |
|
---|
| 3698 |
|
---|
| 3699 | procedure TfrmFrame.pnlFlagMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
| 3700 | Shift: TShiftState; X, Y: Integer);
|
---|
| 3701 | begin
|
---|
| 3702 | pnlFlag.BevelOuter := bvLowered;
|
---|
| 3703 | end;
|
---|
| 3704 |
|
---|
| 3705 | procedure TfrmFrame.pnlFlagMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 3706 | Shift: TShiftState; X, Y: Integer);
|
---|
| 3707 | begin
|
---|
| 3708 | pnlFlag.BevelOuter := bvRaised;
|
---|
| 3709 | end;
|
---|
| 3710 |
|
---|
| 3711 | procedure TfrmFrame.pnlFlagClick(Sender: TObject);
|
---|
| 3712 | begin
|
---|
| 3713 | ShowFlags;
|
---|
| 3714 | end;
|
---|
| 3715 |
|
---|
| 3716 | procedure TfrmFrame.mnuFilePrintSelectedItemsClick(Sender: TObject);
|
---|
| 3717 | begin
|
---|
| 3718 | case TabToPageID(tabPage.TabIndex) of
|
---|
| 3719 | CT_NOTES: frmNotes.LstNotesToPrint;
|
---|
| 3720 | CT_CONSULTS: frmConsults.LstConsultsToPrint;
|
---|
| 3721 | CT_DCSUMM: frmDCSumm.LstSummsToPrint;
|
---|
| 3722 | end; {case}
|
---|
| 3723 | end;
|
---|
| 3724 |
|
---|
| 3725 | procedure TfrmFrame.mnuAlertRenewClick(Sender: TObject);
|
---|
| 3726 | var XQAID: string;
|
---|
| 3727 | begin
|
---|
| 3728 | XQAID := Piece(Notifications.RecordID, '^', 2);
|
---|
| 3729 | RenewAlert(XQAID);
|
---|
| 3730 | end;
|
---|
| 3731 |
|
---|
| 3732 | procedure TfrmFrame.mnuAlertForwardClick(Sender: TObject);
|
---|
| 3733 | var
|
---|
| 3734 | XQAID, AlertMsg: string;
|
---|
| 3735 | begin
|
---|
| 3736 | XQAID := Piece(Notifications.RecordID,'^', 2);
|
---|
| 3737 | AlertMsg := Piece(Notifications.RecordID, '^', 1);
|
---|
| 3738 | RenewAlert(XQAID); // must renew/restore an alert before it can be forwarded
|
---|
| 3739 | ForwardAlertTo(XQAID + '^' + AlertMsg);
|
---|
| 3740 | end;
|
---|
| 3741 |
|
---|
| 3742 | procedure TfrmFrame.mnuGECStatusClick(Sender: TObject);
|
---|
| 3743 | var
|
---|
| 3744 | ans, Result,str,str1,title: string;
|
---|
| 3745 | cnt,i: integer;
|
---|
| 3746 | fin: boolean;
|
---|
| 3747 |
|
---|
| 3748 | begin
|
---|
| 3749 | Result := sCallV('ORQQPXRM GEC STATUS PROMPT', [Patient.DFN]);
|
---|
| 3750 | if Piece(Result,U,1) <> '0' then
|
---|
| 3751 | begin
|
---|
| 3752 | title := Piece(Result,U,2);
|
---|
| 3753 | if pos('~',Piece(Result,U,1))>0 then
|
---|
| 3754 | begin
|
---|
| 3755 | str:='';
|
---|
| 3756 | str1 := Piece(Result,U,1);
|
---|
| 3757 | cnt := DelimCount(str1, '~');
|
---|
| 3758 | for i:=1 to cnt+1 do
|
---|
| 3759 | begin
|
---|
| 3760 | if i = 1 then str := Piece(str1,'~',i);
|
---|
| 3761 | if i > 1 then str :=str+CRLF+Piece(str1,'~',i);
|
---|
| 3762 | end;
|
---|
| 3763 | end
|
---|
| 3764 | else str := Piece(Result,U,1);
|
---|
| 3765 | if Piece(Result,U,3)='1' then
|
---|
| 3766 | begin
|
---|
| 3767 | fin := (InfoBox(str,title, MB_YESNO or MB_DEFBUTTON2)=IDYES);
|
---|
| 3768 | if fin = true then ans := '1';
|
---|
| 3769 | if fin = false then ans := '0';
|
---|
| 3770 | CallV('ORQQPXRM GEC FINISHED?',[Patient.DFN,ans]);
|
---|
| 3771 | end
|
---|
| 3772 | else
|
---|
| 3773 | InfoBox(str,title, MB_OK);
|
---|
| 3774 | end;
|
---|
| 3775 | end;
|
---|
| 3776 |
|
---|
| 3777 | procedure TfrmFrame.pnlFlagEnter(Sender: TObject);
|
---|
| 3778 | begin
|
---|
| 3779 | pnlFlag.BevelInner := bvRaised;
|
---|
| 3780 | pnlFlag.BevelOuter := bvNone;
|
---|
| 3781 | pnlFlag.BevelWidth := 4;
|
---|
| 3782 | end;
|
---|
| 3783 |
|
---|
| 3784 | procedure TfrmFrame.pnlFlagExit(Sender: TObject);
|
---|
| 3785 | begin
|
---|
| 3786 | pnlFlag.BevelWidth := 2;
|
---|
| 3787 | pnlFlag.BevelInner := bvNone;
|
---|
| 3788 | pnlFlag.BevelOuter := bvRaised;
|
---|
| 3789 | end;
|
---|
| 3790 |
|
---|
| 3791 | procedure TfrmFrame.tabPageMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 3792 | Shift: TShiftState; X, Y: Integer);
|
---|
| 3793 | begin
|
---|
| 3794 | LastTab := TabToPageID((sender as TTabControl).TabIndex);
|
---|
| 3795 | end;
|
---|
| 3796 |
|
---|
| 3797 | procedure TfrmFrame.lstCIRNLocationsExit(Sender: TObject);
|
---|
| 3798 | begin
|
---|
| 3799 | //Make the lstCIRNLocations act as if between pnlCIRN & pnlReminders
|
---|
| 3800 | //in the Tab Order
|
---|
| 3801 | if Boolean(Hi(GetKeyState(VK_TAB))) then
|
---|
| 3802 | if Boolean(Hi(GetKeyState(VK_SHIFT))) then
|
---|
| 3803 | pnlCIRN.SetFocus
|
---|
| 3804 | else
|
---|
| 3805 | pnlReminders.SetFocus;
|
---|
| 3806 | end;
|
---|
| 3807 |
|
---|
| 3808 | procedure TfrmFrame.AppEventsActivate(Sender: TObject);
|
---|
| 3809 | begin
|
---|
| 3810 | FJustEnteredApp := True;
|
---|
| 3811 | end;
|
---|
| 3812 |
|
---|
| 3813 | procedure TfrmFrame.ScreenActiveFormChange(Sender: TObject);
|
---|
| 3814 | var
|
---|
| 3815 | I : integer;
|
---|
| 3816 | begin
|
---|
| 3817 | //Locate the Form that Stays on Top after the Application Regains focus.
|
---|
| 3818 | if FJustEnteredApp then
|
---|
| 3819 | begin
|
---|
| 3820 | for I := (Screen.FormCount-1) downto 0 do //Set the last one opened last
|
---|
| 3821 | begin
|
---|
| 3822 | with Screen.Forms[I] do
|
---|
| 3823 | if (FormStyle = fsStayOnTop) and (Enabled) and (Visible) then
|
---|
| 3824 | SetFocus;
|
---|
| 3825 | end;
|
---|
| 3826 | FJustEnteredApp := false;
|
---|
| 3827 | end;
|
---|
| 3828 | end;
|
---|
| 3829 |
|
---|
| 3830 |
|
---|
| 3831 | initialization
|
---|
| 3832 |
|
---|
| 3833 | finalization
|
---|
| 3834 |
|
---|
| 3835 | end.
|
---|
| 3836 |
|
---|