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