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

Last change on this file since 737 was 456, checked in by Kevin Toppenberg, 16 years ago

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