source: cprs/branches/tmg-cprs/CPRS-Chart/uCore.pas@ 581

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

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