1 | unit uCore;
|
---|
2 | { The core objects- patient, user, and encounter are defined here. All other clinical objects
|
---|
3 | in the GUI assume that these core objects exist. }
|
---|
4 |
|
---|
5 | {$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
|
---|
6 |
|
---|
7 | interface
|
---|
8 |
|
---|
9 | uses SysUtils, Windows, Classes, Forms, ORFn, rCore, uConst, ORClasses, uCombatVet;
|
---|
10 |
|
---|
11 | type
|
---|
12 | TUser = class(TObject)
|
---|
13 | private
|
---|
14 | FDUZ: Int64; // User DUZ (IEN in New Person file)
|
---|
15 | FName: string; // User Name (mixed case)
|
---|
16 | FUserClass: Integer; // User Class (based on OR keys for now)
|
---|
17 | FCanSignOrders: Boolean; // Has ORES key
|
---|
18 | FIsProvider: Boolean; // Has VA Provider key
|
---|
19 | FOrderRole: Integer;
|
---|
20 | FNoOrdering: Boolean;
|
---|
21 | FEnableVerify: Boolean;
|
---|
22 | FDTIME: Integer;
|
---|
23 | FCountDown: Integer;
|
---|
24 | FCurrentPrinter: string;
|
---|
25 | FNotifyAppsWM: Boolean;
|
---|
26 | FDomain: string;
|
---|
27 | FPtMsgHang: Integer;
|
---|
28 | FService: Integer;
|
---|
29 | FAutoSave: Integer;
|
---|
30 | FInitialTab: Integer;
|
---|
31 | FUseLastTab: Boolean;
|
---|
32 | FWebAccess: Boolean;
|
---|
33 | FIsRPL: string;
|
---|
34 | FRPLList: string;
|
---|
35 | FHasCorTabs: Boolean;
|
---|
36 | FHasRptTab: Boolean;
|
---|
37 | FIsReportsOnly: Boolean;
|
---|
38 | FToolsRptEdit: Boolean;
|
---|
39 | FDisableHold: Boolean;
|
---|
40 | FGECStatus: Boolean;
|
---|
41 | FStationNumber: string;
|
---|
42 | FIsProductionAccount: boolean;
|
---|
43 | public
|
---|
44 | constructor Create;
|
---|
45 | function HasKey(const KeyName: string): Boolean;
|
---|
46 | procedure SetCurrentPrinter(Value: string);
|
---|
47 | property DUZ: Int64 read FDUZ;
|
---|
48 | property Name: string read FName;
|
---|
49 | property UserClass: Integer read FUserClass;
|
---|
50 | property CanSignOrders: Boolean read FCanSignOrders;
|
---|
51 | property IsProvider: Boolean read FIsProvider;
|
---|
52 | property OrderRole: Integer read FOrderRole;
|
---|
53 | property NoOrdering: Boolean read FNoOrdering;
|
---|
54 | property EnableVerify: Boolean read FEnableVerify;
|
---|
55 | property DTIME: Integer read FDTIME;
|
---|
56 | property CountDown: Integer read FCountDown;
|
---|
57 | property PtMsgHang: Integer read FPtMsgHang;
|
---|
58 | property Service: Integer read FService;
|
---|
59 | property AutoSave: Integer read FAutoSave;
|
---|
60 | property InitialTab: Integer read FInitialTab;
|
---|
61 | property UseLastTab: Boolean read FUseLastTab;
|
---|
62 | property WebAccess: Boolean read FWebAccess;
|
---|
63 | property DisableHold: Boolean read FDisableHold;
|
---|
64 | property IsRPL: string read FIsRPL;
|
---|
65 | property RPLList: string read FRPLList;
|
---|
66 | property HasCorTabs: Boolean read FHasCorTabs;
|
---|
67 | property HasRptTab: Boolean read FHasRptTab;
|
---|
68 | property IsReportsOnly: Boolean read FIsReportsOnly;
|
---|
69 | property ToolsRptEdit: Boolean read FToolsRptEdit;
|
---|
70 | property CurrentPrinter: string read FCurrentPrinter write SetCurrentPrinter;
|
---|
71 | property GECStatus: Boolean read FGECStatus;
|
---|
72 | property StationNumber: string read FStationNumber;
|
---|
73 | property IsProductionAccount: boolean read FIsProductionAccount;
|
---|
74 | end;
|
---|
75 |
|
---|
76 | TPatient = class(TObject)
|
---|
77 | private
|
---|
78 | FDFN: string; // Internal Entry Number in Patient file //*DFN*
|
---|
79 | FICN: string; // Integration Control Number from MPI
|
---|
80 | FName: string; // Patient Name (mixed case)
|
---|
81 | FSSN: string; // Patient Identifier (generally SSN)
|
---|
82 | FDOB: TFMDateTime; // Date of Birth in Fileman format
|
---|
83 | FAge: Integer; // Patient Age
|
---|
84 | FSex: Char; // Male, Female, Unknown
|
---|
85 | FCWAD: string; // chars identify if pt has CWAD warnings
|
---|
86 | FRestricted: Boolean; // True if this is a restricted record
|
---|
87 | FInpatient: Boolean; // True if that patient is an inpatient
|
---|
88 | FStatus: string; // Patient status indicator (Inpatient or Outpatient)
|
---|
89 | FLocation: Integer; // IEN in Hosp Loc if inpatient
|
---|
90 | FWardService: string;
|
---|
91 | FSpecialty: Integer; // IEN of the treating specialty if inpatient
|
---|
92 | FAdmitTime: TFMDateTime; // Admit date/time if inpatient
|
---|
93 | FSrvConn: Boolean; // True if patient is service connected
|
---|
94 | FSCPercent: Integer; // Per Cent Service Connection
|
---|
95 | FPrimTeam: string; // name of primary care team
|
---|
96 | FPrimProv: string; // name of primary care provider
|
---|
97 | FAttending: string; // if inpatient, name of attending
|
---|
98 | FAssociate: string; // if inpatient, name of associate
|
---|
99 | FDateDied: TFMDateTime; // Date of Patient Death (<=0 or still alive)
|
---|
100 | FDateDiedLoaded: boolean; // Used to determine of DateDied has been loaded
|
---|
101 | FCombatVet : TCombatVet; // Object Holding CombatVet Data
|
---|
102 | procedure SetDFN(const Value: string);
|
---|
103 | function GetDateDied: TFMDateTime;
|
---|
104 | function GetCombatVet: TCombatVet; // *DFN*
|
---|
105 | public
|
---|
106 | procedure Clear;
|
---|
107 | destructor Destroy; override;
|
---|
108 | property DFN: string read FDFN write SetDFN; //*DFN*
|
---|
109 | property ICN: string read FICN;
|
---|
110 | property Name: string read FName;
|
---|
111 | property SSN: string read FSSN;
|
---|
112 | property DOB: TFMDateTime read FDOB;
|
---|
113 | property Age: Integer read FAge;
|
---|
114 | property Sex: Char read FSex;
|
---|
115 | property CWAD: string read FCWAD;
|
---|
116 | property Inpatient: Boolean read FInpatient;
|
---|
117 | property Status: string read FStatus;
|
---|
118 | property Location: Integer read FLocation;
|
---|
119 | property WardService: string read FWardService;
|
---|
120 | property Specialty: Integer read FSpecialty;
|
---|
121 | property AdmitTime: TFMDateTime read FAdmitTime;
|
---|
122 | property DateDied: TFMDateTime read GetDateDied;
|
---|
123 | property ServiceConnected: Boolean read FSrvConn;
|
---|
124 | property SCPercent: Integer read FSCPercent;
|
---|
125 | property PrimaryTeam: string read FPrimTeam;
|
---|
126 | property PrimaryProvider: string read FPrimProv;
|
---|
127 | property Attending: string read FAttending;
|
---|
128 | property Associate: string read FAssociate;
|
---|
129 | property CombatVet: TCombatVet read GetCombatVet;
|
---|
130 | end;
|
---|
131 |
|
---|
132 | TEncounter = class(TObject, IORNotifier)
|
---|
133 | private
|
---|
134 | FChanged: Boolean; // one or more visit fields have changed
|
---|
135 | FDateTime: TFMDateTime; // date/time of encounter (appt, admission)
|
---|
136 | FInpatient: Boolean; // true if this is an inpatient encounter
|
---|
137 | FLocation: Integer; // IEN in Hospital Location file
|
---|
138 | FLocationName: string; // Name in Hospital Location file
|
---|
139 | FLocationText: string; // Name + Date/Time or Name + RoomBed
|
---|
140 | FProvider: Int64 ; // IEN in New Person file
|
---|
141 | FProviderName: string; // Name in New Person file
|
---|
142 | FVisitCategory: Char; // A=ambulatory,T=Telephone,H=inpt,E=historic
|
---|
143 | FStandAlone: Boolean; // true if visit not related to appointment
|
---|
144 | FNotifier: IORNotifier; // Event handlers for location changes
|
---|
145 | function GetLocationName: string;
|
---|
146 | function GetLocationText: string;
|
---|
147 | function GetProviderName: string;
|
---|
148 | function GetVisitCategory: Char;
|
---|
149 | function GetVisitStr: string;
|
---|
150 | procedure SetDateTime(Value: TFMDateTime);
|
---|
151 | procedure SetInpatient(Value: Boolean);
|
---|
152 | procedure SetLocation(Value: Integer);
|
---|
153 | procedure SetProvider(Value: Int64);
|
---|
154 | procedure SetStandAlone(Value: Boolean);
|
---|
155 | procedure SetVisitCategory(Value: Char);
|
---|
156 | procedure UpdateText;
|
---|
157 | public
|
---|
158 | constructor Create;
|
---|
159 | destructor Destroy; override;
|
---|
160 | procedure Clear;
|
---|
161 | procedure EncounterSwitch(Loc: integer; LocName, LocText: string; DT: TFMDateTime; vCat: Char);
|
---|
162 | function NeedVisit: Boolean;
|
---|
163 | property DateTime: TFMDateTime read FDateTime write SetDateTime;
|
---|
164 | property Inpatient: Boolean read FInpatient write SetInpatient;
|
---|
165 | property Location: Integer read FLocation write SetLocation;
|
---|
166 | property LocationName: string read GetLocationName write FLocationName;
|
---|
167 | property LocationText: string read GetLocationText write FLocationText;
|
---|
168 | property Provider: Int64 read FProvider write SetProvider;
|
---|
169 | property ProviderName: string read GetProviderName;
|
---|
170 | property StandAlone: Boolean read FStandAlone write SetStandAlone;
|
---|
171 | property VisitCategory: Char read GetVisitCategory write SetVisitCategory;
|
---|
172 | property VisitStr: string read GetVisitStr;
|
---|
173 | property Notifier: IORNotifier read FNotifier implements IORNotifier;
|
---|
174 | end;
|
---|
175 |
|
---|
176 | TChangeItem = class
|
---|
177 | private
|
---|
178 | FItemType: Integer;
|
---|
179 | FID: string;
|
---|
180 | FText: string;
|
---|
181 | FGroupName: string;
|
---|
182 | FSignState: Integer;
|
---|
183 | FParentID : string;
|
---|
184 | FUser : Int64;
|
---|
185 | FOrderDG : String;
|
---|
186 | FDCOrder : boolean;
|
---|
187 | FDelay : boolean;
|
---|
188 | constructor Create(AnItemType: Integer; const AnID, AText, AGroupName: string;
|
---|
189 | ASignState: Integer; AParentID: string = ''; User: int64 = 0; OrderDG: string = ''; DCOrder: boolean = False; Delay: boolean = False);
|
---|
190 | public
|
---|
191 | property ItemType: Integer read FItemType;
|
---|
192 | property ID: string read FID;
|
---|
193 | property Text: string read FText;
|
---|
194 | property GroupName: string read FGroupName;
|
---|
195 | property SignState: Integer read FSignState write FSignState;
|
---|
196 | property ParentID : string read FParentID;
|
---|
197 | property User: Int64 read FUser write FUser;
|
---|
198 | property OrderDG: string read FOrderDG write FOrderDG;
|
---|
199 | property DCOrder: boolean read FDCOrder write FDCOrder;
|
---|
200 | property Delay: boolean read FDelay write FDelay;
|
---|
201 | end;
|
---|
202 |
|
---|
203 | TORRemoveChangesEvent = procedure(Sender: TObject; ChangeItem: TChangeItem) of object; {**RV**}
|
---|
204 |
|
---|
205 | TChanges = class
|
---|
206 | private
|
---|
207 | FCount: Integer;
|
---|
208 | FDocuments: TList;
|
---|
209 | FOrders: TList;
|
---|
210 | FOrderGrp: TStringList;
|
---|
211 | FPCE: TList;
|
---|
212 | FPCEGrp: TStringList;
|
---|
213 | FOnRemove: TORRemoveChangesEvent; {**RV**}
|
---|
214 | private
|
---|
215 | procedure AddUnsignedToChanges;
|
---|
216 | public
|
---|
217 | constructor Create;
|
---|
218 | destructor Destroy; override;
|
---|
219 | procedure Add(ItemType: Integer; const AnID, ItemText, GroupName: string; SignState: Integer; AParentID: string = '';
|
---|
220 | User: int64 = 0; OrderDG: String = ''; DCOrder: boolean = FALSE; Delay: boolean = False);
|
---|
221 | procedure Clear;
|
---|
222 | function CanSign: Boolean;
|
---|
223 | function Exist(ItemType: Integer; const AnID: string): Boolean;
|
---|
224 | function ExistForOrder(const AnID: string): Boolean;
|
---|
225 | function Locate(ItemType: Integer; const AnID: string): TChangeItem;
|
---|
226 | procedure Remove(ItemType: Integer; const AnID: string);
|
---|
227 | procedure ReplaceID(ItemType: Integer; const OldID, NewID: string);
|
---|
228 | procedure ReplaceSignState(ItemType: Integer; const AnID: string; NewState: Integer);
|
---|
229 | procedure ReplaceText(ItemType: Integer; const AnID, NewText: string);
|
---|
230 | procedure ReplaceODGrpName(const AnODID, NewGrp: string);
|
---|
231 | procedure ChangeOrderGrp(const oldGrpName,newGrpName: string);
|
---|
232 | function RequireReview: Boolean;
|
---|
233 | property Count: Integer read FCount;
|
---|
234 | property Documents: TList read FDocuments;
|
---|
235 | property OnRemove: TORRemoveChangesEvent read FOnRemove write FOnRemove; {**RV**}
|
---|
236 | property Orders: TList read FOrders;
|
---|
237 | property PCE: TList read FPCE;
|
---|
238 | property OrderGrp: TStringList read FOrderGrp;
|
---|
239 | property PCEGrp: TStringList read FPCEGrp;
|
---|
240 | end;
|
---|
241 |
|
---|
242 | TNotifyItem = class
|
---|
243 | private
|
---|
244 | DFN: string;
|
---|
245 | FollowUp: Integer;
|
---|
246 | //AlertData: string;
|
---|
247 | RecordID: string;
|
---|
248 | HighLightSection: String;
|
---|
249 | end;
|
---|
250 |
|
---|
251 | TNotifications = class
|
---|
252 | private
|
---|
253 | FActive: Boolean;
|
---|
254 | FList: TList;
|
---|
255 | FCurrentIndex: Integer;
|
---|
256 | FNotifyItem: TNotifyItem;
|
---|
257 | function GetDFN: string; //*DFN*
|
---|
258 | function GetFollowUp: Integer;
|
---|
259 | function GetAlertData: string;
|
---|
260 | function GetHighLightSection: String; //CB
|
---|
261 | function GetRecordID: string;
|
---|
262 | function GetText: string;
|
---|
263 | public
|
---|
264 | constructor Create;
|
---|
265 | destructor Destroy; override;
|
---|
266 | procedure Add(const ADFN: string; AFollowUp: Integer; const ARecordID: string; AHighLightSection : string = ''); //*DFN* CB
|
---|
267 | procedure Clear;
|
---|
268 | procedure Next;
|
---|
269 | procedure Prior;
|
---|
270 | procedure Delete;
|
---|
271 | procedure DeleteForCurrentUser;
|
---|
272 | property Active: Boolean read FActive;
|
---|
273 | property DFN: string read GetDFN; //*DFN*
|
---|
274 | property FollowUp: Integer read GetFollowUp;
|
---|
275 | property AlertData: string read GetAlertData;
|
---|
276 | property RecordID: string read GetRecordID;
|
---|
277 | property Text: string read GetText;
|
---|
278 | property HighLightSection: String read GetHighLightSection; //cb
|
---|
279 | end;
|
---|
280 |
|
---|
281 | TRemoteSite = class
|
---|
282 | private
|
---|
283 | FSiteID: string;
|
---|
284 | FSiteName: string;
|
---|
285 | FLastDate: TFMDateTime;
|
---|
286 | FSelected: Boolean;
|
---|
287 | FRemoteHandle: string;
|
---|
288 | FLabRemoteHandle: string;
|
---|
289 | FQueryStatus: string;
|
---|
290 | FLabQueryStatus: string;
|
---|
291 | FData: TStringList;
|
---|
292 | FLabData: TStringList;
|
---|
293 | FCurrentLabQuery: string;
|
---|
294 | FCurrentReportQuery: string;
|
---|
295 | procedure SetSelected(Value: Boolean);
|
---|
296 | public
|
---|
297 | destructor Destroy; override;
|
---|
298 | constructor Create(ASite: string);
|
---|
299 | procedure ReportClear;
|
---|
300 | procedure LabClear;
|
---|
301 | property SiteID : string read FSiteID;
|
---|
302 | property SiteName: string read FSiteName;
|
---|
303 | property LastDate: TFMDateTime read FLastDate;
|
---|
304 | property Selected: boolean read FSelected write SetSelected;
|
---|
305 | property RemoteHandle: string read FRemoteHandle write FRemoteHandle;
|
---|
306 | property QueryStatus: string read FQueryStatus write FQueryStatus;
|
---|
307 | property Data: TStringList read FData write FData;
|
---|
308 | property LabRemoteHandle: string read FLabRemoteHandle write FLabRemoteHandle;
|
---|
309 | property LabQueryStatus: string read FLabQueryStatus write FLabQueryStatus;
|
---|
310 | property LabData: TStringList read FLabData write FLabData;
|
---|
311 | property CurrentLabQuery: string read FCurrentLabQuery write FCurrentLabQuery;
|
---|
312 | property CurrentReportQuery: string read FCurrentReportQuery write FCurrentReportQuery;
|
---|
313 | end;
|
---|
314 |
|
---|
315 | TRemoteSiteList = class
|
---|
316 | private
|
---|
317 | FCount: integer;
|
---|
318 | FSiteList: TList;
|
---|
319 | FRemoteDataExists: Boolean;
|
---|
320 | FNoDataReason: string;
|
---|
321 | public
|
---|
322 | constructor Create;
|
---|
323 | destructor Destroy; override;
|
---|
324 | procedure Add(ASite: string);
|
---|
325 | procedure ChangePatient(const DFN: string);
|
---|
326 | procedure Clear;
|
---|
327 | property Count : integer read FCount;
|
---|
328 | property SiteList : TList read FSiteList;
|
---|
329 | property RemoteDataExists: Boolean read FRemoteDataExists;
|
---|
330 | property NoDataReason : string read FNoDataReason;
|
---|
331 | end;
|
---|
332 |
|
---|
333 | TRemoteReport = class
|
---|
334 | private
|
---|
335 | FReport: string;
|
---|
336 | FHandle: string;
|
---|
337 | public
|
---|
338 | constructor Create(AReport: string);
|
---|
339 | destructor Destroy; override;
|
---|
340 | property Handle :string read FHandle write FHandle;
|
---|
341 | property Report :string read FReport write FReport;
|
---|
342 | end;
|
---|
343 |
|
---|
344 | TRemoteReportList = class
|
---|
345 | private
|
---|
346 | FCount: integer;
|
---|
347 | FReportList: TList;
|
---|
348 | public
|
---|
349 | constructor Create;
|
---|
350 | destructor Destroy; override;
|
---|
351 | procedure Add(AReportList, AHandle: string);
|
---|
352 | procedure Clear;
|
---|
353 | property Count :integer read FCount;
|
---|
354 | property ReportList :TList read FReportList;
|
---|
355 | end;
|
---|
356 |
|
---|
357 | PReportTreeObject = ^TReportTreeObject;
|
---|
358 | TReportTreeObject = Record
|
---|
359 | ID : String; //Report ID
|
---|
360 | Heading : String; //Report Heading
|
---|
361 | Remote : String; //Remote Data Capable
|
---|
362 | RptType : String; //Report Type
|
---|
363 | Category : String; //Report Category
|
---|
364 | RPCName : String; //Associated RPC
|
---|
365 | IFN : String; //IFN of report in file 101.24
|
---|
366 | HDR : String; //HDR is source of data if = 1
|
---|
367 | end;
|
---|
368 |
|
---|
369 | var
|
---|
370 | User: TUser;
|
---|
371 | Patient: TPatient;
|
---|
372 | Encounter: TEncounter = nil;
|
---|
373 | Changes: TChanges;
|
---|
374 | RemoteSites: TRemoteSiteList;
|
---|
375 | RemoteReports: TRemoteReportList;
|
---|
376 | Notifications: TNotifications;
|
---|
377 | HasFlag: boolean;
|
---|
378 | FlagList: TStringList;
|
---|
379 | //hds7591 Clinic/Ward movement.
|
---|
380 | TempEncounterLoc: Integer; // used to Save Encounter Location when user selected "Review Sign Changes" from "File"
|
---|
381 | TempEncounterLocName: string; // since in the path PatientRefresh is done prior to checking if patient has been admitted while entering OPT orders.
|
---|
382 | TempEncounterText: string;
|
---|
383 | TempEncounterDateTime: TFMDateTime;
|
---|
384 | TempEncounterVistCat: Char;
|
---|
385 | //TempOutEncounterLoc: Integer;
|
---|
386 | //TempOutEncounterLocName: string;
|
---|
387 |
|
---|
388 | procedure NotifyOtherApps(const AppEvent, AppData: string);
|
---|
389 | procedure FlushNotifierBuffer;
|
---|
390 | procedure TerminateOtherAppNotification;
|
---|
391 | procedure GotoWebPage(const URL: WideString);
|
---|
392 | function AllowAccessToSensitivePatient(NewDFN: string; var AccessStatus: integer): boolean;
|
---|
393 |
|
---|
394 |
|
---|
395 | implementation
|
---|
396 |
|
---|
397 | uses rTIU, rOrders, rConsults, uOrders;
|
---|
398 |
|
---|
399 | type
|
---|
400 | HlinkNavProc = function(pUnk: IUnknown; szTarget: PWideChar): HResult; stdcall;
|
---|
401 |
|
---|
402 | var
|
---|
403 | uVistaMsg, uVistaDomMsg: UINT;
|
---|
404 | URLMonHandle: THandle = 0;
|
---|
405 | HlinkNav: HlinkNavProc;
|
---|
406 |
|
---|
407 | type
|
---|
408 | TNotifyAppsThread = class(TThread)
|
---|
409 | private
|
---|
410 | FRunning: boolean;
|
---|
411 | public
|
---|
412 | constructor CreateThread;
|
---|
413 | procedure ResumeIfIdle;
|
---|
414 | procedure ResumeAndTerminate;
|
---|
415 | procedure Execute; override;
|
---|
416 | property Running: boolean read FRunning;
|
---|
417 | end;
|
---|
418 |
|
---|
419 | TMsgType = (mtVistaMessage, mtVistaDomainMessage);
|
---|
420 |
|
---|
421 | var
|
---|
422 | uSynchronizer: TMultiReadExclusiveWriteSynchronizer = nil;
|
---|
423 | uNotifyAppsThread: TNotifyAppsThread = nil;
|
---|
424 | uNotifyAppsQueue: TStringList = nil;
|
---|
425 | uNotifyAppsActive: boolean = TRUE;
|
---|
426 | AnAtom: ATOM = 0;
|
---|
427 |
|
---|
428 | const
|
---|
429 | LONG_BROADCAST_TIMEOUT = 30000; // 30 seconds
|
---|
430 | SHORT_BROADCAST_TIMEOUT = 2000; // 2 seconds
|
---|
431 | MSG_TYPE: array[TMsgType] of String = ('V','D');
|
---|
432 |
|
---|
433 | function AllowAccessToSensitivePatient(NewDFN: string; var AccessStatus: integer): boolean;
|
---|
434 | const
|
---|
435 | TX_DGSR_ERR = 'Unable to perform sensitive record checks';
|
---|
436 | TC_DGSR_ERR = 'Error';
|
---|
437 | TC_DGSR_SHOW = 'Restricted Record';
|
---|
438 | TC_DGSR_DENY = 'Access Denied';
|
---|
439 | TX_DGSR_YESNO = CRLF + 'Do you want to continue processing this patient record?';
|
---|
440 | TC_NEXT_NOTIF = 'NEXT NOTIFICATION: ';
|
---|
441 | var
|
---|
442 | //AccessStatus: integer;
|
---|
443 | AMsg, PrefixC, PrefixT: string;
|
---|
444 | begin
|
---|
445 | Result := TRUE;
|
---|
446 | if Notifications.Active then
|
---|
447 | begin
|
---|
448 | PrefixT := Piece(Notifications.RecordID, U, 1) + CRLF + CRLF;
|
---|
449 | PrefixC := TC_NEXT_NOTIF;
|
---|
450 | end
|
---|
451 | else
|
---|
452 | begin
|
---|
453 | PrefixT := '';
|
---|
454 | PrefixC := '';
|
---|
455 | end;
|
---|
456 | CheckSensitiveRecordAccess(NewDFN, AccessStatus, AMsg);
|
---|
457 | case AccessStatus of
|
---|
458 | DGSR_FAIL: begin
|
---|
459 | InfoBox(PrefixT + TX_DGSR_ERR, PrefixC + TC_DGSR_ERR, MB_OK);
|
---|
460 | Result := FALSE;
|
---|
461 | end;
|
---|
462 | DGSR_NONE: { Nothing - allow access to the patient. };
|
---|
463 | DGSR_SHOW: InfoBox(PrefixT + AMsg, PrefixC + TC_DGSR_SHOW, MB_OK);
|
---|
464 | DGSR_ASK: if InfoBox(PrefixT + AMsg + TX_DGSR_YESNO, PrefixC + TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
|
---|
465 | MB_DEFBUTTON2) = IDYES then LogSensitiveRecordAccess(NewDFN)
|
---|
466 | else Result := FALSE;
|
---|
467 | else begin
|
---|
468 | InfoBox(PrefixT + AMsg, PrefixC + TC_DGSR_DENY, MB_OK);
|
---|
469 | if Notifications.Active then Notifications.DeleteForCurrentUser;
|
---|
470 | Result := FALSE;
|
---|
471 | end;
|
---|
472 | end;
|
---|
473 | end;
|
---|
474 |
|
---|
475 | function QueuePending: boolean;
|
---|
476 | begin
|
---|
477 | uSynchronizer.BeginRead;
|
---|
478 | try
|
---|
479 | Result := (uNotifyAppsQueue.Count > 0);
|
---|
480 | finally
|
---|
481 | uSynchronizer.EndRead;
|
---|
482 | end;
|
---|
483 | end;
|
---|
484 |
|
---|
485 | procedure ProcessQueue(ShortTimout: boolean);
|
---|
486 | var
|
---|
487 | msg: String;
|
---|
488 | process: boolean;
|
---|
489 | AResult: LPDWORD;
|
---|
490 | MsgCode, timeout: UINT;
|
---|
491 | TypeCode: String;
|
---|
492 |
|
---|
493 | begin
|
---|
494 | if(not QueuePending) then exit;
|
---|
495 | uSynchronizer.BeginWrite;
|
---|
496 | try
|
---|
497 | process := (uNotifyAppsQueue.Count > 0);
|
---|
498 | if(process) then
|
---|
499 | begin
|
---|
500 | msg := uNotifyAppsQueue.Strings[0];
|
---|
501 | uNotifyAppsQueue.Delete(0);
|
---|
502 | end;
|
---|
503 | finally
|
---|
504 | uSynchronizer.EndWrite;
|
---|
505 | end;
|
---|
506 | if(process) then
|
---|
507 | begin
|
---|
508 | TypeCode := copy(msg,1,1);
|
---|
509 | delete(msg,1,1);
|
---|
510 | if(TypeCode = MSG_TYPE[mtVistaMessage]) then
|
---|
511 | MsgCode := uVistaMsg
|
---|
512 | else
|
---|
513 | MsgCode := uVistaDomMsg;
|
---|
514 |
|
---|
515 | if(ShortTimout) then
|
---|
516 | timeout := SHORT_BROADCAST_TIMEOUT
|
---|
517 | else
|
---|
518 | timeout := LONG_BROADCAST_TIMEOUT;
|
---|
519 |
|
---|
520 | // put text in the global atom table
|
---|
521 | AnAtom := GlobalAddAtom(PChar(msg));
|
---|
522 | if (AnAtom <> 0) then
|
---|
523 | begin
|
---|
524 | try
|
---|
525 | // broadcast 'VistA Domain Event - Clinical' to all main windows
|
---|
526 | //SendMessage(HWND_BROADCAST, uVistaDomMsg, WPARAM(Application.MainForm.Handle), LPARAM(AnAtom));
|
---|
527 | //
|
---|
528 | //Changed to SendMessageTimeout to prevent hang when other app unresponsive (RV)
|
---|
529 | AResult := nil;
|
---|
530 | SendMessageTimeout(HWND_BROADCAST, MsgCode, WPARAM(Application.MainForm.Handle), LPARAM(AnAtom),
|
---|
531 | SMTO_ABORTIFHUNG or SMTO_BLOCK, timeout, AResult^);
|
---|
532 | finally
|
---|
533 | // after all windows have processed the message, remove the text from the table
|
---|
534 | GlobalDeleteAtom(AnAtom);
|
---|
535 | AnAtom := 0;
|
---|
536 | end;
|
---|
537 | end;
|
---|
538 | end;
|
---|
539 | end;
|
---|
540 |
|
---|
541 | constructor TNotifyAppsThread.CreateThread;
|
---|
542 | begin
|
---|
543 | inherited Create(TRUE);
|
---|
544 | FRunning := TRUE;
|
---|
545 | end;
|
---|
546 |
|
---|
547 | procedure TNotifyAppsThread.ResumeIfIdle;
|
---|
548 | begin
|
---|
549 | if(Suspended) then
|
---|
550 | Resume;
|
---|
551 | end;
|
---|
552 |
|
---|
553 | procedure TNotifyAppsThread.ResumeAndTerminate;
|
---|
554 | begin
|
---|
555 | Terminate;
|
---|
556 | if(Suspended) then
|
---|
557 | Resume;
|
---|
558 | end;
|
---|
559 |
|
---|
560 | procedure TNotifyAppsThread.Execute;
|
---|
561 | begin
|
---|
562 | while(not Terminated) do
|
---|
563 | begin
|
---|
564 | if(QueuePending) then
|
---|
565 | ProcessQueue(FALSE)
|
---|
566 | else if(not Terminated) then
|
---|
567 | Suspend;
|
---|
568 | end;
|
---|
569 | FRunning := FALSE;
|
---|
570 | end;
|
---|
571 |
|
---|
572 | function AppNotificationEnabled: boolean;
|
---|
573 | begin
|
---|
574 | Result := FALSE;
|
---|
575 | if(not uNotifyAppsActive) then exit;
|
---|
576 | if Application.MainForm = nil then Exit;
|
---|
577 | if User = nil then exit;
|
---|
578 | if not User.FNotifyAppsWM then Exit;
|
---|
579 | // register the message with windows to get a unique message number (if not already registered)
|
---|
580 | if uVistaMsg = 0 then uVistaMsg := RegisterWindowMessage('VistA Event - Clinical');
|
---|
581 | if uVistaDomMsg = 0 then uVistaDomMsg := RegisterWindowMessage('VistA Domain Event - Clinical');
|
---|
582 | if (uVistaMsg = 0) or (uVistaDomMsg = 0) then Exit;
|
---|
583 | if(not assigned(uNotifyAppsQueue)) then
|
---|
584 | uNotifyAppsQueue := TStringList.Create;
|
---|
585 | if(not assigned(uSynchronizer)) then
|
---|
586 | uSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create;
|
---|
587 | if(not assigned(uNotifyAppsThread)) then
|
---|
588 | uNotifyAppsThread := TNotifyAppsThread.CreateThread;
|
---|
589 | Result := TRUE;
|
---|
590 | end;
|
---|
591 |
|
---|
592 | procedure ReleaseAppNotification;
|
---|
593 | var
|
---|
594 | waitState: DWORD;
|
---|
595 |
|
---|
596 | begin
|
---|
597 | uNotifyAppsActive := FALSE;
|
---|
598 | if(assigned(uNotifyAppsThread)) then
|
---|
599 | begin
|
---|
600 | uNotifyAppsThread.ResumeAndTerminate;
|
---|
601 | sleep(10);
|
---|
602 | if(uNotifyAppsThread.Running) then
|
---|
603 | begin
|
---|
604 | waitState := WaitForSingleObject(uNotifyAppsThread.Handle, SHORT_BROADCAST_TIMEOUT);
|
---|
605 | if((waitState = WAIT_TIMEOUT) or
|
---|
606 | (waitState = WAIT_FAILED) or
|
---|
607 | (waitState = WAIT_ABANDONED)) then
|
---|
608 | begin
|
---|
609 | TerminateThread(uNotifyAppsThread.Handle, 0);
|
---|
610 | if(AnAtom <> 0) then
|
---|
611 | begin
|
---|
612 | GlobalDeleteAtom(AnAtom);
|
---|
613 | AnAtom := 0;
|
---|
614 | end;
|
---|
615 | end;
|
---|
616 | end;
|
---|
617 | FreeAndNil(uNotifyAppsThread);
|
---|
618 | end;
|
---|
619 | if(assigned(uSynchronizer)) and
|
---|
620 | (assigned(uNotifyAppsQueue)) then
|
---|
621 | begin
|
---|
622 | while(QueuePending) do
|
---|
623 | ProcessQueue(TRUE);
|
---|
624 | end;
|
---|
625 | FreeAndNil(uSynchronizer);
|
---|
626 | FreeAndNil(uNotifyAppsQueue);
|
---|
627 | end;
|
---|
628 |
|
---|
629 | procedure NotifyOtherApps(const AppEvent, AppData: string);
|
---|
630 | var
|
---|
631 | m1: string;
|
---|
632 | m2: string;
|
---|
633 |
|
---|
634 | begin
|
---|
635 | if(AppNotificationEnabled) then
|
---|
636 | begin
|
---|
637 | // first send the domain version of the message
|
---|
638 | m1 := MSG_TYPE[mtVistaDomainMessage] + AppEvent + U + 'CPRS;' + User.FDomain + U + Patient.DFN + U + AppData;
|
---|
639 | // for backward compatibility, send the message without the domain
|
---|
640 | m2 := MSG_TYPE[mtVistaMessage] + AppEvent + U + 'CPRS' + U + Patient.DFN + U + AppData;
|
---|
641 | uSynchronizer.BeginWrite;
|
---|
642 | try
|
---|
643 | uNotifyAppsQueue.Add(m1);
|
---|
644 | uNotifyAppsQueue.Add(m2);
|
---|
645 | finally
|
---|
646 | uSynchronizer.EndWrite;
|
---|
647 | end;
|
---|
648 | uNotifyAppsThread.ResumeIfIdle;
|
---|
649 | end;
|
---|
650 | end;
|
---|
651 |
|
---|
652 | procedure FlushNotifierBuffer;
|
---|
653 | begin
|
---|
654 | if(AppNotificationEnabled) then
|
---|
655 | begin
|
---|
656 | uSynchronizer.BeginWrite;
|
---|
657 | try
|
---|
658 | uNotifyAppsQueue.Clear;
|
---|
659 | finally
|
---|
660 | uSynchronizer.EndWrite;
|
---|
661 | end;
|
---|
662 | end;
|
---|
663 | end;
|
---|
664 |
|
---|
665 | procedure TerminateOtherAppNotification;
|
---|
666 | begin
|
---|
667 | ReleaseAppNotification;
|
---|
668 | end;
|
---|
669 |
|
---|
670 | { TUser methods ---------------------------------------------------------------------------- }
|
---|
671 |
|
---|
672 | constructor TUser.Create;
|
---|
673 | { create the User object for the currently logged in user }
|
---|
674 | var
|
---|
675 | UserInfo: TUserInfo;
|
---|
676 | begin
|
---|
677 | UserInfo := GetUserInfo;
|
---|
678 | FDUZ := UserInfo.DUZ;
|
---|
679 | FName := UserInfo.Name;
|
---|
680 | FUserClass := UserInfo.UserClass;
|
---|
681 | FCanSignOrders := UserInfo.CanSignOrders;
|
---|
682 | FIsProvider := UserInfo.IsProvider;
|
---|
683 | FOrderRole := UserInfo.OrderRole;
|
---|
684 | FNoOrdering := UserInfo.NoOrdering;
|
---|
685 | FEnableVerify := UserInfo.EnableVerify;
|
---|
686 | FDTIME := UserInfo.DTIME;
|
---|
687 | FCountDown := UserInfo.CountDown;
|
---|
688 | FNotifyAppsWM := UserInfo.NotifyAppsWM;
|
---|
689 | FDomain := UserInfo.Domain;
|
---|
690 | FPtMsgHang := UserInfo.PtMsgHang;
|
---|
691 | FService := UserInfo.Service;
|
---|
692 | FAutoSave := UserInfo.AutoSave;
|
---|
693 | FInitialTab := UserInfo.InitialTab;
|
---|
694 | FUseLastTab := UserInfo.UseLastTab;
|
---|
695 | if(URLMonHandle = 0) then
|
---|
696 | FWebAccess := FALSE
|
---|
697 | else
|
---|
698 | FWebAccess := UserInfo.WebAccess;
|
---|
699 | FDisableHold := UserInfo.DisableHold;
|
---|
700 | FIsRPL := UserInfo.IsRPL;
|
---|
701 | FRPLList := UserInfo.RPLList;
|
---|
702 | FHasCorTabs := UserInfo.HasCorTabs;
|
---|
703 | FHasRptTab := UserInfo.HasRptTab;
|
---|
704 | FIsReportsOnly := UserInfo.IsReportsOnly;
|
---|
705 | FToolsRptEdit := UserInfo.ToolsRptEdit;
|
---|
706 | FCurrentPrinter := GetDefaultPrinter(DUZ, 0);
|
---|
707 | FGECStatus := UserInfo.GECStatusCheck;
|
---|
708 | FStationNumber := UserInfo.StationNumber;
|
---|
709 | FIsProductionAccount := UserInfo.IsProductionAccount;
|
---|
710 | end;
|
---|
711 |
|
---|
712 | function TUser.HasKey(const KeyName: string): Boolean;
|
---|
713 | { returns true if the current user has the given security key }
|
---|
714 | begin
|
---|
715 | Result := HasSecurityKey(KeyName);
|
---|
716 | end;
|
---|
717 |
|
---|
718 | { TPatient methods ------------------------------------------------------------------------- }
|
---|
719 |
|
---|
720 | procedure TPatient.Clear;
|
---|
721 | { clears all fields in the Patient object }
|
---|
722 | begin
|
---|
723 | FDFN := '';
|
---|
724 | FName := '';
|
---|
725 | FSSN := '';
|
---|
726 | FDOB := 0;
|
---|
727 | FAge := 0;
|
---|
728 | FSex := 'U';
|
---|
729 | FCWAD := '';
|
---|
730 | FRestricted := False;
|
---|
731 | FInpatient := False;
|
---|
732 | FStatus := '';
|
---|
733 | FLocation := 0;
|
---|
734 | FWardService := '';
|
---|
735 | FSpecialty := 0;
|
---|
736 | FAdmitTime := 0;
|
---|
737 | FSrvConn := False;
|
---|
738 | FSCPercent := 0;
|
---|
739 | FPrimTeam := '';
|
---|
740 | FPrimProv := '';
|
---|
741 | FAttending := '';
|
---|
742 | FreeAndNil(FCombatVet);
|
---|
743 | end;
|
---|
744 |
|
---|
745 | destructor TPatient.Destroy;
|
---|
746 | begin
|
---|
747 | FreeAndNil(FCombatVet);
|
---|
748 | inherited;
|
---|
749 | end;
|
---|
750 |
|
---|
751 | function TPatient.GetCombatVet: TCombatVet;
|
---|
752 | begin
|
---|
753 | if FCombatVet = nil then
|
---|
754 | FCombatVet := TCombatVet.Create(FDFN);
|
---|
755 | Result := FCombatVet;
|
---|
756 | end;
|
---|
757 |
|
---|
758 | function TPatient.GetDateDied: TFMDateTime;
|
---|
759 | begin
|
---|
760 | if(not FDateDiedLoaded) then
|
---|
761 | begin
|
---|
762 | FDateDied := DateOfDeath(FDFN);
|
---|
763 | FDateDiedLoaded := TRUE;
|
---|
764 | end;
|
---|
765 | Result := FDateDied;
|
---|
766 | end;
|
---|
767 |
|
---|
768 | procedure TPatient.SetDFN(const Value: string); //*DFN*
|
---|
769 | { selects a patient and sets up the Patient object for the patient }
|
---|
770 | var
|
---|
771 | PtSelect: TPtSelect;
|
---|
772 | begin
|
---|
773 | if (Value = '') or (Value = FDFN) then Exit; //*DFN*
|
---|
774 | Clear;
|
---|
775 | SelectPatient(Value, PtSelect);
|
---|
776 | FDFN := Value;
|
---|
777 | FName := PtSelect.Name;
|
---|
778 | FICN := PtSelect.ICN;
|
---|
779 | FSSN := PtSelect.SSN;
|
---|
780 | FDOB := PtSelect.DOB;
|
---|
781 | FAge := PtSelect.Age;
|
---|
782 | FSex := PtSelect.Sex;
|
---|
783 | FCWAD := PtSelect.CWAD;
|
---|
784 | FRestricted := PtSelect.Restricted;
|
---|
785 | FInpatient := Length(PtSelect.Location) > 0;
|
---|
786 | if FInpatient then FStatus := ' (INPATIENT)'
|
---|
787 | else FStatus := ' (OUTPATIENT)';
|
---|
788 | FWardService :=PtSelect.WardService;
|
---|
789 | FLocation := PtSelect.LocationIEN;
|
---|
790 | FSpecialty := PtSelect.SpecialtyIEN;
|
---|
791 | FAdmitTime := PtSelect.AdmitTime;
|
---|
792 | FSrvConn := PtSelect.ServiceConnected;
|
---|
793 | FSCPercent := PtSelect.SCPercent;
|
---|
794 | FPrimTeam := PtSelect.PrimaryTeam;
|
---|
795 | FPrimProv := PtSelect.PrimaryProvider;
|
---|
796 | FAttending := PtSelect.Attending;
|
---|
797 | FAssociate := PtSelect.Associate;
|
---|
798 | end;
|
---|
799 |
|
---|
800 | { TEncounter ------------------------------------------------------------------------------- }
|
---|
801 |
|
---|
802 | constructor TEncounter.Create;
|
---|
803 | begin
|
---|
804 | inherited;
|
---|
805 | FNotifier := TORNotifier.Create(Self, TRUE);
|
---|
806 | end;
|
---|
807 |
|
---|
808 | destructor TEncounter.Destroy;
|
---|
809 | begin
|
---|
810 | FNotifier := nil; // Frees instance
|
---|
811 | inherited;
|
---|
812 | end;
|
---|
813 |
|
---|
814 | procedure TEncounter.EncounterSwitch(Loc: integer; LocName, LocText: string; DT: TFMDateTime; vCat: Char);
|
---|
815 | begin
|
---|
816 | Encounter.Location := Loc;
|
---|
817 | Encounter.LocationName := LocName;
|
---|
818 | Encounter.LocationText := LocText;
|
---|
819 | Encounter.VisitCategory := vCat;
|
---|
820 | Encounter.DateTime := DT;;
|
---|
821 | end;
|
---|
822 |
|
---|
823 | procedure TEncounter.Clear;
|
---|
824 | { clears all the fields of an Encounter (usually done upon patient selection }
|
---|
825 | begin
|
---|
826 | FChanged := False;
|
---|
827 | FDateTime := 0;
|
---|
828 | FInpatient := False;
|
---|
829 | FLocationName := '';
|
---|
830 | FLocationText := '';
|
---|
831 | FProvider := 0;
|
---|
832 | FProviderName := '';
|
---|
833 | FStandAlone := False;
|
---|
834 | FVisitCategory := #0;
|
---|
835 | SetLocation(0); // Used to call Notifications - do it last so everything else is set
|
---|
836 | end;
|
---|
837 |
|
---|
838 | function TEncounter.GetLocationText: string;
|
---|
839 | { returns abbreviated hospital location + room/bed (or date/time for appt) }
|
---|
840 | begin
|
---|
841 | if FChanged then UpdateText;
|
---|
842 | Result := FLocationText;
|
---|
843 | end;
|
---|
844 |
|
---|
845 | function TEncounter.GetLocationName: string;
|
---|
846 | { returns external text value for hospital location }
|
---|
847 | begin
|
---|
848 | if FChanged then UpdateText;
|
---|
849 | Result := FLocationName;
|
---|
850 | end;
|
---|
851 |
|
---|
852 | function TEncounter.GetProviderName: string;
|
---|
853 | { returns external text value for provider name }
|
---|
854 | begin
|
---|
855 | if FChanged then UpdateText;
|
---|
856 | Result := FProviderName;
|
---|
857 | end;
|
---|
858 |
|
---|
859 | function TEncounter.GetVisitCategory: Char;
|
---|
860 | begin
|
---|
861 | Result := FVisitCategory;
|
---|
862 | if Result = #0 then Result := 'A';
|
---|
863 | end;
|
---|
864 |
|
---|
865 | function TEncounter.GetVisitStr: string;
|
---|
866 | begin
|
---|
867 | Result := IntToStr(FLocation) + ';' + FloatToStr(FDateTime) + ';' + VisitCategory;
|
---|
868 | // use VisitCategory property to insure non-null character
|
---|
869 | end;
|
---|
870 |
|
---|
871 | function TEncounter.NeedVisit: Boolean;
|
---|
872 | { returns true if required fields for visit creation are present }
|
---|
873 | begin
|
---|
874 | // added "<" to FDateTime check to trap "-1" visit dates - v23.12 (RV)
|
---|
875 | if (FDateTime <= 0) or (FLocation = 0) then Result := True else Result := False;
|
---|
876 | end;
|
---|
877 |
|
---|
878 | procedure TEncounter.SetDateTime(Value: TFMDateTime);
|
---|
879 | { sets the date/time for the encounter - causes the visit to be reset }
|
---|
880 | begin
|
---|
881 | if Value <> FDateTime then
|
---|
882 | begin
|
---|
883 | FDateTime := Value;
|
---|
884 | FChanged := True;
|
---|
885 | end;
|
---|
886 | end;
|
---|
887 |
|
---|
888 | procedure TEncounter.SetInpatient(Value: Boolean);
|
---|
889 | { sets the inpatient flag for the encounter - causes the visit to be reset }
|
---|
890 | begin
|
---|
891 | if Value <> FInpatient then
|
---|
892 | begin
|
---|
893 | FInpatient := Value;
|
---|
894 | FChanged := True;
|
---|
895 | end;
|
---|
896 | end;
|
---|
897 |
|
---|
898 | procedure TEncounter.SetLocation(Value: Integer);
|
---|
899 | { sets the location for the encounter - causes the visit to be reset }
|
---|
900 | begin
|
---|
901 | if Value <> FLocation then
|
---|
902 | begin
|
---|
903 | FLocation := Value;
|
---|
904 | FChanged := True;
|
---|
905 | FNotifier.Notify(Self);
|
---|
906 | end;
|
---|
907 | end;
|
---|
908 |
|
---|
909 | procedure TEncounter.SetProvider(Value: Int64);
|
---|
910 | { sets the provider for the encounter - causes the visit to be reset }
|
---|
911 | begin
|
---|
912 | if Value <> FProvider then
|
---|
913 | begin
|
---|
914 | FProvider := Value;
|
---|
915 | FChanged := True;
|
---|
916 | end;
|
---|
917 | end;
|
---|
918 |
|
---|
919 | procedure TEncounter.SetStandAlone(Value: Boolean);
|
---|
920 | { StandAlone should be true if this encounter isn't related to an appointment }
|
---|
921 | begin
|
---|
922 | if Value <> FStandAlone then
|
---|
923 | begin
|
---|
924 | FStandAlone := Value;
|
---|
925 | FChanged := True;
|
---|
926 | end;
|
---|
927 | end;
|
---|
928 |
|
---|
929 | procedure TEncounter.SetVisitCategory(Value: Char);
|
---|
930 | { sets the visit type for this encounter - causes to visit to be reset }
|
---|
931 | begin
|
---|
932 | if Value <> FVisitCategory then
|
---|
933 | begin
|
---|
934 | FVisitCategory := Value;
|
---|
935 | FChanged := True;
|
---|
936 | end;
|
---|
937 | end;
|
---|
938 |
|
---|
939 | procedure TEncounter.UpdateText;
|
---|
940 | { retrieve external values for provider name, hospital location }
|
---|
941 | var
|
---|
942 | EncounterText: TEncounterText;
|
---|
943 | begin
|
---|
944 | { this references the Patient object which is assumed to be created }
|
---|
945 | EncounterText := GetEncounterText(Patient.DFN, FLocation, FProvider);
|
---|
946 | with EncounterText do
|
---|
947 | begin
|
---|
948 | FLocationName := LocationName;
|
---|
949 | if Length(LocationAbbr) > 0
|
---|
950 | then FLocationText := LocationAbbr
|
---|
951 | else FLocationText := LocationName;
|
---|
952 | if Length(LocationName) > 0 then
|
---|
953 | begin
|
---|
954 | if (FVisitCategory = 'H') //FInpatient
|
---|
955 | then FLocationText := FLocationText + ' ' + RoomBed
|
---|
956 | else FLocationText := FLocationText + ' ' +
|
---|
957 | FormatFMDateTime('mmm dd,yy hh:nn', FDateTime);
|
---|
958 | end
|
---|
959 | else FLocationText := '';
|
---|
960 | if Length(ProviderName) > 0 // ProviderName is the field in EncounterText
|
---|
961 | then FProviderName := ProviderName
|
---|
962 | else FProviderName := '';
|
---|
963 | end;
|
---|
964 | FChanged := False;
|
---|
965 | end;
|
---|
966 |
|
---|
967 | { TChangeItem ------------------------------------------------------------------------------ }
|
---|
968 |
|
---|
969 | constructor TChangeItem.Create(AnItemType: Integer; const AnID, AText, AGroupName: string;
|
---|
970 | ASignState: Integer; AParentID: string; user: int64; OrderDG: string; DCOrder, Delay: boolean);
|
---|
971 | begin
|
---|
972 | FItemType := AnItemType;
|
---|
973 | FID := AnID;
|
---|
974 | FText := AText;
|
---|
975 | FGroupName := AGroupName;
|
---|
976 | FSignState := ASignState;
|
---|
977 | FParentID := AParentID;
|
---|
978 | FUser := User;
|
---|
979 | FOrderDG := OrderDG;
|
---|
980 | FDCOrder := DCOrder;
|
---|
981 | FDelay := Delay;
|
---|
982 | end;
|
---|
983 |
|
---|
984 | { TChanges --------------------------------------------------------------------------------- }
|
---|
985 |
|
---|
986 | constructor TChanges.Create;
|
---|
987 | begin
|
---|
988 | FDocuments := TList.Create;
|
---|
989 | FOrders := TList.Create;
|
---|
990 | FPCE := TList.Create;
|
---|
991 | FOrderGrp := TStringList.Create;
|
---|
992 | FPCEGrp := TStringList.Create;
|
---|
993 | FCount := 0;
|
---|
994 | end;
|
---|
995 |
|
---|
996 | destructor TChanges.Destroy;
|
---|
997 | begin
|
---|
998 | Clear;
|
---|
999 | FDocuments.Free;
|
---|
1000 | FOrders.Free;
|
---|
1001 | FPCE.Free;
|
---|
1002 | FOrderGrp.Free;
|
---|
1003 | FPCEGrp.Free;
|
---|
1004 | inherited Destroy;
|
---|
1005 | end;
|
---|
1006 |
|
---|
1007 | procedure TChanges.Add(ItemType: Integer; const AnID, ItemText, GroupName: string;
|
---|
1008 | SignState: Integer; AParentID: string; User: int64; OrderDG: String; DCOrder, Delay: boolean);
|
---|
1009 | var
|
---|
1010 | i: Integer;
|
---|
1011 | Found: Boolean;
|
---|
1012 | ChangeList: TList;
|
---|
1013 | NewChangeItem: TChangeItem;
|
---|
1014 | begin
|
---|
1015 | ChangeList := nil;
|
---|
1016 | case ItemType of
|
---|
1017 | CH_DOC: ChangeList := FDocuments;
|
---|
1018 | CH_SUM: ChangeList := FDocuments; {*REV*}
|
---|
1019 | CH_CON: ChangeList := FDocuments;
|
---|
1020 | CH_SUR: ChangeList := FDocuments;
|
---|
1021 | CH_ORD: ChangeList := FOrders;
|
---|
1022 | CH_PCE: ChangeList := FPCE;
|
---|
1023 | end;
|
---|
1024 | Found := False;
|
---|
1025 | if ChangeList <> nil then with ChangeList do for i := 0 to Count - 1 do
|
---|
1026 | with TChangeItem(Items[i]) do if ID = AnID then
|
---|
1027 | begin
|
---|
1028 | Found := True;
|
---|
1029 | // can't change ItemType, ID, or GroupName, must call Remove first
|
---|
1030 | FText := ItemText;
|
---|
1031 | FSignState := SignState;
|
---|
1032 | end;
|
---|
1033 | if not Found then
|
---|
1034 | begin
|
---|
1035 | NewChangeItem := TChangeItem.Create(ItemType, AnID, ItemText, GroupName, SignState, AParentID, User, OrderDG, DCOrder, Delay);
|
---|
1036 | case ItemType of
|
---|
1037 | CH_DOC: begin
|
---|
1038 | FDocuments.Add(NewChangeItem);
|
---|
1039 | end;
|
---|
1040 | CH_SUM: begin {*REV*}
|
---|
1041 | FDocuments.Add(NewChangeItem);
|
---|
1042 | end;
|
---|
1043 | CH_CON: begin
|
---|
1044 | FDocuments.Add(NewChangeItem);
|
---|
1045 | end;
|
---|
1046 | CH_SUR: begin
|
---|
1047 | FDocuments.Add(NewChangeItem);
|
---|
1048 | end;
|
---|
1049 | CH_ORD: begin
|
---|
1050 | FOrders.Add(NewChangeItem);
|
---|
1051 | with FOrderGrp do if IndexOf(GroupName) < 0 then Add(GroupName);
|
---|
1052 | end;
|
---|
1053 | CH_PCE: begin
|
---|
1054 | FPCE.Add(NewChangeItem);
|
---|
1055 | with FPCEGrp do if IndexOf(GroupName) < 0 then Add(GroupName);
|
---|
1056 | end;
|
---|
1057 | end;
|
---|
1058 | Inc(FCount);
|
---|
1059 | end;
|
---|
1060 | end;
|
---|
1061 |
|
---|
1062 | function TChanges.CanSign: Boolean;
|
---|
1063 | { returns true if any items in the changes list can be signed by the user }
|
---|
1064 | var
|
---|
1065 | i: Integer;
|
---|
1066 | begin
|
---|
1067 | Result := False;
|
---|
1068 | with FDocuments do for i := 0 to Count - 1 do
|
---|
1069 | with TChangeItem(Items[i]) do if FSignState <> CH_SIGN_NA then
|
---|
1070 | begin
|
---|
1071 | Result := True;
|
---|
1072 | Exit;
|
---|
1073 | end;
|
---|
1074 | with FOrders do for i := 0 to Count - 1 do
|
---|
1075 | with TChangeItem(Items[i]) do if FSignState <> CH_SIGN_NA then
|
---|
1076 | begin
|
---|
1077 | Result := True;
|
---|
1078 | Exit;
|
---|
1079 | end;
|
---|
1080 | // don't have to worry about FPCE - it never requires signatures
|
---|
1081 | end;
|
---|
1082 |
|
---|
1083 | procedure TChanges.Clear;
|
---|
1084 | var
|
---|
1085 | i, ConsultIEN: Integer;
|
---|
1086 | DocIEN: Int64;
|
---|
1087 | OrderID: string;
|
---|
1088 | begin
|
---|
1089 | with FDocuments do for i := 0 to Count - 1 do
|
---|
1090 | begin
|
---|
1091 | DocIEN := StrToInt64Def(TChangeItem(Items[i]).ID, 0);
|
---|
1092 | UnlockDocument(DocIEN);
|
---|
1093 | ConsultIEN := GetConsultIENforNote(DocIEN);
|
---|
1094 | if ConsultIEN > -1 then
|
---|
1095 | begin
|
---|
1096 | OrderID := GetConsultOrderIEN(ConsultIEN);
|
---|
1097 | UnlockOrderIfAble(OrderID);
|
---|
1098 | end;
|
---|
1099 | TChangeItem(Items[i]).Free;
|
---|
1100 | end;
|
---|
1101 | with FOrders do for i := 0 to Count - 1 do TChangeItem(Items[i]).Free;
|
---|
1102 | with FPCE do for i := 0 to Count - 1 do TChangeItem(Items[i]).Free;
|
---|
1103 | FDocuments.Clear;
|
---|
1104 | FOrders.Clear;
|
---|
1105 | FPCE.Clear;
|
---|
1106 | FOrderGrp.Clear;
|
---|
1107 | FPCEGrp.Clear;
|
---|
1108 | FCount := 0;
|
---|
1109 | end;
|
---|
1110 |
|
---|
1111 | function TChanges.Exist(ItemType: Integer; const AnID: string): Boolean;
|
---|
1112 | var
|
---|
1113 | ChangeList: TList;
|
---|
1114 | i: Integer;
|
---|
1115 | begin
|
---|
1116 | Result := False;
|
---|
1117 | ChangeList := nil;
|
---|
1118 | case ItemType of
|
---|
1119 | CH_DOC: ChangeList := FDocuments;
|
---|
1120 | CH_SUM: ChangeList := FDocuments; {*REV*}
|
---|
1121 | CH_CON: ChangeList := FDocuments;
|
---|
1122 | CH_SUR: ChangeList := FDocuments;
|
---|
1123 | CH_ORD: ChangeList := FOrders;
|
---|
1124 | CH_PCE: ChangeList := FPCE;
|
---|
1125 | end;
|
---|
1126 | if ChangeList <> nil then with ChangeList do
|
---|
1127 | for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
---|
1128 | begin
|
---|
1129 | Result := True;
|
---|
1130 | Break;
|
---|
1131 | end;
|
---|
1132 | end;
|
---|
1133 |
|
---|
1134 | function TChanges.ExistForOrder(const AnID: string): Boolean;
|
---|
1135 | { returns TRUE if any item in the list of orders has matching order number (ignores action) }
|
---|
1136 | var
|
---|
1137 | i: Integer;
|
---|
1138 | begin
|
---|
1139 | Result := False;
|
---|
1140 | if FOrders <> nil then with FOrders do
|
---|
1141 | for i := 0 to Count - 1 do
|
---|
1142 | if Piece(TChangeItem(Items[i]).ID, ';', 1) = Piece(AnID, ';', 1) then
|
---|
1143 | begin
|
---|
1144 | Result := True;
|
---|
1145 | Break;
|
---|
1146 | end;
|
---|
1147 | end;
|
---|
1148 |
|
---|
1149 | function TChanges.Locate(ItemType: Integer; const AnID: string): TChangeItem;
|
---|
1150 | var
|
---|
1151 | ChangeList: TList;
|
---|
1152 | i: Integer;
|
---|
1153 | begin
|
---|
1154 | Result := nil;
|
---|
1155 | ChangeList := nil;
|
---|
1156 | case ItemType of
|
---|
1157 | CH_DOC: ChangeList := FDocuments;
|
---|
1158 | CH_SUM: ChangeList := FDocuments; {*REV*}
|
---|
1159 | CH_CON: ChangeList := FDocuments;
|
---|
1160 | CH_SUR: ChangeList := FDocuments;
|
---|
1161 | CH_ORD: ChangeList := FOrders;
|
---|
1162 | CH_PCE: ChangeList := FPCE;
|
---|
1163 | end;
|
---|
1164 | if ChangeList <> nil then with ChangeList do
|
---|
1165 | for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
---|
1166 | begin
|
---|
1167 | Result := TChangeItem(Items[i]);
|
---|
1168 | Break;
|
---|
1169 | end;
|
---|
1170 | end;
|
---|
1171 |
|
---|
1172 | procedure TChanges.Remove(ItemType: Integer; const AnID: string);
|
---|
1173 | { remove a change item from the appropriate list of changes (depending on type)
|
---|
1174 | this doesn't check groupnames, may leave a groupname without any associated items }
|
---|
1175 | var
|
---|
1176 | ChangeList: TList;
|
---|
1177 | i,j: Integer;
|
---|
1178 | needRemove: boolean;
|
---|
1179 | begin
|
---|
1180 | ChangeList := nil;
|
---|
1181 | case ItemType of
|
---|
1182 | CH_DOC: ChangeList := FDocuments;
|
---|
1183 | CH_SUM: ChangeList := FDocuments;
|
---|
1184 | CH_CON: ChangeList := FDocuments;
|
---|
1185 | CH_SUR: ChangeList := FDocuments;
|
---|
1186 | CH_ORD: ChangeList := FOrders;
|
---|
1187 | CH_PCE: ChangeList := FPCE;
|
---|
1188 | end;
|
---|
1189 | if ChangeList <> nil then with ChangeList do
|
---|
1190 | for i := Count - 1 downto 0 do if TChangeItem(Items[i]).ID = AnID then
|
---|
1191 | begin
|
---|
1192 | if Assigned(FOnRemove) then FOnRemove(Self, TChangeItem(Items[i])) {**RV**}
|
---|
1193 | else TChangeItem(Items[i]).Free; {**RV**}
|
---|
1194 | //TChangeItem(Items[i]).Free; {**RV**}
|
---|
1195 | // set TChangeItem(Items[i]) = nil?
|
---|
1196 | Delete(i);
|
---|
1197 | Dec(FCount);
|
---|
1198 | end;
|
---|
1199 | if ItemType = CH_ORD then
|
---|
1200 | begin
|
---|
1201 | for i := OrderGrp.Count - 1 downto 0 do
|
---|
1202 | begin
|
---|
1203 | needRemove := True;
|
---|
1204 | for j := 0 to FOrders.Count - 1 do
|
---|
1205 | if (AnsiCompareText(TChangeItem(FOrders[j]).GroupName,OrderGrp[i]) = 0 ) then
|
---|
1206 | needRemove := False;
|
---|
1207 | if needRemove then
|
---|
1208 | OrderGrp.Delete(i);
|
---|
1209 | end;
|
---|
1210 | end;
|
---|
1211 | if ItemType = CH_ORD then UnlockOrder(AnID);
|
---|
1212 | if ItemType = CH_DOC then UnlockDocument(StrToIntDef(AnID, 0));
|
---|
1213 | if ItemType = CH_CON then UnlockDocument(StrToIntDef(AnID, 0));
|
---|
1214 | if ItemType = CH_SUM then UnlockDocument(StrToIntDef(AnID, 0));
|
---|
1215 | if ItemType = CH_SUR then UnlockDocument(StrToIntDef(AnID, 0));
|
---|
1216 | end;
|
---|
1217 |
|
---|
1218 | procedure TChanges.ReplaceID(ItemType: Integer; const OldID, NewID: string);
|
---|
1219 | var
|
---|
1220 | ChangeList: TList;
|
---|
1221 | i: Integer;
|
---|
1222 | begin
|
---|
1223 | ChangeList := nil;
|
---|
1224 | case ItemType of
|
---|
1225 | CH_DOC: ChangeList := FDocuments;
|
---|
1226 | CH_SUM: ChangeList := FDocuments; {*REV*}
|
---|
1227 | CH_CON: ChangeList := FDocuments;
|
---|
1228 | CH_SUR: ChangeList := FDocuments;
|
---|
1229 | CH_ORD: ChangeList := FOrders;
|
---|
1230 | CH_PCE: ChangeList := FPCE;
|
---|
1231 | end;
|
---|
1232 | if ChangeList <> nil then with ChangeList do
|
---|
1233 | for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = OldID then
|
---|
1234 | begin
|
---|
1235 | TChangeItem(Items[i]).FID := NewID;
|
---|
1236 | end;
|
---|
1237 | end;
|
---|
1238 |
|
---|
1239 | procedure TChanges.ReplaceSignState(ItemType: Integer; const AnID: string; NewState: Integer);
|
---|
1240 | var
|
---|
1241 | ChangeList: TList;
|
---|
1242 | i: Integer;
|
---|
1243 | begin
|
---|
1244 | ChangeList := nil;
|
---|
1245 | case ItemType of
|
---|
1246 | CH_DOC: ChangeList := FDocuments;
|
---|
1247 | CH_SUM: ChangeList := FDocuments; {*REV*}
|
---|
1248 | CH_CON: ChangeList := FDocuments;
|
---|
1249 | CH_SUR: ChangeList := FDocuments;
|
---|
1250 | CH_ORD: ChangeList := FOrders;
|
---|
1251 | CH_PCE: ChangeList := FPCE;
|
---|
1252 | end;
|
---|
1253 | if ChangeList <> nil then with ChangeList do
|
---|
1254 | for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
---|
1255 | begin
|
---|
1256 | TChangeItem(Items[i]).FSignState := NewState;
|
---|
1257 | end;
|
---|
1258 | end;
|
---|
1259 |
|
---|
1260 | procedure TChanges.ReplaceText(ItemType: Integer; const AnID, NewText: string);
|
---|
1261 | var
|
---|
1262 | ChangeList: TList;
|
---|
1263 | i: Integer;
|
---|
1264 | begin
|
---|
1265 | ChangeList := nil;
|
---|
1266 | case ItemType of
|
---|
1267 | CH_DOC: ChangeList := FDocuments;
|
---|
1268 | CH_SUM: ChangeList := FDocuments; {*REV*}
|
---|
1269 | CH_CON: ChangeList := FDocuments;
|
---|
1270 | CH_SUR: ChangeList := FDocuments;
|
---|
1271 | CH_ORD: ChangeList := FOrders;
|
---|
1272 | CH_PCE: ChangeList := FPCE;
|
---|
1273 | end;
|
---|
1274 | if ChangeList <> nil then with ChangeList do
|
---|
1275 | for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
---|
1276 | begin
|
---|
1277 | TChangeItem(Items[i]).FText := NewText;
|
---|
1278 | end;
|
---|
1279 | end;
|
---|
1280 |
|
---|
1281 | function TChanges.RequireReview: Boolean;
|
---|
1282 | { returns true if documents can be signed or if any orders exist in Changes }
|
---|
1283 | var
|
---|
1284 | i: Integer;
|
---|
1285 | begin
|
---|
1286 | Result := False;
|
---|
1287 | AddUnsignedToChanges;
|
---|
1288 | if FOrders.Count > 0 then Result := True;
|
---|
1289 | if Result = False then with FDocuments do for i := 0 to Count - 1 do
|
---|
1290 | with TChangeItem(Items[i]) do if FSignState <> CH_SIGN_NA then
|
---|
1291 | begin
|
---|
1292 | Result := True;
|
---|
1293 | Break;
|
---|
1294 | end;
|
---|
1295 | end;
|
---|
1296 |
|
---|
1297 | procedure TChanges.AddUnsignedToChanges;
|
---|
1298 | { retrieves unsigned orders outside this session based on OR UNSIGNED ORDERS ON EXIT }
|
---|
1299 | var
|
---|
1300 | i, CanSign(*, OrderUser*): Integer;
|
---|
1301 | OrderUser: int64;
|
---|
1302 | AnID, Display: string;
|
---|
1303 | HaveOrders, OtherOrders: TStringList;
|
---|
1304 | AChangeItem: TChangeItem;
|
---|
1305 | IsDiscontinue, IsDelay: boolean;
|
---|
1306 | begin
|
---|
1307 | if Patient.DFN = '' then Exit;
|
---|
1308 | // exit if there is already an 'Other Unsigned' group?
|
---|
1309 | HaveOrders := TStringList.Create;
|
---|
1310 | OtherOrders := TStringList.Create;
|
---|
1311 | try
|
---|
1312 | StatusText('Looking for unsigned orders...');
|
---|
1313 | for i := 0 to Pred(FOrders.Count) do
|
---|
1314 | begin
|
---|
1315 | AChangeItem := FOrders[i];
|
---|
1316 | HaveOrders.Add(AChangeItem.ID);
|
---|
1317 | end;
|
---|
1318 | LoadUnsignedOrders(OtherOrders, HaveOrders);
|
---|
1319 | if (Encounter.Provider = User.DUZ) and User.CanSignOrders
|
---|
1320 | then CanSign := CH_SIGN_YES
|
---|
1321 | else CanSign := CH_SIGN_NA;
|
---|
1322 | for i := 0 to Pred(OtherOrders.Count) do
|
---|
1323 | begin
|
---|
1324 | AnID := Piece(OtherOrders[i],U,1);
|
---|
1325 | if Piece(OtherOrders[i],U,2) = '' then OrderUser := 0
|
---|
1326 | else OrderUser := StrtoInt64(Piece(OtherOrders[i],U,2));
|
---|
1327 | //agp change the M code to pass back the value for the new order properties
|
---|
1328 | Display := Piece(OtherOrders[i],U,3);
|
---|
1329 | if Piece(OtherOrders[i],U,4) = '1' then IsDiscontinue := True
|
---|
1330 | else IsDiscontinue := False;
|
---|
1331 | if Piece(OtherOrders[i],U,5) = '1' then IsDelay := True
|
---|
1332 | else IsDelay := False;
|
---|
1333 | Add(CH_ORD, AnID, TextForOrder(AnID), 'Other Unsigned', CanSign,'', OrderUser, Display, IsDiscontinue, IsDelay);
|
---|
1334 | end;
|
---|
1335 | finally
|
---|
1336 | StatusText('');
|
---|
1337 | HaveOrders.Free;
|
---|
1338 | OtherOrders.Free;
|
---|
1339 | end;
|
---|
1340 | end;
|
---|
1341 |
|
---|
1342 | { TNotifications ---------------------------------------------------------------------------- }
|
---|
1343 |
|
---|
1344 | constructor TNotifications.Create;
|
---|
1345 | begin
|
---|
1346 | FList := TList.Create;
|
---|
1347 | FCurrentIndex := -1;
|
---|
1348 | FActive := False;
|
---|
1349 | end;
|
---|
1350 |
|
---|
1351 | destructor TNotifications.Destroy;
|
---|
1352 | begin
|
---|
1353 | Clear;
|
---|
1354 | FList.Free;
|
---|
1355 | inherited Destroy;
|
---|
1356 | end;
|
---|
1357 |
|
---|
1358 | procedure TNotifications.Add(const ADFN: string; AFollowUp: Integer; const ARecordID: string; AHighLightSection : string = ''); //*DFN*
|
---|
1359 | var
|
---|
1360 | NotifyItem: TNotifyItem;
|
---|
1361 | begin
|
---|
1362 | NotifyItem := TNotifyItem.Create;
|
---|
1363 | NotifyItem.DFN := ADFN;
|
---|
1364 | NotifyItem.FollowUp := AFollowUp;
|
---|
1365 | NotifyItem.RecordID := ARecordId;
|
---|
1366 | If AHighLightSection <> '' then NotifyItem.HighLightSection := AHighLightSection;
|
---|
1367 | FList.Add(NotifyItem);
|
---|
1368 | FActive := True;
|
---|
1369 | end;
|
---|
1370 |
|
---|
1371 | procedure TNotifications.Clear;
|
---|
1372 | var
|
---|
1373 | i: Integer;
|
---|
1374 | begin
|
---|
1375 | with FList do for i := 0 to Count - 1 do with TNotifyItem(Items[i]) do Free;
|
---|
1376 | FList.Clear;
|
---|
1377 | FActive := False;
|
---|
1378 | FCurrentIndex := -1;
|
---|
1379 | FNotifyItem := nil;
|
---|
1380 | end;
|
---|
1381 |
|
---|
1382 | function TNotifications.GetDFN: string; //*DFN*
|
---|
1383 | begin
|
---|
1384 | if FNotifyItem <> nil then Result := FNotifyItem.DFN else Result := ''; //*DFN*
|
---|
1385 | end;
|
---|
1386 |
|
---|
1387 | function TNotifications.GetFollowUp: Integer;
|
---|
1388 | begin
|
---|
1389 | if FNotifyItem <> nil then Result := FNotifyItem.FollowUp else Result := 0;
|
---|
1390 | end;
|
---|
1391 |
|
---|
1392 | function TNotifications.GetAlertData: string;
|
---|
1393 | begin
|
---|
1394 | if FNotifyItem <> nil
|
---|
1395 | then Result := GetXQAData(Piece(FNotifyItem.RecordID, U, 2))
|
---|
1396 | else Result := '';
|
---|
1397 | end;
|
---|
1398 |
|
---|
1399 | function TNotifications.GetRecordID: string;
|
---|
1400 | begin
|
---|
1401 | if FNotifyItem <> nil then Result := FNotifyItem.RecordID else Result := '';
|
---|
1402 | end;
|
---|
1403 |
|
---|
1404 | function TNotifications.GetText: string;
|
---|
1405 | begin
|
---|
1406 | if FNotifyItem <> nil
|
---|
1407 | then Result := Piece(Piece(FNotifyItem.RecordID, U, 1 ), ':', 2)
|
---|
1408 | else Result := '';
|
---|
1409 | end;
|
---|
1410 |
|
---|
1411 | function TNotifications.GetHighLightSection: String; //CB
|
---|
1412 | begin
|
---|
1413 | if FNotifyItem <> nil then Result := FNotifyItem.HighLightSection else Result := '';
|
---|
1414 | end;
|
---|
1415 |
|
---|
1416 |
|
---|
1417 | procedure TNotifications.Next;
|
---|
1418 | begin
|
---|
1419 | Inc(FCurrentIndex);
|
---|
1420 | if FCurrentIndex < FList.Count then FNotifyItem := TNotifyItem(FList[FCurrentIndex]) else
|
---|
1421 | begin
|
---|
1422 | FActive := False;
|
---|
1423 | FNotifyItem := nil;
|
---|
1424 | end;
|
---|
1425 | end;
|
---|
1426 |
|
---|
1427 | procedure TNotifications.Prior;
|
---|
1428 | begin
|
---|
1429 | Dec(FCurrentIndex);
|
---|
1430 | if FCurrentIndex < 0
|
---|
1431 | then FNotifyItem := nil
|
---|
1432 | else FNotifyItem := TNotifyItem(FList[FCurrentIndex]);
|
---|
1433 | if FList.Count > 0 then FActive := True;
|
---|
1434 | end;
|
---|
1435 |
|
---|
1436 | procedure TNotifications.Delete;
|
---|
1437 | begin
|
---|
1438 | if FNotifyItem <> nil then DeleteAlert(Piece(FNotifyItem.RecordID, U, 2));
|
---|
1439 | end;
|
---|
1440 |
|
---|
1441 | procedure TNotifications.DeleteForCurrentUser;
|
---|
1442 | begin
|
---|
1443 | if FNotifyItem <> nil then DeleteAlertForUser(Piece(FNotifyItem.RecordID, U, 2));
|
---|
1444 | end;
|
---|
1445 |
|
---|
1446 | { TRemoteSite methods ---------------------------------------------------------------------------- }
|
---|
1447 |
|
---|
1448 | constructor TRemoteSite.Create(ASite: string);
|
---|
1449 | begin
|
---|
1450 | FSiteID := Piece(ASite, U, 1);
|
---|
1451 | FSiteName := MixedCase(Piece(ASite, U, 2));
|
---|
1452 | FLastDate := StrToFMDateTime(Piece(ASite, U, 3));
|
---|
1453 | FSelected := False;
|
---|
1454 | FQueryStatus := '';
|
---|
1455 | FData := TStringList.Create;
|
---|
1456 | FLabQueryStatus := '';
|
---|
1457 | FLabData := TStringList.Create;
|
---|
1458 | FCurrentLabQuery := '';
|
---|
1459 | FCurrentReportQuery := '';
|
---|
1460 | end;
|
---|
1461 |
|
---|
1462 | destructor TRemoteSite.Destroy;
|
---|
1463 | begin
|
---|
1464 | LabClear;
|
---|
1465 | ReportClear;
|
---|
1466 | FData.Free;
|
---|
1467 | FLabData.Free;
|
---|
1468 | inherited Destroy;
|
---|
1469 | end;
|
---|
1470 |
|
---|
1471 | procedure TRemoteSite.ReportClear;
|
---|
1472 | begin
|
---|
1473 | FData.Clear;
|
---|
1474 | FQueryStatus := '';
|
---|
1475 | end;
|
---|
1476 |
|
---|
1477 | procedure TRemoteSite.LabClear;
|
---|
1478 | begin
|
---|
1479 | FLabData.Clear;
|
---|
1480 | FLabQueryStatus := '';
|
---|
1481 | end;
|
---|
1482 |
|
---|
1483 | procedure TRemoteSite.SetSelected(Value: boolean);
|
---|
1484 | begin
|
---|
1485 | FSelected := Value;
|
---|
1486 | end;
|
---|
1487 |
|
---|
1488 | constructor TRemoteReport.Create(AReport: string);
|
---|
1489 | begin
|
---|
1490 | FReport := AReport;
|
---|
1491 | FHandle := '';
|
---|
1492 | end;
|
---|
1493 |
|
---|
1494 | destructor TRemoteReport.Destroy;
|
---|
1495 | begin
|
---|
1496 | inherited Destroy;
|
---|
1497 | end;
|
---|
1498 |
|
---|
1499 | constructor TRemoteReportList.Create;
|
---|
1500 | begin
|
---|
1501 | FReportList := TList.Create;
|
---|
1502 | FCount := 0;
|
---|
1503 | end;
|
---|
1504 |
|
---|
1505 | destructor TRemoteReportList.Destroy;
|
---|
1506 | begin
|
---|
1507 | //Clear;
|
---|
1508 | FReportList.Free;
|
---|
1509 | inherited Destroy;
|
---|
1510 | end;
|
---|
1511 |
|
---|
1512 | procedure TRemoteReportList.Add(AReportList, AHandle: string);
|
---|
1513 | var
|
---|
1514 | ARemoteReport: TRemoteReport;
|
---|
1515 | begin
|
---|
1516 | ARemoteReport := TRemoteReport.Create(AReportList);
|
---|
1517 | ARemoteReport.Handle := AHandle;
|
---|
1518 | ARemoteReport.Report := AReportList;
|
---|
1519 | FReportList.Add(ARemoteReport);
|
---|
1520 | FCount := FReportList.Count;
|
---|
1521 | end;
|
---|
1522 |
|
---|
1523 | procedure TRemoteReportList.Clear;
|
---|
1524 | var
|
---|
1525 | i: Integer;
|
---|
1526 | begin
|
---|
1527 | with FReportList do
|
---|
1528 | for i := 0 to Count - 1 do
|
---|
1529 | with TRemoteReport(Items[i]) do Free;
|
---|
1530 | FReportList.Clear;
|
---|
1531 | FCount := 0;
|
---|
1532 | end;
|
---|
1533 |
|
---|
1534 | constructor TRemoteSiteList.Create;
|
---|
1535 | begin
|
---|
1536 | FSiteList := TList.Create;
|
---|
1537 | FCount := 0;
|
---|
1538 | end;
|
---|
1539 |
|
---|
1540 | destructor TRemoteSiteList.Destroy;
|
---|
1541 | begin
|
---|
1542 | Clear;
|
---|
1543 | FSiteList.Free;
|
---|
1544 | inherited Destroy;
|
---|
1545 | end;
|
---|
1546 |
|
---|
1547 | procedure TRemoteSiteList.Add(ASite: string);
|
---|
1548 | var
|
---|
1549 | ARemoteSite: TRemoteSite;
|
---|
1550 | begin
|
---|
1551 | ARemoteSite := TRemoteSite.Create(ASite);
|
---|
1552 | FSiteList.Add(ARemoteSite);
|
---|
1553 | FCount := FSiteList.Count;
|
---|
1554 | end;
|
---|
1555 |
|
---|
1556 | procedure TRemoteSiteList.Clear;
|
---|
1557 | var
|
---|
1558 | i: Integer;
|
---|
1559 | begin
|
---|
1560 | with FSiteList do for i := 0 to Count - 1 do with TRemoteSite(Items[i]) do Free;
|
---|
1561 | FSiteList.Clear;
|
---|
1562 | FCount := 0;
|
---|
1563 | end;
|
---|
1564 |
|
---|
1565 | procedure TRemoteSiteList.ChangePatient(const DFN: string);
|
---|
1566 | var
|
---|
1567 | ALocations: TStringList;
|
---|
1568 | i: integer;
|
---|
1569 | begin
|
---|
1570 | Clear;
|
---|
1571 | ALocations := TStringList.Create;
|
---|
1572 | try
|
---|
1573 | FRemoteDataExists := HasRemoteData(DFN, ALocations);
|
---|
1574 | if FRemoteDataExists then
|
---|
1575 | begin
|
---|
1576 | SortByPiece(ALocations, '^', 2);
|
---|
1577 | for i := 0 to ALocations.Count - 1 do
|
---|
1578 | if piece(ALocations[i],'^',5) = '1' then
|
---|
1579 | Add(ALocations.Strings[i]);
|
---|
1580 | FNoDataReason := '';
|
---|
1581 | end
|
---|
1582 | else
|
---|
1583 | FNoDataReason := Piece(ALocations[0], U, 2);
|
---|
1584 | FCount := FSiteList.Count;
|
---|
1585 | finally
|
---|
1586 | ALocations.Free;
|
---|
1587 | end;
|
---|
1588 | end;
|
---|
1589 |
|
---|
1590 | procedure TUser.SetCurrentPrinter(Value: string);
|
---|
1591 | begin
|
---|
1592 | FCurrentPrinter := Value;
|
---|
1593 | end;
|
---|
1594 |
|
---|
1595 | procedure GotoWebPage(const URL: WideString);
|
---|
1596 | begin
|
---|
1597 | if(URLMonHandle <> 0) then
|
---|
1598 | HlinkNav(nil, PWideChar(URL));
|
---|
1599 | end;
|
---|
1600 |
|
---|
1601 | procedure LoadURLMon;
|
---|
1602 | const
|
---|
1603 | UrlMonLib = 'URLMON.DLL';
|
---|
1604 | HlinkName = 'HlinkNavigateString';
|
---|
1605 |
|
---|
1606 | begin
|
---|
1607 | URLMonHandle := LoadLibrary(PChar(UrlMonLib));
|
---|
1608 | if URLMonHandle <= HINSTANCE_ERROR then
|
---|
1609 | URLMonHandle := 0
|
---|
1610 | else
|
---|
1611 | begin
|
---|
1612 | HlinkNav := GetProcAddress(URLMonHandle, HlinkName);
|
---|
1613 | if(not assigned(HlinkNav)) then
|
---|
1614 | begin
|
---|
1615 | FreeLibrary(URLMonHandle);
|
---|
1616 | URLMonHandle := 0;
|
---|
1617 | end;
|
---|
1618 | end;
|
---|
1619 | end;
|
---|
1620 |
|
---|
1621 | procedure ReleaseURLMon;
|
---|
1622 | begin
|
---|
1623 | if(URLMonHandle <> 0) then
|
---|
1624 | begin
|
---|
1625 | FreeLibrary(URLMonHandle);
|
---|
1626 | URLMonHandle := 0;
|
---|
1627 | end;
|
---|
1628 | end;
|
---|
1629 |
|
---|
1630 | procedure TChanges.ReplaceODGrpName(const AnODID, NewGrp: string);
|
---|
1631 | var
|
---|
1632 | ChangeList: TList;
|
---|
1633 | i: Integer;
|
---|
1634 | begin
|
---|
1635 | ChangeList := FOrders;
|
---|
1636 | if ChangeList <> nil then with ChangeList do
|
---|
1637 | for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnODID then
|
---|
1638 | TChangeItem(Items[i]).FGroupName := NewGrp;
|
---|
1639 | end;
|
---|
1640 |
|
---|
1641 | procedure TChanges.ChangeOrderGrp(const oldGrpName,newGrpName: string);
|
---|
1642 | var
|
---|
1643 | i : integer;
|
---|
1644 | begin
|
---|
1645 | for i := 0 to FOrderGrp.Count - 1 do
|
---|
1646 | begin
|
---|
1647 | if AnsiCompareText(FOrderGrp[i],oldGrpName)= 0 then
|
---|
1648 | FOrderGrp[i] := newGrpName;
|
---|
1649 | end;
|
---|
1650 | end;
|
---|
1651 |
|
---|
1652 | initialization
|
---|
1653 | uVistaMsg := 0;
|
---|
1654 | LoadURLMon;
|
---|
1655 |
|
---|
1656 | finalization
|
---|
1657 | ReleaseURLMon;
|
---|
1658 | ReleaseAppNotification;
|
---|
1659 |
|
---|
1660 | end.
|
---|