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