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