source: cprs/trunk/CPRS-Chart/rCore.pas@ 830

Last change on this file since 830 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 44.5 KB
Line 
1unit rCore;
2
3interface
4
5uses SysUtils, Classes, Forms, ORNet, ORFn, ORClasses;
6
7{ record types used to return data from the RPC's. Generally, the delimited strings returned
8 by the RPC are mapped into the records defined below. }
9
10const
11 UC_UNKNOWN = 0; // user class unknown
12 UC_CLERK = 1; // user class clerk
13 UC_NURSE = 2; // user class nurse
14 UC_PHYSICIAN = 3; // user class physician
15
16type
17 TUserInfo = record // record for ORWU USERINFO
18 DUZ: Int64;
19 Name: string;
20 UserClass: Integer;
21 CanSignOrders: Boolean;
22 IsProvider: Boolean;
23 OrderRole: Integer;
24 NoOrdering: Boolean;
25 DTIME: Integer;
26 CountDown: Integer;
27 EnableVerify: Boolean;
28 NotifyAppsWM: Boolean;
29 PtMsgHang: Integer;
30 Domain: string;
31 Service: Integer;
32 AutoSave: Integer;
33 InitialTab: Integer;
34 UseLastTab: Boolean;
35 WebAccess: Boolean;
36 IsRPL: string;
37 RPLList: string;
38 HasCorTabs: Boolean;
39 HasRptTab: Boolean;
40 IsReportsOnly: Boolean;
41 ToolsRptEdit: Boolean;
42 DisableHold: Boolean;
43 GECStatusCheck: Boolean;
44 StationNumber: string;
45 IsProductionAccount: boolean;
46 end;
47
48 TPtIDInfo = record // record for ORWPT IDINFO
49 Name: string;
50 SSN: string;
51 DOB: string;
52 Age: string;
53 Sex: string;
54 SCSts: string;
55 Vet: string;
56 Location: string;
57 RoomBed: string;
58 //ADD VWPT BELOW FOR HRN
59 HRN : string;
60 AltHRN :string;
61 end;
62
63 TPtSelect = record // record for ORWPT SELECT
64 Name: string;
65 ICN: string;
66 SSN: string;
67 DOB: TFMDateTime;
68 Age: Integer;
69 Sex: Char;
70 LocationIEN: Integer;
71 Location: string;
72 WardService: string;
73 RoomBed: string;
74 SpecialtyIEN: Integer;
75 CWAD: string;
76 Restricted: Boolean;
77 AdmitTime: TFMDateTime;
78 ServiceConnected: Boolean;
79 SCPercent: Integer;
80 PrimaryTeam: string;
81 PrimaryProvider: string;
82 Attending: string;
83 //ADD VWPT BELOW FOR HRN AltHRN
84 HRN : string;
85 AltHRN : string;
86 end;
87
88 TEncounterText = record // record for ORWPT ENCTITL
89 LocationName: string;
90 LocationAbbr: string;
91 RoomBed: string;
92 ProviderName: string;
93 end;
94
95{ Date/Time functions - right now these make server calls to use server time}
96
97function FMToday: TFMDateTime;
98function FMNow: TFMDateTime;
99function MakeRelativeDateTime(FMDateTime: TFMDateTime): string;
100function StrToFMDateTime(const AString: string): TFMDateTime;
101function ValidDateTimeStr(const AString, Flags: string): TFMDateTime;
102procedure ListDateRangeClinic(Dest: TStrings);
103
104{ General calls }
105
106function ExternalName(IEN: Int64; FileNumber: Double): string;
107function PersonHasKey(APerson: Int64; const AKey: string): Boolean;
108function GlobalRefForFile(const FileID: string): string;
109function SubsetOfGeneric(const StartFrom: string; Direction: Integer; const GlobalRef: string): TStrings;
110function SubsetOfDevices(const StartFrom: string; Direction: Integer): TStrings;
111function SubSetOfPersons(const StartFrom: string; Direction: Integer): TStrings;
112function SubSetOfActiveAndInactivePersons(const StartFrom: string; Direction: Integer): TStrings;
113function GetDefaultPrinter(DUZ: Int64; Location: integer): string;
114
115{ User specific calls }
116
117function GetUserInfo: TUserInfo;
118function GetUserParam(const AParamName: string): string;
119procedure GetUserListParam(Dest: TStrings; const AParamName: string);
120function HasSecurityKey(const KeyName: string): Boolean;
121function HasMenuOptionAccess(const OptionName: string): Boolean;
122function ValidESCode(const ACode: string): Boolean;
123
124{ Notifications calls }
125
126procedure LoadNotifications(Dest: TStrings);
127procedure DeleteAlert(XQAID: string);
128procedure DeleteAlertForUser(XQAID: string);
129function GetXQAData(XQAID: string): string;
130function GetTIUAlertInfo(XQAID: string): string;
131procedure UpdateUnsignedOrderAlerts(PatientDFN: string);
132function UnsignedOrderAlertFollowup(XQAID: string): string;
133procedure UpdateExpiringMedAlerts(PatientDFN: string);
134procedure UpdateExpiringFlaggedOIAlerts(PatientDFN: string; FollowUp: integer);
135procedure AutoUnflagAlertedOrders(PatientDFN, XQAID: string);
136procedure UpdateUnverifiedMedAlerts(PatientDFN: string);
137procedure UpdateUnverifiedOrderAlerts(PatientDFN: string);
138function GetNotificationFollowUpText(PatientDFN: string; Notification: integer; XQADATA: string): TStrings;
139procedure ForwardAlert(XQAID: string; Recip: string; FWDtype: string; Comment: string);
140procedure RenewAlert(XQAID: string);
141function GetSortMethod: string;
142procedure SetSortMethod(Sort: string; Direction: string);
143
144{ Patient List calls }
145
146function DfltPtList: string;
147function DfltPtListSrc: Char;
148procedure SavePtListDflt(const x: string);
149procedure ListSpecialtyAll(Dest: TStrings);
150procedure ListTeamAll(Dest: TStrings);
151procedure ListWardAll(Dest: TStrings);
152procedure ListProviderTop(Dest: TStrings);
153function SubSetOfProviders(const StartFrom: string; Direction: Integer): TStrings;
154function SubSetOfCosigners(const StartFrom: string; Direction: Integer; Date: TFMDateTime;
155 ADocType: integer; ATitle: integer): TStrings;
156procedure ListClinicTop(Dest: TStrings);
157function SubSetOfClinics(const StartFrom: string; Direction: Integer): TStrings;
158function GetDfltSort: string;
159procedure ResetDfltSort;
160procedure ListPtByDflt(Dest: TStrings);
161procedure ListPtByProvider(Dest: TStrings; ProviderIEN: Int64);
162procedure ListPtByTeam(Dest: TStrings; TeamIEN: Integer);
163procedure ListPtBySpecialty(Dest: TStrings; SpecialtyIEN: Integer);
164procedure ListPtByClinic(Dest: TStrings; ClinicIEN: Integer; FirstDt, LastDt: string);
165procedure ListPtByWard(Dest: TStrings; WardIEN: Integer);
166procedure ListPtByLast5(Dest: TStrings; const Last5: string);
167procedure ListPtByRPLLast5(Dest: TStrings; const Last5: string);
168procedure ListPtByFullSSN(Dest: TStrings; const FullSSN: string);
169procedure ListPtByRPLFullSSN(Dest: TStrings; const FullSSN: string);
170procedure ListPtTop(Dest: TStrings);
171function SubSetOfPatients(const StartFrom: string; Direction: Integer): TStrings;
172function DfltDateRangeClinic: string;
173function MakeRPLPtList(RPLList: string): string;
174function ReadRPLPtList(RPLJobNumber: string; const StartFrom: string; Direction: Integer) : TStrings;
175procedure KillRPLPtList(RPLJobNumber: string);
176
177// VWPT ADDITIONS FOR ENHANCED PATIENT LOOKUP
178procedure ListPtByOther (Dest: Tstrings; const othertext: string ;caption :string);//:string; radbutton:Tobject);
179procedure ListPtByTimson (Dest: Tstrings; const othertext: string);
180//end VWPT
181
182{ Patient specific calls }
183
184function CalcAge(BirthDate, DeathDate: TFMDateTime): Integer;
185procedure CheckSensitiveRecordAccess(const DFN: string; var AccessStatus: Integer;
186 var MessageText: string);
187procedure CheckRemotePatient(var Dest: string; Patient, ASite: string; var AccessStatus: Integer);
188procedure CurrentLocationForPatient(const DFN: string; var ALocation: Integer; var AName: string; var ASvc: string);
189function DateOfDeath(const DFN: string): TFMDateTime;
190function GetPtIDInfo(const DFN: string): TPtIDInfo;
191function HasLegacyData(const DFN: string; var AMsg: string): Boolean;
192function LogSensitiveRecordAccess(const DFN: string): Boolean;
193function MeansTestRequired(const DFN: string; var AMsg: string): Boolean;
194function RestrictedPtRec(const DFN: string): Boolean;
195procedure SelectPatient(const DFN: string; var PtSelect: TPtSelect);
196function SimilarRecordsFound(const DFN: string; var AMsg: string): Boolean;
197function GetDFNFromICN(AnICN: string): string;
198
199{ Encounter specific calls }
200
201function GetEncounterText(const DFN: string; Location: integer; Provider: Int64): TEncounterText; //*DFN*
202procedure ListApptAll(Dest: TStrings; const DFN: string; From: TFMDateTime = 0;
203 Thru: TFMDateTime = 0);
204procedure ListAdmitAll(Dest: TStrings; const DFN: string);
205function SubSetOfLocations(const StartFrom: string; Direction: Integer): TStrings;
206function SubSetOfNewLocs(const StartFrom: string; Direction: Integer): TStrings;
207function SubSetOfInpatientLocations(const StartFrom: string; Direction: Integer): TStrings;
208function SubSetOfProvWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
209function SubSetOfUsersWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
210
211{ Remote Data Access calls }
212function HasRemoteData(const DFN: string; var ALocations: TStringList): Boolean;
213function CheckHL7TCPLink: Boolean;
214function GetVistaWebAddress(value: string): string;
215
216implementation
217
218uses Hash, uCore, ShlObj, Windows;
219
220var
221 uPtListDfltSort: string = ''; // Current user's patient selection list default sort order.
222
223{ private calls }
224
225function FormatSSN(const x: string): string;
226{ places the dashes in a social security number }
227//vwpt code 4/17/0 see below
228var
229
230 i:Integer;
231//end vwpt
232begin
233//vwpt code to prevent extra dashes 4/17/07
234 Result := x;
235 ///take out for i := 1 to Length(x) do if (x[i] in ['-'..'-']) then Exit;
236 //end vwpt
237 if Length(x) > 8
238 then Result := Copy(x,1,3) + '-' + Copy(x,4,2) + '-' + Copy(x,6,Length(x))
239 else Result := x;
240end;
241
242function IsSSN(const x: string): Boolean;
243var
244 i: Integer;
245begin
246 Result := False;
247 if (Length(x) < 9) or (Length(x) > 10) then Exit;
248 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
249 Result := True;
250end;
251
252function IsFMDate(const x: string): Boolean;
253var
254 i: Integer;
255begin
256 Result := False;
257 if Length(x) <> 7 then Exit;
258 for i := 1 to 7 do if not (x[i] in ['0'..'9']) then Exit;
259 Result := True;
260end;
261
262{ Date/Time functions - not in ORFn because they make server calls to use server time}
263
264function FMToday: TFMDateTime;
265{ return the current date in Fileman format }
266begin
267 Result := Int(FMNow);
268end;
269
270function FMNow: TFMDateTime;
271{ return the current date/time in Fileman format }
272var
273 x: string;
274begin
275 x := sCallV('ORWU DT', ['NOW']);
276 Result := StrToFloat(x);
277end;
278
279function MakeRelativeDateTime(FMDateTime: TFMDateTime): string;
280var
281 Offset: Integer;
282 h,n,s,l: Word;
283 ADateTime: TDateTime;
284 ATime: string;
285begin
286 Result := '';
287 if FMDateTime <= 0 then Exit;
288 ADateTime := FMDateTimeToDateTime(FMDateTime);
289 Offset := Trunc(Int(ADateTime) - Int(FMDateTimeToDateTime(FMToday)));
290 if Offset < 0 then Result := 'T' + IntToStr(Offset)
291 else if Offset = 0 then Result := 'T'
292 else Result := 'T+' + IntToStr(Offset);
293 DecodeTime(ADateTime, h, n, s, l);
294 ATime := Format('@%.2d:%.2d', [h, n]);
295 if ATime <> '@00:00' then Result := Result + ATime;
296end;
297
298function StrToFMDateTime(const AString: string): TFMDateTime;
299{ use %DT the validate and convert a string to Fileman format (accepts T, T-1, NOW, etc.) }
300var
301 x: string;
302begin
303 x := sCallV('ORWU DT', [AString]);
304 Result := StrToFloat(x);
305end;
306
307function ValidDateTimeStr(const AString, Flags: string): TFMDateTime;
308{ use %DT to validate & convert a string to Fileman format, accepts %DT flags }
309begin
310 Result := StrToFloat(sCallV('ORWU VALDT', [AString, Flags]));
311end;
312
313procedure ListDateRangeClinic(Dest: TStrings);
314{ returns date ranges for displaying clinic appointments in patient lookup }
315begin
316 CallV('ORWPT CLINRNG', [nil]);
317 FastAssign(RPCBrokerV.Results, Dest);
318end;
319
320function DfltDateRangeClinic;
321{ returns current default date range settings for displaying clinic appointments in patient lookup }
322begin
323 Result := sCallV('ORQPT DEFAULT CLINIC DATE RANG', [nil]);
324end;
325
326{ General calls }
327
328function ExternalName(IEN: Int64; FileNumber: Double): string;
329{ returns the external name of the IEN within a file }
330begin
331 Result := sCallV('ORWU EXTNAME', [IEN, FileNumber]);
332end;
333
334function PersonHasKey(APerson: Int64; const AKey: string): Boolean;
335begin
336 Result := sCallV('ORWU NPHASKEY', [APerson, AKey]) = '1';
337end;
338
339function GlobalRefForFile(const FileID: string): string;
340begin
341 Result := sCallV('ORWU GBLREF', [FileID]);
342end;
343
344function SubsetOfGeneric(const StartFrom: string; Direction: Integer; const GlobalRef: string): TStrings;
345begin
346 CallV('ORWU GENERIC', [StartFrom, Direction, GlobalRef]);
347 Result := RPCBrokerV.Results;
348end;
349
350function SubsetOfDevices(const StartFrom: string; Direction: Integer): TStrings;
351{ returns a pointer to a list of devices (for use in a long list box) - The return value is
352 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
353begin
354 CallV('ORWU DEVICE', [StartFrom, Direction]);
355 Result := RPCBrokerV.Results;
356end;
357
358function SubSetOfPersons(const StartFrom: string; Direction: Integer): TStrings;
359{ returns a pointer to a list of persons (for use in a long list box) - The return value is
360 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
361begin
362 CallV('ORWU NEWPERS', [StartFrom, Direction]);
363// MixedCaseList(RPCBrokerV.Results);
364 Result := RPCBrokerV.Results;
365end;
366
367{ User specific calls }
368
369function GetUserInfo: TUserInfo;
370{ returns a record of user information,
371 Pieces: DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^DTIME^CNTDN^VERORD^NOTIFYAPPS^
372 MSGHANG^DOMAIN^SERVICE^AUTOSAVE^INITTAB^LASTTAB^WEBACCESS^ALLOWHOLD^ISRPL^RPLLIST^
373 CORTABS^RPTTAB^STATION#^GECStatus^Production account?}
374var
375 x: string;
376begin
377 x := sCallV('ORWU USERINFO', [nil]);
378 with Result do
379 begin
380 DUZ := StrToInt64Def(Piece(x, U, 1), 0);
381 Name := Piece(x, U, 2);
382 UserClass := StrToIntDef(Piece(x, U, 3), 0);
383 CanSignOrders := Piece(x, U, 4) = '1';
384 IsProvider := Piece(x, U, 5) = '1';
385 OrderRole := StrToIntDef(Piece(x, U, 6), 0);
386 NoOrdering := Piece(x, U, 7) = '1';
387 DTIME := StrToIntDef(Piece(x, U, 8), 300);
388 CountDown := StrToIntDef(Piece(x, U, 9), 10);
389 EnableVerify := Piece(x, U, 10) = '1';
390 NotifyAppsWM := Piece(x, U, 11) = '1';
391 PtMsgHang := StrToIntDef(Piece(x, U, 12), 5);
392 Domain := Piece(x, U, 13);
393 Service := StrToIntDef(Piece(x, U, 14), 0);
394 AutoSave := StrToIntDef(Piece(x, U, 15), 180);
395 InitialTab := StrToIntDef(Piece(x, U, 16), 1);
396 UseLastTab := Piece(x, U, 17) = '1';
397 WebAccess := Piece(x, U, 18) <> '1';
398 DisableHold := Piece(x, U, 19) = '1';
399 IsRPL := Piece(x, U, 20);
400 RPLList := Piece(x, U, 21);
401 HasCorTabs := Piece(x, U, 22) = '1';
402 HasRptTab := Piece(x, U, 23) = '1';
403 StationNumber := Piece(x, U, 24);
404 GECStatusCheck := Piece(x, U, 25) = '1';
405 IsProductionAccount := Piece(x, U, 26) = '1';
406 IsReportsOnly := false;
407 if ((HasRptTab) and (not HasCorTabs)) then
408 IsReportsOnly := true;
409 // Remove next if and nested if should an "override" later be provided for RPL users,etc.:
410 if HasCorTabs then
411 if (IsRPL = '1') then
412 begin
413 IsRPL := '0'; // Hard set for now.
414 IsReportsOnly := false;
415 end;
416 // Following hard set to TRUE per VHA mgt decision:
417 ToolsRptEdit := true;
418 // x := GetUserParam('ORWT TOOLS RPT SETTINGS OFF');
419 // if x = '1' then
420 // ToolsRptEdit := false;
421 end;
422end;
423
424function GetUserParam(const AParamName: string): string;
425begin
426 Result := sCallV('ORWU PARAM', [AParamName]);
427end;
428
429procedure GetUserListParam(Dest: TStrings; const AParamName: string);
430var
431 tmplst: TStringList;
432begin
433 tmplst := TStringList.Create;
434 try
435 tCallV(tmplst, 'ORWU PARAMS', [AParamName]);
436 FastAssign(tmplst, Dest);
437 finally
438 tmplst.Free;
439 end;
440end;
441
442function HasSecurityKey(const KeyName: string): Boolean;
443{ returns true if the currently logged in user has a given security key }
444var
445 x: string;
446begin
447 Result := False;
448 x := sCallV('ORWU HASKEY', [KeyName]);
449 if x = '1' then Result := True;
450end;
451
452function HasMenuOptionAccess(const OptionName: string): Boolean;
453begin
454 Result := (sCallV('ORWU HAS OPTION ACCESS', [OptionName]) = '1');
455end;
456
457function ValidESCode(const ACode: string): Boolean;
458{ returns true if the electronic signature code in ACode is valid }
459begin
460 Result := sCallV('ORWU VALIDSIG', [Encrypt(ACode)]) = '1';
461end;
462
463{ Notifications Calls }
464
465procedure LoadNotifications(Dest: TStrings);
466var
467 tmplst: TStringList;
468begin
469 tmplst := TStringList.Create;
470 try
471 //UpdateUnsignedOrderAlerts(Patient.DFN); //moved to AFTER signature and DC actions
472 tCallV(tmplst, 'ORWORB FASTUSER', [nil]);
473 FastAssign(tmplst, Dest);
474 finally
475 tmplst.Free;
476 end;
477end;
478
479procedure UpdateUnsignedOrderAlerts(PatientDFN: string);
480begin
481 CallV('ORWORB KILL UNSIG ORDERS ALERT',[PatientDFN]);
482end;
483
484function UnsignedOrderAlertFollowup(XQAID: string): string;
485begin
486 Result := sCallV('ORWORB UNSIG ORDERS FOLLOWUP',[XQAID]);
487end;
488
489procedure UpdateExpiringMedAlerts(PatientDFN: string);
490begin
491 CallV('ORWORB KILL EXPIR MED ALERT',[PatientDFN]);
492end;
493
494procedure UpdateExpiringFlaggedOIAlerts(PatientDFN: string; FollowUp: integer);
495begin
496 CallV('ORWORB KILL EXPIR OI ALERT',[PatientDFN, FollowUp]);
497end;
498
499procedure UpdateUnverifiedMedAlerts(PatientDFN: string);
500begin
501 CallV('ORWORB KILL UNVER MEDS ALERT',[PatientDFN]);
502end;
503
504procedure UpdateUnverifiedOrderAlerts(PatientDFN: string);
505begin
506 CallV('ORWORB KILL UNVER ORDERS ALERT',[PatientDFN]);
507end;
508
509procedure AutoUnflagAlertedOrders(PatientDFN, XQAID: string);
510begin
511 CallV('ORWORB AUTOUNFLAG ORDERS',[PatientDFN, XQAID]);
512end;
513
514procedure DeleteAlert(XQAID: string);
515//deletes an alert
516begin
517 CallV('ORB DELETE ALERT',[XQAID]);
518end;
519
520procedure DeleteAlertForUser(XQAID: string);
521//deletes an alert
522begin
523 CallV('ORB DELETE ALERT',[XQAID, True]);
524end;
525
526procedure ForwardAlert(XQAID: string; Recip: string; FWDtype: string; Comment: string);
527// Forwards an alert with comment to Recip[ient]
528begin
529 CallV('ORB FORWARD ALERT', [XQAID, Recip, FWDtype, Comment]);
530end;
531
532procedure RenewAlert(XQAID: string);
533// Restores/renews an alert
534begin
535 CallV('ORB RENEW ALERT', [XQAID]);
536end;
537
538function GetSortMethod: string;
539// Returns alert sort method
540begin
541 Result := sCallV('ORWORB GETSORT',[nil]);
542end;
543
544procedure SetSortMethod(Sort: string; Direction: string);
545// Sets alert sort method for user
546begin
547 CallV('ORWORB SETSORT', [Sort, Direction]);
548end;
549
550function GetXQAData(XQAID: string): string;
551// Returns data associated with an alert
552begin
553 Result := sCallV('ORWORB GETDATA',[XQAID]);
554end;
555
556function GetTIUAlertInfo(XQAID: string): string;
557// Returns DFN and document type associated with a TIU alert
558begin
559 Result := sCallV('TIU GET ALERT INFO',[XQAID]);
560end;
561
562function GetNotificationFollowUpText(PatientDFN: string; Notification: integer; XQADATA: string): TStrings;
563// Returns follow-up text for an alert
564begin
565 CallV('ORWORB TEXT FOLLOWUP', [PatientDFN, Notification, XQADATA]);
566 Result := RPCBrokerV.Results;
567end;
568
569{ Patient List Calls }
570
571function DfltPtList: string;
572{ returns the name of the current user's default patient list, null if none is defined
573 Pieces: Ptr to Source File^Source Name^Source Type }
574begin
575 Result := sCallV('ORQPT DEFAULT LIST SOURCE', [nil]);
576 if Length(Result) > 0 then Result := Pieces(Result, U, 2, 3);
577end;
578
579function DfltPtListSrc: Char;
580begin
581 Result := CharAt(sCallV('ORWPT DFLTSRC', [nil]), 1);
582end;
583
584procedure SavePtListDflt(const x: string);
585begin
586 CallV('ORWPT SAVDFLT', [x]);
587end;
588
589procedure ListSpecialtyAll(Dest: TStrings);
590{ lists all treating specialties: IEN^Treating Specialty Name }
591begin
592 CallV('ORQPT SPECIALTIES', [nil]);
593 MixedCaseList(RPCBrokerV.Results);
594 FastAssign(RPCBrokerV.Results, Dest);
595end;
596
597procedure ListTeamAll(Dest: TStrings);
598{ lists all patient care teams: IEN^Team Name }
599begin
600 CallV('ORQPT TEAMS', [nil]);
601 MixedCaseList(RPCBrokerV.Results);
602 FastAssign(RPCBrokerV.Results, Dest);
603end;
604
605procedure ListWardAll(Dest: TStrings);
606{ lists all active inpatient wards: IEN^Ward Name }
607begin
608 CallV('ORQPT WARDS', [nil]);
609 //MixedCaseList(RPCBrokerV.Results);
610 FastAssign(RPCBrokerV.Results, Dest);
611end;
612
613procedure ListProviderTop(Dest: TStrings);
614{ checks parameters for list of commonly selected providers }
615begin
616end;
617
618function SubSetOfProviders(const StartFrom: string; Direction: Integer): TStrings;
619{ returns a pointer to a list of providers (for use in a long list box) - The return value is
620 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
621begin
622 CallV('ORWU NEWPERS', [StartFrom, Direction, 'PROVIDER']);
623// MixedCaseList(RPCBrokerV.Results);
624 Result := RPCBrokerV.Results;
625end;
626
627function SubSetOfCosigners(const StartFrom: string; Direction: Integer; Date: TFMDateTime;
628 ADocType: integer; ATitle: integer): TStrings;
629{ returns a pointer to a list of cosigners (for use in a long list box) - The return value is
630 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
631begin
632 if ATitle > 0 then ADocType := 0;
633 // CQ #17218 - Correcting order of parameters for this call
634 // CallV('ORWU2 COSIGNER', [StartFrom, Direction, Date, ATitle, ADocType]);
635 CallV('ORWU2 COSIGNER', [StartFrom, Direction, Date, ADocType, ATitle]);
636
637 // MixedCaseList(RPCBrokerV.Results);
638 Result := RPCBrokerV.Results;
639end;
640
641function SubSetOfProvWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
642{ returns a pointer to a list of providers (for use in a long list box) - The return value is
643 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
644begin
645 CallV('ORWU NEWPERS', [StartFrom, Direction, 'PROVIDER', DateTime]);
646 MixedCaseList(RPCBrokerV.Results);
647 Result := RPCBrokerV.Results;
648end;
649
650function SubSetOfUsersWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
651{ returns a pointer to a list of users (for use in a long list box) - The return value is
652 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
653begin
654 CallV('ORWU NEWPERS', [StartFrom, Direction, '', DateTime]);
655 MixedCaseList(RPCBrokerV.Results);
656 Result := RPCBrokerV.Results;
657end;
658
659function SubSetOfActiveAndInactivePersons(const StartFrom: string; Direction: Integer): TStrings;
660{ returns a pointer to a list of users (for use in a long list box) - The return value is
661 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call!}
662begin
663 CallV('ORWU NEWPERS', [StartFrom, Direction, '', '', '', True]); //TRUE = return all active and inactive users
664 MixedCaseList(RPCBrokerV.Results);
665 Result := RPCBrokerV.Results;
666end;
667
668
669procedure ListClinicTop(Dest: TStrings);
670{ checks parameters for list of commonly selected clinics }
671begin
672end;
673
674function SubSetOfClinics(const StartFrom: string; Direction: Integer): TStrings;
675{ returns a pointer to a list of clinics (for use in a long list box) - The return value is
676 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
677begin
678 CallV('ORWU CLINLOC', [StartFrom, Direction]);
679 MixedCaseList(RPCBrokerV.Results);
680 Result := RPCBrokerV.Results;
681end;
682
683function GetDfltSort: string;
684{ Assigns uPtLstDfltSort to user's default patient list sort order (string character).}
685begin
686 uPtListDfltSort := sCallV('ORQPT DEFAULT LIST SORT', [nil]);
687 if uPtListDfltSort = '' then uPtListDfltSort := 'A'; // Default is always "A" for alpha.
688 result := uPtListDfltSort;
689end;
690
691procedure ResetDfltSort;
692begin
693 uPtListDfltSort := '';
694end;
695
696procedure ListPtByDflt(Dest: TStrings);
697{ loads the default patient list into Dest, Pieces: DFN^PATIENT NAME, ETC. }
698var
699 i, SourceType: Integer;
700 ATime, APlace, Sort, Source, x: string;
701 tmplst: TORStringList;
702begin
703 Sort := GetDfltSort();
704 tmplst := TORStringList.Create;
705 try
706 tCallV(tmplst, 'ORQPT DEFAULT PATIENT LIST', [nil]);
707 Source := sCallV('ORWPT DFLTSRC', [nil]);
708 if Source = 'C' then // Clinics.
709 begin
710 if Sort = 'P' then // "Appointments" sort.
711 SortByPiece(tmplst, U, 4)
712 else
713 SortByPiece(tmplst, U, 2);
714 for i := 0 to tmplst.Count - 1 do
715 begin
716 x := tmplst[i];
717 ATime := Piece(x, U, 4);
718 APlace := Piece(x, U, 3);
719 ATime := FormatFMDateTime('hh:nn mmm dd, yyyy', MakeFMDateTime(ATime));
720 SetPiece(x, U, 3, ATime);
721 x := x + U + APlace;
722 tmplst[i] := x;
723 end;
724 end
725 else
726 begin
727 SourceType := 0; // Default.
728 if Source = 'M' then SourceType := 1; // Combinations.
729 if Source = 'W' then SourceType := 2; // Wards.
730 case SourceType of
731 1 : if Sort = 'S' then tmplst.SortByPieces([3, 8, 2]) // "Source" sort.
732 else if Sort = 'P' then tmplst.SortByPieces([8, 2]) // "Appointment" sort.
733 else if Sort = 'T' then SortByPiece(tmplst, U, 5) // "Terminal Digit" sort.
734 else SortByPiece(tmplst, U, 2); // "Alphabetical" (also the default) sort.
735 2 : if Sort = 'R' then tmplst.SortByPieces([3, 2])
736 else SortByPiece(tmplst, U, 2);
737 else SortByPiece(tmplst, U, 2);
738 end;
739 end;
740 MixedCaseList(tmplst);
741 FastAssign(tmplst, Dest);
742 finally
743 tmplst.Free;
744 end;
745end;
746
747procedure ListPtByProvider(Dest: TStrings; ProviderIEN: Int64);
748{ lists all patients associated with a given provider: DFN^Patient Name }
749begin
750 CallV('ORQPT PROVIDER PATIENTS', [ProviderIEN]);
751 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
752 MixedCaseList(RPCBrokerV.Results);
753 FastAssign(RPCBrokerV.Results, Dest);
754end;
755
756procedure ListPtByTeam(Dest: TStrings; TeamIEN: Integer);
757{ lists all patients associated with a given team: DFN^Patient Name }
758begin
759 CallV('ORQPT TEAM PATIENTS', [TeamIEN]);
760 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
761 MixedCaseList(RPCBrokerV.Results);
762 FastAssign(RPCBrokerV.Results, Dest);
763end;
764
765procedure ListPtBySpecialty(Dest: TStrings; SpecialtyIEN: Integer);
766{ lists all patients associated with a given specialty: DFN^Patient Name }
767begin
768 CallV('ORQPT SPECIALTY PATIENTS', [SpecialtyIEN]);
769 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
770 MixedCaseList(RPCBrokerV.Results);
771 FastAssign(RPCBrokerV.Results, Dest);
772end;
773
774procedure ListPtByClinic(Dest: TStrings; ClinicIEN: Integer; FirstDt, LastDt: string); //TFMDateTime);
775{ lists all patients associated with a given clinic: DFN^Patient Name^App't }
776var
777 i: Integer;
778 x, ATime, APlace, Sort: string;
779begin
780 Sort := GetDfltSort();
781 CallV('ORQPT CLINIC PATIENTS', [ClinicIEN, FirstDt, LastDt]);
782 with RPCBrokerV do
783 begin
784 if Sort = 'P' then
785 SortByPiece(TStringList(Results), U, 4)
786 else
787 SortByPiece(TStringList(Results), U, 2);
788 for i := 0 to Results.Count - 1 do
789 begin
790 x := Results[i];
791 ATime := Piece(x, U, 4);
792 APlace := Piece(x, U, 3);
793 ATime := FormatFMDateTime('hh:nn mmm dd, yyyy', MakeFMDateTime(ATime));
794 SetPiece(x, U, 3, ATime);
795 x := x + U + APlace;
796 Results[i] := x;
797 end;
798 MixedCaseList(Results);
799 FastAssign(Results, Dest);
800 end;
801end;
802
803procedure ListPtByWard(Dest: TStrings; WardIEN: Integer);
804{ lists all patients associated with a given ward: DFN^Patient Name^Room/Bed }
805var
806 Sort: string;
807begin
808 Sort := GetDfltSort();
809 CallV('ORWPT BYWARD', [WardIEN]);
810 if Sort = 'R' then
811 SortByPiece(TStringList(RPCBrokerV.Results), U, 3)
812 else
813 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
814 MixedCaseList(RPCBrokerV.Results);
815 FastAssign(RPCBrokerV.Results, Dest);
816end;
817
818// VWPT ADDITIONS FOR ENHANCED PATIENT LOOKUP
819procedure ListPtByOther (Dest: Tstrings; const othertext: string;caption:string );//:string; radbutton:Tobject);
820var
821 i: Integer;
822 x,Afieldname: string;
823begin
824
825 CallV('ORWPT OTHER-RADIOBUTTONS',[othertext, caption]);
826 //SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
827 MixedCaseList(RPCBrokerV.Results);
828 Dest.Assign(RPCBrokerV.Results);
829end;
830
831procedure ListPtByTimson (Dest: Tstrings; const othertext: string);//
832
833var
834 i: Integer;
835 x,Afieldname: string;
836begin
837
838 CallV('ORWPT ENHANCED PATLOOKUP',[othertext]);
839 //SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
840 MixedCaseList(RPCBrokerV.Results);
841 Dest.Assign(RPCBrokerV.Results);
842end;
843
844
845
846//END VWPT ADDITIONS
847
848procedure ListPtByLast5(Dest: TStrings; const Last5: string);
849var
850 i: Integer;
851 x, ADate, AnSSN: string;
852begin
853{ Lists all patients found in the BS and BS5 xrefs that match Last5: DFN^Patient Name }
854 CallV('ORWPT LAST5', [UpperCase(Last5)]);
855 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
856 with RPCBrokerV do for i := 0 to Results.Count - 1 do
857 begin
858 x := Results[i];
859 ADate := Piece(x, U, 3);
860 AnSSN := Piece(x, U, 4);
861 if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
862 if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
863 SetPiece(x, U, 3, AnSSN + ' ' + ADate);
864 Results[i] := x;
865 end;
866 MixedCaseList(RPCBrokerV.Results);
867 FastAssign(RPCBrokerV.Results, Dest);
868end;
869
870procedure ListPtByRPLLast5(Dest: TStrings; const Last5: string);
871var
872 i: Integer;
873 x, ADate, AnSSN: string;
874begin
875{ Lists patients from RPL list that match Last5: DFN^Patient Name }
876 CallV('ORWPT LAST5 RPL', [UpperCase(Last5)]);
877 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
878 with RPCBrokerV do for i := 0 to Results.Count - 1 do
879 begin
880 x := Results[i];
881 ADate := Piece(x, U, 3);
882 AnSSN := Piece(x, U, 4);
883 if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
884 if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
885 SetPiece(x, U, 3, AnSSN + ' ' + ADate);
886 Results[i] := x;
887 end;
888 MixedCaseList(RPCBrokerV.Results);
889 FastAssign(RPCBrokerV.Results, Dest);
890end;
891
892procedure ListPtByFullSSN(Dest: TStrings; const FullSSN: string);
893{ lists all patients found in the SSN xref that match FullSSN: DFN^Patient Name }
894var
895 i: integer;
896 x, ADate, AnSSN: string;
897begin
898 x := FullSSN;
899 i := Pos('-', x);
900 while i > 0 do
901 begin
902 x := Copy(x, 1, i-1) + Copy(x, i+1, 12);
903 i := Pos('-', x);
904 end;
905 CallV('ORWPT FULLSSN', [UpperCase(x)]);
906 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
907 with RPCBrokerV do for i := 0 to Results.Count - 1 do
908 begin
909 x := Results[i];
910 ADate := Piece(x, U, 3);
911 AnSSN := Piece(x, U, 4);
912 if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
913 if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
914 SetPiece(x, U, 3, AnSSN + ' ' + ADate);
915 Results[i] := x;
916 end;
917 MixedCaseList(RPCBrokerV.Results);
918 FastAssign(RPCBrokerV.Results, Dest);
919end;
920
921procedure ListPtByRPLFullSSN(Dest: TStrings; const FullSSN: string);
922{ lists all patients found in the SSN xref that match FullSSN: DFN^Patient Name }
923var
924 i: integer;
925 x, ADate, AnSSN: string;
926begin
927 x := FullSSN;
928 i := Pos('-', x);
929 while i > 0 do
930 begin
931 x := Copy(x, 1, i-1) + Copy(x, i+1, 12);
932 i := Pos('-', x);
933 end;
934 CallV('ORWPT FULLSSN RPL', [UpperCase(x)]);
935 SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
936 with RPCBrokerV do for i := 0 to Results.Count - 1 do
937 begin
938 x := Results[i];
939 ADate := Piece(x, U, 3);
940 AnSSN := Piece(x, U, 4);
941 if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
942 if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
943 SetPiece(x, U, 3, AnSSN + ' ' + ADate);
944 Results[i] := x;
945 end;
946 MixedCaseList(RPCBrokerV.Results);
947 FastAssign(RPCBrokerV.Results, Dest);
948end;
949
950procedure ListPtTop(Dest: TStrings);
951{ currently returns the last patient selected }
952begin
953 CallV('ORWPT TOP', [nil]);
954 MixedCaseList(RPCBrokerV.Results);
955 FastAssign(RPCBrokerV.Results, Dest);
956end;
957
958function SubSetOfPatients(const StartFrom: string; Direction: Integer): TStrings;
959{ returns a pointer to a list of patients (for use in a long list box) - The return value is
960 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
961begin
962 CallV('ORWPT LIST ALL', [StartFrom, Direction]);
963 MixedCaseList(RPCBrokerV.Results);
964 Result := RPCBrokerV.Results;
965end;
966
967function MakeRPLPtList(RPLList: string): string;
968{ Creates "RPL" Restricted Patient List based on Team List info in user's record. }
969begin
970 result := sCallV('ORQPT MAKE RPL', [RPLList]);
971end;
972
973function ReadRPLPtList(RPLJobNumber: string; const StartFrom: string; Direction: Integer) : TStrings;
974{ returns a pointer to a list of patients (for use in a long list box) - The return value is
975 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
976begin
977 CallV('ORQPT READ RPL', [RPLJobNumber, StartFrom, Direction]);
978 MixedCaseList(RPCBrokerV.Results);
979 Result := RPCBrokerV.Results;
980end;
981
982procedure KillRPLPtList(RPLJobNumber: string);
983begin
984 CallV('ORQPT KILL RPL', [RPLJobNumber]);
985end;
986
987{ Patient Specific Calls }
988
989function CalcAge(BirthDate, DeathDate: TFMDateTime): Integer;
990{ calculates age based on today's date and a birthdate (in Fileman format) }
991begin
992 if (DeathDate > BirthDate) then
993 Result := Trunc(DeathDate - BirthDate) div 10000
994 else
995 Result := Trunc(FMToday - BirthDate) div 10000
996end;
997
998procedure CheckSensitiveRecordAccess(const DFN: string; var AccessStatus: Integer;
999 var MessageText: string);
1000begin
1001 CallV('DG SENSITIVE RECORD ACCESS', [DFN]);
1002 AccessStatus := -1;
1003 MessageText := '';
1004 with RPCBrokerV do
1005 begin
1006 if Results.Count > 0 then
1007 begin
1008 AccessStatus := StrToIntDef(Results[0], -1);
1009 Results.Delete(0);
1010 if Results.Count > 0 then MessageText := Results.Text;
1011 end;
1012 end;
1013end;
1014
1015procedure CheckRemotePatient(var Dest: string; Patient, ASite: string; var AccessStatus: Integer);
1016
1017begin
1018 CallV('XWB DIRECT RPC', [ASite, 'ORWCIRN RESTRICT', 0, Patient]);
1019 AccessStatus := -1;
1020 Dest := '';
1021 with RPCBrokerV do
1022 begin
1023 if Results.Count > 0 then
1024 begin
1025 if Results[0] = '' then Results.Delete(0);
1026 end;
1027 if Results.Count > 0 then
1028 begin
1029 if (length(piece(Results[0],'^',2)) > 0) and ((StrToIntDef(piece(Results[0],'^',1),0) = -1)) then
1030 begin
1031 AccessStatus := -1;
1032 Dest := piece(Results[0],'^',2);
1033 end
1034 else
1035 begin
1036 AccessStatus := StrToIntDef(Results[0], -1);
1037 Results.Delete(0);
1038 if Results.Count > 0 then Dest := Results.Text;
1039 end;
1040 end;
1041 end;
1042end;
1043
1044procedure CurrentLocationForPatient(const DFN: string; var ALocation: Integer; var AName: string; var ASvc: string);
1045var
1046 x: string;
1047begin
1048 x := sCallV('ORWPT INPLOC', [DFN]);
1049 ALocation := StrToIntDef(Piece(x, U, 1), 0);
1050 AName := Piece(x, U, 2);
1051 ASvc := Piece(x, U, 3);
1052end;
1053
1054function DateOfDeath(const DFN: string): TFMDateTime;
1055{ returns 0 or the date a patient died }
1056begin
1057 Result := MakeFMDateTime(sCallV('ORWPT DIEDON', [DFN]));
1058end;
1059
1060function GetPtIDInfo(const DFN: string): TPtIDInfo; //*DFN*
1061//VWPT ADD HRN ,ALT HRN (FUTURE)
1062// Pieces: SSN[1]^DOB[2]^SEX[3]^VET[4]^SC%[5]^WARD[6]^RM-BED[7]^NAME[8]^HRN[9]^ALTHRN[10] }
1063 // Pieces: SSN[1]^DOB[2]^SEX[3]^VET[4]^SC%[5]^WARD[6]^RM-BED[7]^NAME[8] }
1064var
1065 x: string;
1066begin
1067 x := sCallV('ORWPT ID INFO', [DFN]);
1068 with Result do // map string into TPtIDInfo record
1069 begin
1070 Name := MixedCase(Piece(x, U, 8)); // Name
1071 SSN := Piece(x, U, 1);
1072 DOB := Piece(x, U, 2);
1073 Age := '';
1074 if IsSSN(SSN) then SSN := FormatSSN(Piece(x, U, 1)); // SSN (PID)
1075 if IsFMDate(DOB) then DOB := FormatFMDateTimeStr('mmm dd,yyyy', DOB); // Date of Birth
1076 //Age := IntToStr(CalcAge(MakeFMDateTime(Piece(x, U, 2)))); // Age
1077 Sex := Piece(x, U, 3); // Sex
1078 if Length(Sex) = 0 then Sex := 'U';
1079 case Sex[1] of
1080 'F','f': Sex := 'Female';
1081 'M','m': Sex := 'Male';
1082 else Sex := 'Unknown';
1083 end;
1084 if Piece(x, U, 4) = 'Y' then Vet := 'Veteran' else Vet := ''; // Veteran?
1085 if Length(Piece(x, U, 5)) > 0 // % Service Connected
1086 then SCSts := Piece(x, U, 5) + '% Service Connected'
1087 else SCSts := '';
1088 Location := Piece(x, U, 6); // Inpatient Location
1089 RoomBed := Piece(x, U, 7); // Inpatient Room-Bed
1090 // VWPT ADD HRN
1091 HRN := Piece(x, U, 9);
1092 AltHRN := Piece(x, U, 10);
1093 end;
1094end;
1095
1096function HasLegacyData(const DFN: string; var AMsg: string): Boolean;
1097var
1098 i: Integer;
1099begin
1100 Result := False;
1101 AMsg := '';
1102 CallV('ORWPT LEGACY', [DFN]);
1103 with RPCBrokerV do if Results.Count > 0 then
1104 begin
1105 Result := Results[0] = '1';
1106 for i := 1 to Results.Count - 1 do AMsg := AMsg + Results[i] + CRLF;
1107 end;
1108end;
1109
1110function LogSensitiveRecordAccess(const DFN: string): Boolean;
1111begin
1112 Result := sCallV('DG SENSITIVE RECORD BULLETIN', [DFN]) = '1';
1113end;
1114
1115function MeansTestRequired(const DFN: string; var AMsg: string): Boolean;
1116var
1117 i: Integer;
1118begin
1119 Result := False;
1120 AMsg := '';
1121 CallV('DG CHK PAT/DIV MEANS TEST', [DFN]);
1122 with RPCBrokerV do if Results.Count > 0 then
1123 begin
1124 Result := Results[0] = '1';
1125 for i := 1 to Results.Count - 1 do AMsg := AMsg + Results[i] + CRLF;
1126 end;
1127end;
1128
1129function RestrictedPtRec(const DFN: string): Boolean; //*DFN*
1130{ returns true if the record for a patient identified by DFN is restricted }
1131begin
1132 Result := Piece(sCallV('ORWPT SELCHK', [DFN]), U, 1) = '1';
1133end;
1134
1135procedure SelectPatient(const DFN: string; var PtSelect: TPtSelect); //*DFN*
1136{ selects the patient (updates DISV, calls Pt Select actions) & returns key fields
1137 Pieces: NAME[1]^SEX[2]^DOB[3]^SSN[4]^LOCIEN[5]^LOCNAME[6]^ROOMBED[7]^CWAD[8]^SENSITIVE[9]^
1138 //VWPT add HRN and ALTERNATE HRN used with PID hl7 segments
1139 ADMITTIME[10]^CONVERTED[11]^SVCONN[12]^SC%[13]^ICN[14]^Age[15]^TreatSpec[16]^HRN[17]^AltHRN[18] }
1140 // BEFORE THIS VWPT WAS ADMITTIME[10]^CONVERTED[11]^SVCONN[12]^SC%[13]^ICN[14]^Age[15]^TreatSpec[16] }
1141var
1142 x: string;
1143begin
1144 x := sCallV('ORWPT SELECT', [DFN]);
1145 with PtSelect do
1146 begin
1147 Name := Piece(x, U, 1);
1148 ICN := Piece(x, U, 14);
1149 SSN := FormatSSN(Piece(x, U, 4));
1150 DOB := MakeFMDateTime(Piece(x, U, 3));
1151 Age := StrToIntDef(Piece(x, U, 15), 0);
1152 //Age := CalcAge(DOB, DateOfDeath(DFN));
1153 if Length(Piece(x, U, 2)) > 0 then Sex := Piece(x, U, 2)[1] else Sex := 'U';
1154 LocationIEN := StrToIntDef(Piece(x, U, 5), 0);
1155 Location := Piece(x, U, 6);
1156 RoomBed := Piece(x, U, 7);
1157 SpecialtyIEN := StrToIntDef(Piece(x, u, 16), 0);
1158 CWAD := Piece(x, U, 8);
1159 Restricted := Piece(x, U, 9) = '1';
1160 AdmitTime := MakeFMDateTime(Piece(x, U, 10));
1161 ServiceConnected := Piece(x, U, 12) = '1';
1162 SCPercent := StrToIntDef(Piece(x, U, 13), 0);
1163 //VWPT ADD HRN AltHRN (future)
1164 HRN := Piece(x, U, 17);
1165 AltHRN := Piece(x, U, 18);
1166 end;
1167 x := sCallV('ORWPT1 PRCARE', [DFN]);
1168 with PtSelect do
1169 begin
1170 PrimaryTeam := Piece(x, U, 1);
1171 PrimaryProvider := Piece(x, U, 2);
1172 if Length(Location) > 0 then
1173 begin
1174 Attending := Piece(x, U, 3);
1175 x := sCallV('ORWPT INPLOC', [DFN]);
1176 WardService := Piece(x, U, 3);
1177 end;
1178 end;
1179end;
1180
1181function SimilarRecordsFound(const DFN: string; var AMsg: string): Boolean;
1182begin
1183 Result := False;
1184 AMsg := '';
1185 CallV('DG CHK BS5 XREF Y/N', [DFN]);
1186 with RPCBrokerV do if Results.Count > 0 then
1187 begin
1188 Result := Results[0] = '1';
1189 Results.Delete(0);
1190 AMsg := Results.Text;
1191 end;
1192 (*
1193 CallV('DG CHK BS5 XREF ARRAY', [DFN]);
1194 with RPCBrokerV do if Results.Count > 0 then
1195 begin
1196 Result := Results[0] = '1';
1197 for i := 1 to Results.Count - 1 do
1198 begin
1199 if Piece(Results[i], U, 1) = '0' then AMsg := AMsg + Copy(Results[i], 3, Length(Results[i])) + CRLF;
1200 if Piece(Results[i], U, 1) = '1' then AMsg := AMsg + Piece(Results[i], U, 3) + #9 +
1201 FormatFMDateTimeStr('mmm dd,yyyy', Piece(Results[i], U, 4)) + #9 + Piece(Results[i], U, 5) + CRLF;
1202 end;
1203 end;
1204 *)
1205end;
1206
1207function GetDFNFromICN(AnICN: string): string;
1208begin
1209 Result := Piece(sCallV('VAFCTFU CONVERT ICN TO DFN', [AnICN]), U, 1);
1210end;
1211
1212{ Encounter specific calls }
1213
1214function GetEncounterText(const DFN: string; Location: integer; Provider: Int64): TEncounterText; //*DFN*
1215{ returns resolved external values Pieces: LOCNAME[1]^PROVNAME[2]^ROOMBED[3] }
1216var
1217 x: string;
1218begin
1219 x := sCallV('ORWPT ENCTITL', [DFN, Location, Provider]);
1220 with Result do
1221 begin
1222 LocationName := Piece(x, U, 1);
1223 LocationAbbr := Piece(x, U, 2);
1224 RoomBed := Piece(x, U, 3);
1225 ProviderName := Piece(x, U, 4);
1226// ProviderName := sCallV('ORWU1 NAMECVT', [Provider]);
1227 end;
1228end;
1229
1230procedure ListApptAll(Dest: TStrings; const DFN: string; From: TFMDateTime = 0;
1231 Thru: TFMDateTime = 0);
1232{ lists appts/visits for a patient (uses same call as cover sheet)
1233 V|A;DateTime;LocIEN^DateTime^LocName^Status }
1234const
1235 SKIP_ADMITS = 1;
1236begin
1237 CallV('ORWCV VST', [Patient.DFN, From, Thru, SKIP_ADMITS]);
1238 with RPCBrokerV do
1239 begin
1240 InvertStringList(TStringList(Results));
1241 MixedCaseList(Results);
1242 SetListFMDateTime('mmm dd,yyyy hh:nn', TStringList(Results), U, 2);
1243 FastAssign(Results, Dest);
1244 end;
1245 (*
1246 CallV('ORWPT APPTLST', [DFN]);
1247 with RPCBrokerV do
1248 begin
1249 SortByPiece(TStringList(Results), U, 1);
1250 InvertStringList(TStringList(Results));
1251 for i := 0 to Results.Count - 1 do
1252 begin
1253 x := Results[i];
1254 ATime := Piece(x, U, 1);
1255 ATime := FormatFMDateTime('mmm dd, yyyy hh:nn', MakeFMDateTime(ATime));
1256 SetPiece(x, U, 5, ATime);
1257 Results[i] := x;
1258 end;
1259 FastAssign(Results, Dest);
1260 end;
1261 *)
1262end;
1263
1264procedure ListAdmitAll(Dest: TStrings; const DFN: string); //*DFN*
1265{ lists all admissions for a patient: MovementTime^LocIEN^LocName^Type }
1266var
1267 i: Integer;
1268 ATime, x: string;
1269begin
1270 CallV('ORWPT ADMITLST', [DFN]);
1271 with RPCBrokerV do
1272 begin
1273 for i := 0 to Results.Count - 1 do
1274 begin
1275 x := Results[i];
1276 ATime := Piece(x, U, 1);
1277 ATime := FormatFMDateTime('mmm dd, yyyy hh:nn', MakeFMDateTime(ATime));
1278 SetPiece(x, U, 5, ATime);
1279 Results[i] := x;
1280 end;
1281 FastAssign(Results, Dest);
1282 end;
1283end;
1284
1285function SubSetOfLocations(const StartFrom: string; Direction: Integer): TStrings;
1286{ returns a pointer to a list of locations (for use in a long list box) - The return value is
1287 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
1288begin
1289 CallV('ORWU HOSPLOC', [StartFrom, Direction]);
1290 Result := RPCBrokerV.Results;
1291end;
1292
1293function SubSetOfNewLocs(const StartFrom: string; Direction: Integer): TStrings;
1294{ Returns a pointer to a list of locations (for use in a long list box) - the return value is
1295 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call!
1296 Filtered by C, W, and Z types - i.e., Clinics, Wards, and "Other" type locations.}
1297begin
1298 CallV('ORWU1 NEWLOC', [StartFrom, Direction]);
1299 Result := RPCBrokerV.Results;
1300end;
1301
1302function SubSetOfInpatientLocations(const StartFrom: string; Direction: Integer): TStrings;
1303{ returns a pointer to a list of locations (for use in a long list box) - The return value is
1304 a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
1305begin
1306 CallV('ORWU INPLOC', [StartFrom, Direction]);
1307 Result := RPCBrokerV.Results;
1308end;
1309
1310{ Remote Data Access calls }
1311
1312function HasRemoteData(const DFN: string; var ALocations: TStringList): Boolean;
1313begin
1314 CallV('ORWCIRN FACLIST', [DFN]);
1315 FastAssign(RPCBrokerV.Results, ALocations);
1316 Result := not (Piece(RPCBrokerV.Results[0], U, 1) = '-1');
1317
1318// '-1^NO DFN'
1319// '-1^PATIENT NOT IN DATABASE'
1320// '-1^NO MPI Node'
1321// '-1^NO ICN'
1322// '-1^Parameter missing.'
1323// '-1^No patient DFN.'
1324// '-1^Could not find Treating Facilities'
1325// '-1^Remote access not allowed' <===parameter ORWCIRN REMOTE DATA ALLOW
1326end;
1327
1328function CheckHL7TCPLink: Boolean;
1329 begin
1330 CallV('ORWCIRN CHECKLINK',[nil]);
1331 Result := RPCBrokerV.Results[0] = '1';
1332 end;
1333
1334function GetVistaWebAddress(value: string): string;
1335begin
1336 CallV('ORWCIRN WEBADDR', [value]);
1337 result := RPCBrokerV.Results[0];
1338end;
1339
1340function GetDefaultPrinter(DUZ: Int64; Location: integer): string;
1341begin
1342 Result := sCallV('ORWRP GET DEFAULT PRINTER', [DUZ, Location]) ;
1343end;
1344
1345end.
Note: See TracBrowser for help on using the repository browser.