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

Last change on this file since 1806 was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28
File size: 51.5 KB
RevLine 
[456]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
[1679]9uses SysUtils, Windows, Classes, Forms, ORFn, rCore, uConst, ORClasses, uCombatVet;
[456]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
[1679]88 FStatus: string; // Patient status indicator (Inpatient or Outpatient)
[456]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
[1679]98 FAssociate: string; // if inpatient, name of associate
[456]99 FDateDied: TFMDateTime; // Date of Patient Death (<=0 or still alive)
100 FDateDiedLoaded: boolean; // Used to determine of DateDied has been loaded
[1679]101 FCombatVet : TCombatVet; // Object Holding CombatVet Data
[456]102 procedure SetDFN(const Value: string);
[1679]103 function GetDateDied: TFMDateTime;
104 function GetCombatVet: TCombatVet; // *DFN*
[456]105 public
106 procedure Clear;
[1679]107 destructor Destroy; override;
[456]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;
[1679]117 property Status: string read FStatus;
[456]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;
[1679]128 property Associate: string read FAssociate;
129 property CombatVet: TCombatVet read GetCombatVet;
[456]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;
[830]161 procedure EncounterSwitch(Loc: integer; LocName, LocText: string; DT: TFMDateTime; vCat: Char);
[456]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;
[830]166 property LocationName: string read GetLocationName write FLocationName;
167 property LocationText: string read GetLocationText write FLocationText;
[456]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;
[830]184 FUser : Int64;
[1679]185 FOrderDG : String;
[830]186 FDCOrder : boolean;
187 FDelay : boolean;
[456]188 constructor Create(AnItemType: Integer; const AnID, AText, AGroupName: string;
[830]189 ASignState: Integer; AParentID: string = ''; User: int64 = 0; OrderDG: string = ''; DCOrder: boolean = False; Delay: boolean = False);
[456]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;
[830]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;
[456]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;
[830]219 procedure Add(ItemType: Integer; const AnID, ItemText, GroupName: string; SignState: Integer; AParentID: string = '';
[1679]220 User: int64 = 0; OrderDG: String = ''; DCOrder: boolean = FALSE; Delay: boolean = False);
[456]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;
[1679]248 HighLightSection: String;
[456]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;
[1679]260 function GetHighLightSection: String; //CB
[456]261 function GetRecordID: string;
262 function GetText: string;
263 public
264 constructor Create;
265 destructor Destroy; override;
[1679]266 procedure Add(const ADFN: string; AFollowUp: Integer; const ARecordID: string; AHighLightSection : string = ''); //*DFN* CB
[456]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;
[1679]278 property HighLightSection: String read GetHighLightSection; //cb
[456]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
369var
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.
[830]382 TempEncounterText: string;
383 TempEncounterDateTime: TFMDateTime;
384 TempEncounterVistCat: Char;
385 //TempOutEncounterLoc: Integer;
386 //TempOutEncounterLocName: string;
[456]387
388procedure NotifyOtherApps(const AppEvent, AppData: string);
389procedure FlushNotifierBuffer;
390procedure TerminateOtherAppNotification;
391procedure GotoWebPage(const URL: WideString);
[830]392function AllowAccessToSensitivePatient(NewDFN: string; var AccessStatus: integer): boolean;
[456]393
[830]394
[456]395implementation
396
397uses rTIU, rOrders, rConsults, uOrders;
398
399type
400 HlinkNavProc = function(pUnk: IUnknown; szTarget: PWideChar): HResult; stdcall;
401
402var
403 uVistaMsg, uVistaDomMsg: UINT;
404 URLMonHandle: THandle = 0;
405 HlinkNav: HlinkNavProc;
406
407type
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
421var
422 uSynchronizer: TMultiReadExclusiveWriteSynchronizer = nil;
423 uNotifyAppsThread: TNotifyAppsThread = nil;
424 uNotifyAppsQueue: TStringList = nil;
425 uNotifyAppsActive: boolean = TRUE;
426 AnAtom: ATOM = 0;
427
428const
429 LONG_BROADCAST_TIMEOUT = 30000; // 30 seconds
430 SHORT_BROADCAST_TIMEOUT = 2000; // 2 seconds
431 MSG_TYPE: array[TMsgType] of String = ('V','D');
432
[830]433function AllowAccessToSensitivePatient(NewDFN: string; var AccessStatus: integer): boolean;
434const
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: ';
441var
442 //AccessStatus: integer;
443 AMsg, PrefixC, PrefixT: string;
444begin
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;
473end;
474
[456]475function QueuePending: boolean;
476begin
477 uSynchronizer.BeginRead;
478 try
479 Result := (uNotifyAppsQueue.Count > 0);
480 finally
481 uSynchronizer.EndRead;
482 end;
483end;
484
485procedure ProcessQueue(ShortTimout: boolean);
486var
487 msg: String;
488 process: boolean;
489 AResult: LPDWORD;
490 MsgCode, timeout: UINT;
491 TypeCode: String;
492
493begin
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;
539end;
540
541constructor TNotifyAppsThread.CreateThread;
542begin
543 inherited Create(TRUE);
544 FRunning := TRUE;
545end;
546
547procedure TNotifyAppsThread.ResumeIfIdle;
548begin
549 if(Suspended) then
550 Resume;
551end;
552
553procedure TNotifyAppsThread.ResumeAndTerminate;
554begin
555 Terminate;
556 if(Suspended) then
557 Resume;
558end;
559
560procedure TNotifyAppsThread.Execute;
561begin
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;
570end;
571
572function AppNotificationEnabled: boolean;
573begin
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;
590end;
591
592procedure ReleaseAppNotification;
593var
594 waitState: DWORD;
595
596begin
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);
627end;
628
629procedure NotifyOtherApps(const AppEvent, AppData: string);
630var
631 m1: string;
632 m2: string;
633
634begin
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;
650end;
651
652procedure FlushNotifierBuffer;
653begin
654 if(AppNotificationEnabled) then
655 begin
656 uSynchronizer.BeginWrite;
657 try
658 uNotifyAppsQueue.Clear;
659 finally
660 uSynchronizer.EndWrite;
661 end;
662 end;
663end;
664
665procedure TerminateOtherAppNotification;
666begin
667 ReleaseAppNotification;
668end;
669
670{ TUser methods ---------------------------------------------------------------------------- }
671
672constructor TUser.Create;
673{ create the User object for the currently logged in user }
674var
675 UserInfo: TUserInfo;
676begin
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;
710end;
711
712function TUser.HasKey(const KeyName: string): Boolean;
713{ returns true if the current user has the given security key }
714begin
715 Result := HasSecurityKey(KeyName);
716end;
717
718{ TPatient methods ------------------------------------------------------------------------- }
719
720procedure TPatient.Clear;
721{ clears all fields in the Patient object }
722begin
723 FDFN := '';
724 FName := '';
725 FSSN := '';
726 FDOB := 0;
727 FAge := 0;
728 FSex := 'U';
729 FCWAD := '';
730 FRestricted := False;
731 FInpatient := False;
[1679]732 FStatus := '';
[456]733 FLocation := 0;
734 FWardService := '';
735 FSpecialty := 0;
736 FAdmitTime := 0;
737 FSrvConn := False;
738 FSCPercent := 0;
739 FPrimTeam := '';
740 FPrimProv := '';
741 FAttending := '';
[1679]742 FreeAndNil(FCombatVet);
[456]743end;
744
[1679]745destructor TPatient.Destroy;
746begin
747 FreeAndNil(FCombatVet);
748 inherited;
749end;
750
751function TPatient.GetCombatVet: TCombatVet;
752begin
753 if FCombatVet = nil then
754 FCombatVet := TCombatVet.Create(FDFN);
755 Result := FCombatVet;
756end;
757
[456]758function TPatient.GetDateDied: TFMDateTime;
759begin
760 if(not FDateDiedLoaded) then
761 begin
762 FDateDied := DateOfDeath(FDFN);
763 FDateDiedLoaded := TRUE;
764 end;
765 Result := FDateDied;
766end;
767
768procedure TPatient.SetDFN(const Value: string); //*DFN*
769{ selects a patient and sets up the Patient object for the patient }
770var
771 PtSelect: TPtSelect;
772begin
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;
[1679]786 if FInpatient then FStatus := ' (INPATIENT)'
787 else FStatus := ' (OUTPATIENT)';
[456]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;
[1679]797 FAssociate := PtSelect.Associate;
[456]798end;
799
800{ TEncounter ------------------------------------------------------------------------------- }
801
802constructor TEncounter.Create;
803begin
804 inherited;
805 FNotifier := TORNotifier.Create(Self, TRUE);
806end;
807
808destructor TEncounter.Destroy;
809begin
810 FNotifier := nil; // Frees instance
811 inherited;
812end;
813
[830]814procedure TEncounter.EncounterSwitch(Loc: integer; LocName, LocText: string; DT: TFMDateTime; vCat: Char);
815begin
816 Encounter.Location := Loc;
817 Encounter.LocationName := LocName;
818 Encounter.LocationText := LocText;
819 Encounter.VisitCategory := vCat;
820 Encounter.DateTime := DT;;
821end;
822
[456]823procedure TEncounter.Clear;
824{ clears all the fields of an Encounter (usually done upon patient selection }
825begin
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
836end;
837
838function TEncounter.GetLocationText: string;
839{ returns abbreviated hospital location + room/bed (or date/time for appt) }
840begin
841 if FChanged then UpdateText;
842 Result := FLocationText;
843end;
844
845function TEncounter.GetLocationName: string;
846{ returns external text value for hospital location }
847begin
848 if FChanged then UpdateText;
849 Result := FLocationName;
850end;
851
852function TEncounter.GetProviderName: string;
853{ returns external text value for provider name }
854begin
855 if FChanged then UpdateText;
856 Result := FProviderName;
857end;
858
859function TEncounter.GetVisitCategory: Char;
860begin
861 Result := FVisitCategory;
862 if Result = #0 then Result := 'A';
863end;
864
865function TEncounter.GetVisitStr: string;
866begin
867 Result := IntToStr(FLocation) + ';' + FloatToStr(FDateTime) + ';' + VisitCategory;
868 // use VisitCategory property to insure non-null character
869end;
870
871function TEncounter.NeedVisit: Boolean;
872{ returns true if required fields for visit creation are present }
873begin
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;
876end;
877
878procedure TEncounter.SetDateTime(Value: TFMDateTime);
879{ sets the date/time for the encounter - causes the visit to be reset }
880begin
881 if Value <> FDateTime then
882 begin
883 FDateTime := Value;
884 FChanged := True;
885 end;
886end;
887
888procedure TEncounter.SetInpatient(Value: Boolean);
889{ sets the inpatient flag for the encounter - causes the visit to be reset }
890begin
891 if Value <> FInpatient then
892 begin
893 FInpatient := Value;
894 FChanged := True;
895 end;
896end;
897
898procedure TEncounter.SetLocation(Value: Integer);
899{ sets the location for the encounter - causes the visit to be reset }
900begin
901 if Value <> FLocation then
902 begin
903 FLocation := Value;
904 FChanged := True;
905 FNotifier.Notify(Self);
906 end;
907end;
908
909procedure TEncounter.SetProvider(Value: Int64);
910{ sets the provider for the encounter - causes the visit to be reset }
911begin
912 if Value <> FProvider then
913 begin
914 FProvider := Value;
915 FChanged := True;
916 end;
917end;
918
919procedure TEncounter.SetStandAlone(Value: Boolean);
920{ StandAlone should be true if this encounter isn't related to an appointment }
921begin
922 if Value <> FStandAlone then
923 begin
924 FStandAlone := Value;
925 FChanged := True;
926 end;
927end;
928
929procedure TEncounter.SetVisitCategory(Value: Char);
930{ sets the visit type for this encounter - causes to visit to be reset }
931begin
932 if Value <> FVisitCategory then
933 begin
934 FVisitCategory := Value;
935 FChanged := True;
936 end;
937end;
938
939procedure TEncounter.UpdateText;
940{ retrieve external values for provider name, hospital location }
941var
942 EncounterText: TEncounterText;
943begin
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;
965end;
966
967{ TChangeItem ------------------------------------------------------------------------------ }
968
969constructor TChangeItem.Create(AnItemType: Integer; const AnID, AText, AGroupName: string;
[830]970 ASignState: Integer; AParentID: string; user: int64; OrderDG: string; DCOrder, Delay: boolean);
[456]971begin
972 FItemType := AnItemType;
973 FID := AnID;
974 FText := AText;
975 FGroupName := AGroupName;
976 FSignState := ASignState;
977 FParentID := AParentID;
[830]978 FUser := User;
979 FOrderDG := OrderDG;
980 FDCOrder := DCOrder;
981 FDelay := Delay;
[456]982end;
983
984{ TChanges --------------------------------------------------------------------------------- }
985
986constructor TChanges.Create;
987begin
988 FDocuments := TList.Create;
989 FOrders := TList.Create;
990 FPCE := TList.Create;
991 FOrderGrp := TStringList.Create;
992 FPCEGrp := TStringList.Create;
993 FCount := 0;
994end;
995
996destructor TChanges.Destroy;
997begin
998 Clear;
999 FDocuments.Free;
1000 FOrders.Free;
1001 FPCE.Free;
1002 FOrderGrp.Free;
1003 FPCEGrp.Free;
1004 inherited Destroy;
1005end;
1006
1007procedure TChanges.Add(ItemType: Integer; const AnID, ItemText, GroupName: string;
[830]1008 SignState: Integer; AParentID: string; User: int64; OrderDG: String; DCOrder, Delay: boolean);
[456]1009var
1010 i: Integer;
1011 Found: Boolean;
1012 ChangeList: TList;
1013 NewChangeItem: TChangeItem;
1014begin
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
[830]1035 NewChangeItem := TChangeItem.Create(ItemType, AnID, ItemText, GroupName, SignState, AParentID, User, OrderDG, DCOrder, Delay);
[456]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;
1060end;
1061
1062function TChanges.CanSign: Boolean;
1063{ returns true if any items in the changes list can be signed by the user }
1064var
1065 i: Integer;
1066begin
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
1081end;
1082
1083procedure TChanges.Clear;
1084var
1085 i, ConsultIEN: Integer;
1086 DocIEN: Int64;
1087 OrderID: string;
1088begin
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;
1109end;
1110
1111function TChanges.Exist(ItemType: Integer; const AnID: string): Boolean;
1112var
1113 ChangeList: TList;
1114 i: Integer;
1115begin
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;
1132end;
1133
1134function TChanges.ExistForOrder(const AnID: string): Boolean;
1135{ returns TRUE if any item in the list of orders has matching order number (ignores action) }
1136var
1137 i: Integer;
1138begin
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;
1147end;
1148
1149function TChanges.Locate(ItemType: Integer; const AnID: string): TChangeItem;
1150var
1151 ChangeList: TList;
1152 i: Integer;
1153begin
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;
1170end;
1171
1172procedure 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 }
1175var
1176 ChangeList: TList;
1177 i,j: Integer;
1178 needRemove: boolean;
1179begin
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));
1216end;
1217
1218procedure TChanges.ReplaceID(ItemType: Integer; const OldID, NewID: string);
1219var
1220 ChangeList: TList;
1221 i: Integer;
1222begin
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;
1237end;
1238
1239procedure TChanges.ReplaceSignState(ItemType: Integer; const AnID: string; NewState: Integer);
1240var
1241 ChangeList: TList;
1242 i: Integer;
1243begin
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;
1258end;
1259
1260procedure TChanges.ReplaceText(ItemType: Integer; const AnID, NewText: string);
1261var
1262 ChangeList: TList;
1263 i: Integer;
1264begin
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;
1279end;
1280
1281function TChanges.RequireReview: Boolean;
1282{ returns true if documents can be signed or if any orders exist in Changes }
1283var
1284 i: Integer;
1285begin
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;
1295end;
1296
1297procedure TChanges.AddUnsignedToChanges;
1298{ retrieves unsigned orders outside this session based on OR UNSIGNED ORDERS ON EXIT }
1299var
[830]1300 i, CanSign(*, OrderUser*): Integer;
1301 OrderUser: int64;
[1679]1302 AnID, Display: string;
[456]1303 HaveOrders, OtherOrders: TStringList;
1304 AChangeItem: TChangeItem;
[1679]1305 IsDiscontinue, IsDelay: boolean;
[456]1306begin
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
[830]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));
[1679]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);
[456]1334 end;
1335 finally
1336 StatusText('');
1337 HaveOrders.Free;
1338 OtherOrders.Free;
1339 end;
1340end;
1341
1342{ TNotifications ---------------------------------------------------------------------------- }
1343
1344constructor TNotifications.Create;
1345begin
1346 FList := TList.Create;
1347 FCurrentIndex := -1;
1348 FActive := False;
1349end;
1350
1351destructor TNotifications.Destroy;
1352begin
1353 Clear;
1354 FList.Free;
1355 inherited Destroy;
1356end;
1357
[1679]1358procedure TNotifications.Add(const ADFN: string; AFollowUp: Integer; const ARecordID: string; AHighLightSection : string = ''); //*DFN*
[456]1359var
1360 NotifyItem: TNotifyItem;
1361begin
1362 NotifyItem := TNotifyItem.Create;
1363 NotifyItem.DFN := ADFN;
1364 NotifyItem.FollowUp := AFollowUp;
1365 NotifyItem.RecordID := ARecordId;
[1679]1366 If AHighLightSection <> '' then NotifyItem.HighLightSection := AHighLightSection;
[456]1367 FList.Add(NotifyItem);
1368 FActive := True;
1369end;
1370
1371procedure TNotifications.Clear;
1372var
1373 i: Integer;
1374begin
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;
1380end;
1381
1382function TNotifications.GetDFN: string; //*DFN*
1383begin
1384 if FNotifyItem <> nil then Result := FNotifyItem.DFN else Result := ''; //*DFN*
1385end;
1386
1387function TNotifications.GetFollowUp: Integer;
1388begin
1389 if FNotifyItem <> nil then Result := FNotifyItem.FollowUp else Result := 0;
1390end;
1391
1392function TNotifications.GetAlertData: string;
1393begin
1394 if FNotifyItem <> nil
1395 then Result := GetXQAData(Piece(FNotifyItem.RecordID, U, 2))
1396 else Result := '';
1397end;
1398
1399function TNotifications.GetRecordID: string;
1400begin
1401 if FNotifyItem <> nil then Result := FNotifyItem.RecordID else Result := '';
1402end;
1403
1404function TNotifications.GetText: string;
1405begin
1406 if FNotifyItem <> nil
1407 then Result := Piece(Piece(FNotifyItem.RecordID, U, 1 ), ':', 2)
1408 else Result := '';
1409end;
1410
[1679]1411function TNotifications.GetHighLightSection: String; //CB
1412begin
1413 if FNotifyItem <> nil then Result := FNotifyItem.HighLightSection else Result := '';
1414end;
1415
1416
[456]1417procedure TNotifications.Next;
1418begin
1419 Inc(FCurrentIndex);
1420 if FCurrentIndex < FList.Count then FNotifyItem := TNotifyItem(FList[FCurrentIndex]) else
1421 begin
1422 FActive := False;
1423 FNotifyItem := nil;
1424 end;
1425end;
1426
1427procedure TNotifications.Prior;
1428begin
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;
1434end;
1435
1436procedure TNotifications.Delete;
1437begin
1438 if FNotifyItem <> nil then DeleteAlert(Piece(FNotifyItem.RecordID, U, 2));
1439end;
1440
1441procedure TNotifications.DeleteForCurrentUser;
1442begin
1443 if FNotifyItem <> nil then DeleteAlertForUser(Piece(FNotifyItem.RecordID, U, 2));
1444end;
1445
1446{ TRemoteSite methods ---------------------------------------------------------------------------- }
1447
1448constructor TRemoteSite.Create(ASite: string);
1449begin
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 := '';
1460end;
1461
1462destructor TRemoteSite.Destroy;
1463begin
1464 LabClear;
1465 ReportClear;
1466 FData.Free;
1467 FLabData.Free;
1468 inherited Destroy;
1469end;
1470
1471procedure TRemoteSite.ReportClear;
1472begin
1473 FData.Clear;
1474 FQueryStatus := '';
1475end;
1476
1477procedure TRemoteSite.LabClear;
1478begin
1479 FLabData.Clear;
1480 FLabQueryStatus := '';
1481end;
1482
1483procedure TRemoteSite.SetSelected(Value: boolean);
1484begin
1485 FSelected := Value;
1486end;
1487
1488constructor TRemoteReport.Create(AReport: string);
1489begin
1490 FReport := AReport;
1491 FHandle := '';
1492end;
1493
1494destructor TRemoteReport.Destroy;
1495begin
1496 inherited Destroy;
1497end;
1498
1499constructor TRemoteReportList.Create;
1500begin
1501 FReportList := TList.Create;
1502 FCount := 0;
1503end;
1504
1505destructor TRemoteReportList.Destroy;
1506begin
1507 //Clear;
1508 FReportList.Free;
1509 inherited Destroy;
1510end;
1511
1512procedure TRemoteReportList.Add(AReportList, AHandle: string);
1513var
1514 ARemoteReport: TRemoteReport;
1515begin
1516 ARemoteReport := TRemoteReport.Create(AReportList);
1517 ARemoteReport.Handle := AHandle;
1518 ARemoteReport.Report := AReportList;
1519 FReportList.Add(ARemoteReport);
1520 FCount := FReportList.Count;
1521end;
1522
1523procedure TRemoteReportList.Clear;
1524var
1525 i: Integer;
1526begin
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;
1532end;
1533
1534constructor TRemoteSiteList.Create;
1535begin
1536 FSiteList := TList.Create;
1537 FCount := 0;
1538end;
1539
1540destructor TRemoteSiteList.Destroy;
1541begin
1542 Clear;
1543 FSiteList.Free;
1544 inherited Destroy;
1545end;
1546
1547procedure TRemoteSiteList.Add(ASite: string);
1548var
1549 ARemoteSite: TRemoteSite;
1550begin
1551 ARemoteSite := TRemoteSite.Create(ASite);
1552 FSiteList.Add(ARemoteSite);
1553 FCount := FSiteList.Count;
1554end;
1555
1556procedure TRemoteSiteList.Clear;
1557var
1558 i: Integer;
1559begin
1560 with FSiteList do for i := 0 to Count - 1 do with TRemoteSite(Items[i]) do Free;
1561 FSiteList.Clear;
1562 FCount := 0;
1563end;
1564
1565procedure TRemoteSiteList.ChangePatient(const DFN: string);
1566var
1567 ALocations: TStringList;
1568 i: integer;
1569begin
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;
1588end;
1589
1590procedure TUser.SetCurrentPrinter(Value: string);
1591begin
1592 FCurrentPrinter := Value;
1593end;
1594
1595procedure GotoWebPage(const URL: WideString);
1596begin
1597 if(URLMonHandle <> 0) then
1598 HlinkNav(nil, PWideChar(URL));
1599end;
1600
1601procedure LoadURLMon;
1602const
1603 UrlMonLib = 'URLMON.DLL';
1604 HlinkName = 'HlinkNavigateString';
1605
1606begin
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;
1619end;
1620
1621procedure ReleaseURLMon;
1622begin
1623 if(URLMonHandle <> 0) then
1624 begin
1625 FreeLibrary(URLMonHandle);
1626 URLMonHandle := 0;
1627 end;
1628end;
1629
1630procedure TChanges.ReplaceODGrpName(const AnODID, NewGrp: string);
1631var
1632 ChangeList: TList;
1633 i: Integer;
1634begin
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;
1639end;
1640
1641procedure TChanges.ChangeOrderGrp(const oldGrpName,newGrpName: string);
1642var
1643 i : integer;
1644begin
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;
1650end;
1651
1652initialization
1653 uVistaMsg := 0;
1654 LoadURLMon;
1655
1656finalization
1657 ReleaseURLMon;
1658 ReleaseAppNotification;
1659
1660end.
Note: See TracBrowser for help on using the repository browser.