source: cprs/branches/tmg-cprs/CPRS-Chart/rCore.pas@ 1680

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

Bug fixes. Improved Adding Image

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