| [459] | 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 | 
 | 
|---|
| [460] | 100 | function GetProgramFilesPath: String;
 | 
|---|
| [459] | 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;
 | 
|---|
| [460] | 136 | procedure SetSortMethod(Sort: string; Direction: string);
 | 
|---|
| [459] | 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;
 | 
|---|
| [460] | 201 | function UseVistaWeb: Boolean;
 | 
|---|
 | 202 | function GetVistaWebAddress(value: string): string;
 | 
|---|
 | 203 | procedure ChangeVistaWebParam(value: string);
 | 
|---|
| [459] | 204 | 
 | 
|---|
 | 205 | implementation
 | 
|---|
 | 206 | 
 | 
|---|
| [460] | 207 | uses Hash, uCore, ShlObj, Windows;
 | 
|---|
| [459] | 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 | 
 | 
|---|
| [460] | 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 | 
 | 
|---|
| [459] | 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 | 
 | 
|---|
| [460] | 524 | procedure SetSortMethod(Sort: string; Direction: string);
 | 
|---|
| [459] | 525 | // Sets alert sort method for user
 | 
|---|
 | 526 | begin
 | 
|---|
| [460] | 527 |    CallV('ORWORB SETSORT', [Sort, Direction]);
 | 
|---|
| [459] | 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
 | 
|---|
| [460] | 629 |   CallV('ORWU NEWPERS', [StartFrom, Direction, '', '', '', True]);  //TRUE = return all active and inactive users
 | 
|---|
| [459] | 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 | 
 | 
|---|
| [460] | 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 | 
 | 
|---|
| [459] | 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.
 | 
|---|