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

Last change on this file since 901 was 460, checked in by Kevin Toppenberg, 17 years ago

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