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

Last change on this file since 1156 was 729, checked in by Kevin Toppenberg, 15 years ago

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