source: cprs/trunk/CPRS-Chart/uCore.pas@ 1545

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

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