source: cprs/branches/foia-cprs/CPRS-Chart/uCore.pas@ 459

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

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