1348 lines
44 KiB
Plaintext
1348 lines
44 KiB
Plaintext
unit rCore;
|
|
|
|
interface
|
|
|
|
uses SysUtils, Classes, Forms, ORNet, ORFn, ORClasses;
|
|
|
|
{ record types used to return data from the RPC's. Generally, the delimited strings returned
|
|
by the RPC are mapped into the records defined below. }
|
|
|
|
const
|
|
UC_UNKNOWN = 0; // user class unknown
|
|
UC_CLERK = 1; // user class clerk
|
|
UC_NURSE = 2; // user class nurse
|
|
UC_PHYSICIAN = 3; // user class physician
|
|
|
|
type
|
|
TUserInfo = record // record for ORWU USERINFO
|
|
DUZ: Int64;
|
|
Name: string;
|
|
UserClass: Integer;
|
|
CanSignOrders: Boolean;
|
|
IsProvider: Boolean;
|
|
OrderRole: Integer;
|
|
NoOrdering: Boolean;
|
|
DTIME: Integer;
|
|
CountDown: Integer;
|
|
EnableVerify: Boolean;
|
|
NotifyAppsWM: Boolean;
|
|
PtMsgHang: Integer;
|
|
Domain: string;
|
|
Service: Integer;
|
|
AutoSave: Integer;
|
|
InitialTab: Integer;
|
|
UseLastTab: Boolean;
|
|
WebAccess: Boolean;
|
|
IsRPL: string;
|
|
RPLList: string;
|
|
HasCorTabs: Boolean;
|
|
HasRptTab: Boolean;
|
|
IsReportsOnly: Boolean;
|
|
ToolsRptEdit: Boolean;
|
|
DisableHold: Boolean;
|
|
GECStatusCheck: Boolean;
|
|
StationNumber: string;
|
|
IsProductionAccount: boolean;
|
|
end;
|
|
|
|
TPtIDInfo = record // record for ORWPT IDINFO
|
|
Name: string;
|
|
SSN: string;
|
|
DOB: string;
|
|
Age: string;
|
|
Sex: string;
|
|
SCSts: string;
|
|
Vet: string;
|
|
Location: string;
|
|
RoomBed: string;
|
|
//ADD VWPT BELOW FOR HRN
|
|
HRN : string;
|
|
AltHRN :string;
|
|
end;
|
|
|
|
TPtSelect = record // record for ORWPT SELECT
|
|
Name: string;
|
|
ICN: string;
|
|
SSN: string;
|
|
DOB: TFMDateTime;
|
|
Age: Integer;
|
|
Sex: Char;
|
|
LocationIEN: Integer;
|
|
Location: string;
|
|
WardService: string;
|
|
RoomBed: string;
|
|
SpecialtyIEN: Integer;
|
|
CWAD: string;
|
|
Restricted: Boolean;
|
|
AdmitTime: TFMDateTime;
|
|
ServiceConnected: Boolean;
|
|
SCPercent: Integer;
|
|
PrimaryTeam: string;
|
|
PrimaryProvider: string;
|
|
Attending: string;
|
|
//ADD VWPT BELOW FOR HRN AltHRN
|
|
HRN : string;
|
|
AltHRN : string;
|
|
end;
|
|
|
|
TEncounterText = record // record for ORWPT ENCTITL
|
|
LocationName: string;
|
|
LocationAbbr: string;
|
|
RoomBed: string;
|
|
ProviderName: string;
|
|
end;
|
|
|
|
{ Date/Time functions - right now these make server calls to use server time}
|
|
|
|
function FMToday: TFMDateTime;
|
|
function FMNow: TFMDateTime;
|
|
function MakeRelativeDateTime(FMDateTime: TFMDateTime): string;
|
|
function StrToFMDateTime(const AString: string): TFMDateTime;
|
|
function ValidDateTimeStr(const AString, Flags: string): TFMDateTime;
|
|
procedure ListDateRangeClinic(Dest: TStrings);
|
|
|
|
{ General calls }
|
|
|
|
function GetProgramFilesPath: String;
|
|
function ExternalName(IEN: Int64; FileNumber: Double): string;
|
|
function PersonHasKey(APerson: Int64; const AKey: string): Boolean;
|
|
function GlobalRefForFile(const FileID: string): string;
|
|
function SubsetOfGeneric(const StartFrom: string; Direction: Integer; const GlobalRef: string): TStrings;
|
|
function SubsetOfDevices(const StartFrom: string; Direction: Integer): TStrings;
|
|
function SubSetOfPersons(const StartFrom: string; Direction: Integer): TStrings;
|
|
function SubSetOfActiveAndInactivePersons(const StartFrom: string; Direction: Integer): TStrings;
|
|
function GetDefaultPrinter(DUZ: Int64; Location: integer): string;
|
|
|
|
{ User specific calls }
|
|
|
|
function GetUserInfo: TUserInfo;
|
|
function GetUserParam(const AParamName: string): string;
|
|
function HasSecurityKey(const KeyName: string): Boolean;
|
|
function HasMenuOptionAccess(const OptionName: string): Boolean;
|
|
function ValidESCode(const ACode: string): Boolean;
|
|
|
|
{ Notifications calls }
|
|
|
|
procedure LoadNotifications(Dest: TStrings);
|
|
procedure DeleteAlert(XQAID: string);
|
|
procedure DeleteAlertForUser(XQAID: string);
|
|
function GetXQAData(XQAID: string): string;
|
|
function GetTIUAlertInfo(XQAID: string): string;
|
|
procedure UpdateUnsignedOrderAlerts(PatientDFN: string);
|
|
function UnsignedOrderAlertFollowup(XQAID: string): string;
|
|
procedure UpdateExpiringMedAlerts(PatientDFN: string);
|
|
procedure UpdateExpiringFlaggedOIAlerts(PatientDFN: string; FollowUp: integer);
|
|
procedure AutoUnflagAlertedOrders(PatientDFN, XQAID: string);
|
|
procedure UpdateUnverifiedMedAlerts(PatientDFN: string);
|
|
procedure UpdateUnverifiedOrderAlerts(PatientDFN: string);
|
|
function GetNotificationFollowUpText(PatientDFN: string; Notification: integer; XQADATA: string): TStrings;
|
|
procedure ForwardAlert(XQAID: string; Recip: string; FWDtype: string; Comment: string);
|
|
procedure RenewAlert(XQAID: string);
|
|
function GetSortMethod: string;
|
|
procedure SetSortMethod(Sort: string; Direction: string);
|
|
|
|
{ Patient List calls }
|
|
|
|
function DfltPtList: string;
|
|
function DfltPtListSrc: Char;
|
|
procedure SavePtListDflt(const x: string);
|
|
procedure ListSpecialtyAll(Dest: TStrings);
|
|
procedure ListTeamAll(Dest: TStrings);
|
|
procedure ListWardAll(Dest: TStrings);
|
|
procedure ListProviderTop(Dest: TStrings);
|
|
function SubSetOfProviders(const StartFrom: string; Direction: Integer): TStrings;
|
|
procedure ListClinicTop(Dest: TStrings);
|
|
function SubSetOfClinics(const StartFrom: string; Direction: Integer): TStrings;
|
|
function GetDfltSort: string;
|
|
procedure ResetDfltSort;
|
|
procedure ListPtByDflt(Dest: TStrings);
|
|
procedure ListPtByProvider(Dest: TStrings; ProviderIEN: Int64);
|
|
procedure ListPtByTeam(Dest: TStrings; TeamIEN: Integer);
|
|
procedure ListPtBySpecialty(Dest: TStrings; SpecialtyIEN: Integer);
|
|
procedure ListPtByClinic(Dest: TStrings; ClinicIEN: Integer; FirstDt, LastDt: string);
|
|
procedure ListPtByWard(Dest: TStrings; WardIEN: Integer);
|
|
procedure ListPtByLast5(Dest: TStrings; const Last5: string);
|
|
procedure ListPtByRPLLast5(Dest: TStrings; const Last5: string);
|
|
procedure ListPtByFullSSN(Dest: TStrings; const FullSSN: string);
|
|
procedure ListPtByRPLFullSSN(Dest: TStrings; const FullSSN: string);
|
|
procedure ListPtTop(Dest: TStrings);
|
|
function SubSetOfPatients(const StartFrom: string; Direction: Integer): TStrings;
|
|
function DfltDateRangeClinic: string;
|
|
function MakeRPLPtList(RPLList: string): string;
|
|
function ReadRPLPtList(RPLJobNumber: string; const StartFrom: string; Direction: Integer) : TStrings;
|
|
procedure KillRPLPtList(RPLJobNumber: string);
|
|
|
|
// VWPT ADDITIONS FOR ENHANCED PATIENT LOOKUP
|
|
procedure ListPtByOther (Dest: Tstrings; const othertext: string ;caption :string);//:string; radbutton:Tobject);
|
|
procedure ListPtByTimson (Dest: Tstrings; const othertext: string);
|
|
//end VWPT
|
|
|
|
{ Patient specific calls }
|
|
|
|
function CalcAge(BirthDate, DeathDate: TFMDateTime): Integer;
|
|
procedure CheckSensitiveRecordAccess(const DFN: string; var AccessStatus: Integer;
|
|
var MessageText: string);
|
|
procedure CheckRemotePatient(var Dest: string; Patient, ASite: string; var AccessStatus: Integer);
|
|
procedure CurrentLocationForPatient(const DFN: string; var ALocation: Integer; var AName: string; var ASvc: string);
|
|
function DateOfDeath(const DFN: string): TFMDateTime;
|
|
function GetPtIDInfo(const DFN: string): TPtIDInfo;
|
|
function HasLegacyData(const DFN: string; var AMsg: string): Boolean;
|
|
function LogSensitiveRecordAccess(const DFN: string): Boolean;
|
|
function MeansTestRequired(const DFN: string; var AMsg: string): Boolean;
|
|
function RestrictedPtRec(const DFN: string): Boolean;
|
|
procedure SelectPatient(const DFN: string; var PtSelect: TPtSelect);
|
|
function SimilarRecordsFound(const DFN: string; var AMsg: string): Boolean;
|
|
function GetDFNFromICN(AnICN: string): string;
|
|
|
|
{ Encounter specific calls }
|
|
|
|
function GetEncounterText(const DFN: string; Location: integer; Provider: Int64): TEncounterText; //*DFN*
|
|
procedure ListApptAll(Dest: TStrings; const DFN: string; From: TFMDateTime = 0;
|
|
Thru: TFMDateTime = 0);
|
|
procedure ListAdmitAll(Dest: TStrings; const DFN: string);
|
|
function SubSetOfLocations(const StartFrom: string; Direction: Integer): TStrings;
|
|
function SubSetOfNewLocs(const StartFrom: string; Direction: Integer): TStrings;
|
|
function SubSetOfInpatientLocations(const StartFrom: string; Direction: Integer): TStrings;
|
|
function SubSetOfProvWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
|
|
function SubSetOfUsersWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
|
|
|
|
{ Remote Data Access calls }
|
|
function HasRemoteData(const DFN: string; var ALocations: TStringList): Boolean;
|
|
function CheckHL7TCPLink: Boolean;
|
|
function UseVistaWeb: Boolean;
|
|
function GetVistaWebAddress(value: string): string;
|
|
procedure ChangeVistaWebParam(value: string);
|
|
|
|
implementation
|
|
|
|
uses Hash, uCore, ShlObj, Windows;
|
|
|
|
var
|
|
uFMToday: TFMDateTime; // Today's date in Fileman format.
|
|
uPtListDfltSort: string = ''; // Current user's patient selection list default sort order.
|
|
|
|
{ private calls }
|
|
|
|
function FormatSSN(const x: string): string;
|
|
{places the dashes in a social security number }
|
|
|
|
//vwpt code 4/17/0 see below
|
|
var
|
|
|
|
i:Integer;
|
|
//end vwpt
|
|
begin
|
|
//vwpt code to prevent extra dashes 4/17/07
|
|
Result := x;
|
|
///take out for i := 1 to Length(x) do if (x[i] in ['-'..'-']) then Exit;
|
|
//end vwpt
|
|
if Length(x) > 8
|
|
then Result := Copy(x,1,3) + '-' + Copy(x,4,2) + '-' + Copy(x,6,Length(x))
|
|
else Result := x;
|
|
end;
|
|
|
|
function IsSSN(const x: string): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
if (Length(x) < 9) or (Length(x) > 10) then Exit;
|
|
for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
function IsFMDate(const x: string): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
if Length(x) <> 7 then Exit;
|
|
for i := 1 to 7 do if not (x[i] in ['0'..'9']) then Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
{ Date/Time functions - not in ORFn because they make server calls to use server time}
|
|
|
|
function FMToday: TFMDateTime;
|
|
{ return the current date in Fileman format }
|
|
begin
|
|
if uFMToday = 0 then uFMToday := Int(FMNow);
|
|
Result := uFMToday;
|
|
end;
|
|
|
|
function FMNow: TFMDateTime;
|
|
{ return the current date/time in Fileman format }
|
|
var
|
|
x: string;
|
|
begin
|
|
x := sCallV('ORWU DT', ['NOW']);
|
|
Result := StrToFloat(x);
|
|
end;
|
|
|
|
function MakeRelativeDateTime(FMDateTime: TFMDateTime): string;
|
|
var
|
|
Offset: Integer;
|
|
h,n,s,l: Word;
|
|
ADateTime: TDateTime;
|
|
ATime: string;
|
|
begin
|
|
Result := '';
|
|
if FMDateTime <= 0 then Exit;
|
|
ADateTime := FMDateTimeToDateTime(FMDateTime);
|
|
Offset := Trunc(Int(ADateTime) - Int(FMDateTimeToDateTime(FMToday)));
|
|
if Offset < 0 then Result := 'T' + IntToStr(Offset)
|
|
else if Offset = 0 then Result := 'T'
|
|
else Result := 'T+' + IntToStr(Offset);
|
|
DecodeTime(ADateTime, h, n, s, l);
|
|
ATime := Format('@%.2d:%.2d', [h, n]);
|
|
if ATime <> '@00:00' then Result := Result + ATime;
|
|
end;
|
|
|
|
function StrToFMDateTime(const AString: string): TFMDateTime;
|
|
{ use %DT the validate and convert a string to Fileman format (accepts T, T-1, NOW, etc.) }
|
|
var
|
|
x: string;
|
|
begin
|
|
x := sCallV('ORWU DT', [AString]);
|
|
Result := StrToFloat(x);
|
|
end;
|
|
|
|
function ValidDateTimeStr(const AString, Flags: string): TFMDateTime;
|
|
{ use %DT to validate & convert a string to Fileman format, accepts %DT flags }
|
|
begin
|
|
Result := StrToFloat(sCallV('ORWU VALDT', [AString, Flags]));
|
|
end;
|
|
|
|
procedure ListDateRangeClinic(Dest: TStrings);
|
|
{ returns date ranges for displaying clinic appointments in patient lookup }
|
|
begin
|
|
CallV('ORWPT CLINRNG', [nil]);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
function DfltDateRangeClinic;
|
|
{ returns current default date range settings for displaying clinic appointments in patient lookup }
|
|
begin
|
|
Result := sCallV('ORQPT DEFAULT CLINIC DATE RANG', [nil]);
|
|
end;
|
|
|
|
{ General calls }
|
|
|
|
function GetProgramFilesPath: String;
|
|
Const
|
|
CSIDL_PROGRAM_FILES = $0026;
|
|
var
|
|
Path: array[0..Max_Path] of Char;
|
|
begin
|
|
Path := '';
|
|
SHGetSpecialFolderPath(0,Path,CSIDL_PROGRAM_FILES,false);
|
|
Result := Path;
|
|
end;
|
|
|
|
function ExternalName(IEN: Int64; FileNumber: Double): string;
|
|
{ returns the external name of the IEN within a file }
|
|
begin
|
|
Result := sCallV('ORWU EXTNAME', [IEN, FileNumber]);
|
|
end;
|
|
|
|
function PersonHasKey(APerson: Int64; const AKey: string): Boolean;
|
|
begin
|
|
Result := sCallV('ORWU NPHASKEY', [APerson, AKey]) = '1';
|
|
end;
|
|
|
|
function GlobalRefForFile(const FileID: string): string;
|
|
begin
|
|
Result := sCallV('ORWU GBLREF', [FileID]);
|
|
end;
|
|
|
|
function SubsetOfGeneric(const StartFrom: string; Direction: Integer; const GlobalRef: string): TStrings;
|
|
begin
|
|
CallV('ORWU GENERIC', [StartFrom, Direction, GlobalRef]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubsetOfDevices(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of devices (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU DEVICE', [StartFrom, Direction]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubSetOfPersons(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of persons (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU NEWPERS', [StartFrom, Direction]);
|
|
// MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
{ User specific calls }
|
|
|
|
function GetUserInfo: TUserInfo;
|
|
{ returns a record of user information,
|
|
Pieces: DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^DTIME^CNTDN^VERORD^NOTIFYAPPS^
|
|
MSGHANG^DOMAIN^SERVICE^AUTOSAVE^INITTAB^LASTTAB^WEBACCESS^ALLOWHOLD^ISRPL^RPLLIST^
|
|
CORTABS^RPTTAB^STATION#^GECStatus^Production account?}
|
|
var
|
|
x: string;
|
|
begin
|
|
x := sCallV('ORWU USERINFO', [nil]);
|
|
with Result do
|
|
begin
|
|
DUZ := StrToInt64Def(Piece(x, U, 1), 0);
|
|
Name := Piece(x, U, 2);
|
|
UserClass := StrToIntDef(Piece(x, U, 3), 0);
|
|
CanSignOrders := Piece(x, U, 4) = '1';
|
|
IsProvider := Piece(x, U, 5) = '1';
|
|
OrderRole := StrToIntDef(Piece(x, U, 6), 0);
|
|
NoOrdering := Piece(x, U, 7) = '1';
|
|
DTIME := StrToIntDef(Piece(x, U, 8), 300);
|
|
CountDown := StrToIntDef(Piece(x, U, 9), 10);
|
|
EnableVerify := Piece(x, U, 10) = '1';
|
|
NotifyAppsWM := Piece(x, U, 11) = '1';
|
|
PtMsgHang := StrToIntDef(Piece(x, U, 12), 5);
|
|
Domain := Piece(x, U, 13);
|
|
Service := StrToIntDef(Piece(x, U, 14), 0);
|
|
AutoSave := StrToIntDef(Piece(x, U, 15), 180);
|
|
InitialTab := StrToIntDef(Piece(x, U, 16), 1);
|
|
UseLastTab := Piece(x, U, 17) = '1';
|
|
WebAccess := Piece(x, U, 18) <> '1';
|
|
DisableHold := Piece(x, U, 19) = '1';
|
|
IsRPL := Piece(x, U, 20);
|
|
RPLList := Piece(x, U, 21);
|
|
HasCorTabs := Piece(x, U, 22) = '1';
|
|
HasRptTab := Piece(x, U, 23) = '1';
|
|
StationNumber := Piece(x, U, 24);
|
|
GECStatusCheck := Piece(x, U, 25) = '1';
|
|
IsProductionAccount := Piece(x, U, 26) = '1';
|
|
IsReportsOnly := false;
|
|
if ((HasRptTab) and (not HasCorTabs)) then
|
|
IsReportsOnly := true;
|
|
// Remove next if and nested if should an "override" later be provided for RPL users,etc.:
|
|
if HasCorTabs then
|
|
if (IsRPL = '1') then
|
|
begin
|
|
IsRPL := '0'; // Hard set for now.
|
|
IsReportsOnly := false;
|
|
end;
|
|
// Following hard set to TRUE per VHA mgt decision:
|
|
ToolsRptEdit := true;
|
|
// x := GetUserParam('ORWT TOOLS RPT SETTINGS OFF');
|
|
// if x = '1' then
|
|
// ToolsRptEdit := false;
|
|
end;
|
|
end;
|
|
|
|
function GetUserParam(const AParamName: string): string;
|
|
begin
|
|
Result := sCallV('ORWU PARAM', [AParamName]);
|
|
end;
|
|
|
|
function HasSecurityKey(const KeyName: string): Boolean;
|
|
{ returns true if the currently logged in user has a given security key }
|
|
var
|
|
x: string;
|
|
begin
|
|
Result := False;
|
|
x := sCallV('ORWU HASKEY', [KeyName]);
|
|
if x = '1' then Result := True;
|
|
end;
|
|
|
|
function HasMenuOptionAccess(const OptionName: string): Boolean;
|
|
begin
|
|
Result := (sCallV('ORWU HAS OPTION ACCESS', [OptionName]) = '1');
|
|
end;
|
|
|
|
function ValidESCode(const ACode: string): Boolean;
|
|
{ returns true if the electronic signature code in ACode is valid }
|
|
begin
|
|
Result := sCallV('ORWU VALIDSIG', [Encrypt(ACode)]) = '1';
|
|
end;
|
|
|
|
{ Notifications Calls }
|
|
|
|
procedure LoadNotifications(Dest: TStrings);
|
|
var
|
|
tmplst: TStringList;
|
|
begin
|
|
tmplst := TStringList.Create;
|
|
try
|
|
//UpdateUnsignedOrderAlerts(Patient.DFN); //moved to AFTER signature and DC actions
|
|
tCallV(tmplst, 'ORWORB FASTUSER', [nil]);
|
|
Dest.Assign(tmplst);
|
|
finally
|
|
tmplst.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure UpdateUnsignedOrderAlerts(PatientDFN: string);
|
|
begin
|
|
CallV('ORWORB KILL UNSIG ORDERS ALERT',[PatientDFN]);
|
|
end;
|
|
|
|
function UnsignedOrderAlertFollowup(XQAID: string): string;
|
|
begin
|
|
Result := sCallV('ORWORB UNSIG ORDERS FOLLOWUP',[XQAID]);
|
|
end;
|
|
|
|
procedure UpdateExpiringMedAlerts(PatientDFN: string);
|
|
begin
|
|
CallV('ORWORB KILL EXPIR MED ALERT',[PatientDFN]);
|
|
end;
|
|
|
|
procedure UpdateExpiringFlaggedOIAlerts(PatientDFN: string; FollowUp: integer);
|
|
begin
|
|
CallV('ORWORB KILL EXPIR OI ALERT',[PatientDFN, FollowUp]);
|
|
end;
|
|
|
|
procedure UpdateUnverifiedMedAlerts(PatientDFN: string);
|
|
begin
|
|
CallV('ORWORB KILL UNVER MEDS ALERT',[PatientDFN]);
|
|
end;
|
|
|
|
procedure UpdateUnverifiedOrderAlerts(PatientDFN: string);
|
|
begin
|
|
CallV('ORWORB KILL UNVER ORDERS ALERT',[PatientDFN]);
|
|
end;
|
|
|
|
procedure AutoUnflagAlertedOrders(PatientDFN, XQAID: string);
|
|
begin
|
|
CallV('ORWORB AUTOUNFLAG ORDERS',[PatientDFN, XQAID]);
|
|
end;
|
|
|
|
procedure DeleteAlert(XQAID: string);
|
|
//deletes an alert
|
|
begin
|
|
CallV('ORB DELETE ALERT',[XQAID]);
|
|
end;
|
|
|
|
procedure DeleteAlertForUser(XQAID: string);
|
|
//deletes an alert
|
|
begin
|
|
CallV('ORB DELETE ALERT',[XQAID, True]);
|
|
end;
|
|
|
|
procedure ForwardAlert(XQAID: string; Recip: string; FWDtype: string; Comment: string);
|
|
// Forwards an alert with comment to Recip[ient]
|
|
begin
|
|
CallV('ORB FORWARD ALERT', [XQAID, Recip, FWDtype, Comment]);
|
|
end;
|
|
|
|
procedure RenewAlert(XQAID: string);
|
|
// Restores/renews an alert
|
|
begin
|
|
CallV('ORB RENEW ALERT', [XQAID]);
|
|
end;
|
|
|
|
function GetSortMethod: string;
|
|
// Returns alert sort method
|
|
begin
|
|
Result := sCallV('ORWORB GETSORT',[nil]);
|
|
end;
|
|
|
|
procedure SetSortMethod(Sort: string; Direction: string);
|
|
// Sets alert sort method for user
|
|
begin
|
|
CallV('ORWORB SETSORT', [Sort, Direction]);
|
|
end;
|
|
|
|
function GetXQAData(XQAID: string): string;
|
|
// Returns data associated with an alert
|
|
begin
|
|
Result := sCallV('ORWORB GETDATA',[XQAID]);
|
|
end;
|
|
|
|
function GetTIUAlertInfo(XQAID: string): string;
|
|
// Returns DFN and document type associated with a TIU alert
|
|
begin
|
|
Result := sCallV('TIU GET ALERT INFO',[XQAID]);
|
|
end;
|
|
|
|
function GetNotificationFollowUpText(PatientDFN: string; Notification: integer; XQADATA: string): TStrings;
|
|
// Returns follow-up text for an alert
|
|
begin
|
|
CallV('ORWORB TEXT FOLLOWUP', [PatientDFN, Notification, XQADATA]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
{ Patient List Calls }
|
|
|
|
function DfltPtList: string;
|
|
{ returns the name of the current user's default patient list, null if none is defined
|
|
Pieces: Ptr to Source File^Source Name^Source Type }
|
|
begin
|
|
Result := sCallV('ORQPT DEFAULT LIST SOURCE', [nil]);
|
|
if Length(Result) > 0 then Result := Pieces(Result, U, 2, 3);
|
|
end;
|
|
|
|
function DfltPtListSrc: Char;
|
|
begin
|
|
Result := CharAt(sCallV('ORWPT DFLTSRC', [nil]), 1);
|
|
end;
|
|
|
|
procedure SavePtListDflt(const x: string);
|
|
begin
|
|
CallV('ORWPT SAVDFLT', [x]);
|
|
end;
|
|
|
|
procedure ListSpecialtyAll(Dest: TStrings);
|
|
{ lists all treating specialties: IEN^Treating Specialty Name }
|
|
begin
|
|
CallV('ORQPT SPECIALTIES', [nil]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListTeamAll(Dest: TStrings);
|
|
{ lists all patient care teams: IEN^Team Name }
|
|
begin
|
|
CallV('ORQPT TEAMS', [nil]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListWardAll(Dest: TStrings);
|
|
{ lists all active inpatient wards: IEN^Ward Name }
|
|
begin
|
|
CallV('ORQPT WARDS', [nil]);
|
|
//MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListProviderTop(Dest: TStrings);
|
|
{ checks parameters for list of commonly selected providers }
|
|
begin
|
|
end;
|
|
|
|
function SubSetOfProviders(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of providers (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU NEWPERS', [StartFrom, Direction, 'PROVIDER']);
|
|
// MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubSetOfProvWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
|
|
{ returns a pointer to a list of providers (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU NEWPERS', [StartFrom, Direction, 'PROVIDER', DateTime]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubSetOfUsersWithClass(const StartFrom: string; Direction: Integer; DateTime: string): TStrings;
|
|
{ returns a pointer to a list of users (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU NEWPERS', [StartFrom, Direction, '', DateTime]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubSetOfActiveAndInactivePersons(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of users (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call!}
|
|
begin
|
|
CallV('ORWU NEWPERS', [StartFrom, Direction, '', '', '', True]); //TRUE = return all active and inactive users
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
|
|
procedure ListClinicTop(Dest: TStrings);
|
|
{ checks parameters for list of commonly selected clinics }
|
|
begin
|
|
end;
|
|
|
|
function SubSetOfClinics(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of clinics (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU CLINLOC', [StartFrom, Direction]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function GetDfltSort: string;
|
|
{ Assigns uPtLstDfltSort to user's default patient list sort order (string character).}
|
|
begin
|
|
uPtListDfltSort := sCallV('ORQPT DEFAULT LIST SORT', [nil]);
|
|
if uPtListDfltSort = '' then uPtListDfltSort := 'A'; // Default is always "A" for alpha.
|
|
result := uPtListDfltSort;
|
|
end;
|
|
|
|
procedure ResetDfltSort;
|
|
begin
|
|
uPtListDfltSort := '';
|
|
end;
|
|
|
|
procedure ListPtByDflt(Dest: TStrings);
|
|
{ loads the default patient list into Dest, Pieces: DFN^PATIENT NAME, ETC. }
|
|
var
|
|
i, SourceType: Integer;
|
|
ATime, APlace, Sort, Source, x: string;
|
|
tmplst: TORStringList;
|
|
begin
|
|
Sort := GetDfltSort();
|
|
tmplst := TORStringList.Create;
|
|
try
|
|
tCallV(tmplst, 'ORQPT DEFAULT PATIENT LIST', [nil]);
|
|
Source := sCallV('ORWPT DFLTSRC', [nil]);
|
|
if Source = 'C' then // Clinics.
|
|
begin
|
|
if Sort = 'P' then // "Appointments" sort.
|
|
SortByPiece(tmplst, U, 4)
|
|
else
|
|
SortByPiece(tmplst, U, 2);
|
|
for i := 0 to tmplst.Count - 1 do
|
|
begin
|
|
x := tmplst[i];
|
|
ATime := Piece(x, U, 4);
|
|
APlace := Piece(x, U, 3);
|
|
ATime := FormatFMDateTime('hh:nn mmm dd, yyyy', MakeFMDateTime(ATime));
|
|
SetPiece(x, U, 3, ATime);
|
|
x := x + U + APlace;
|
|
tmplst[i] := x;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
SourceType := 0; // Default.
|
|
if Source = 'M' then SourceType := 1; // Combinations.
|
|
if Source = 'W' then SourceType := 2; // Wards.
|
|
case SourceType of
|
|
1 : if Sort = 'S' then tmplst.SortByPieces([3, 8, 2]) // "Source" sort.
|
|
else if Sort = 'P' then tmplst.SortByPieces([8, 2]) // "Appointment" sort.
|
|
else if Sort = 'T' then SortByPiece(tmplst, U, 5) // "Terminal Digit" sort.
|
|
else SortByPiece(tmplst, U, 2); // "Alphabetical" (also the default) sort.
|
|
2 : if Sort = 'R' then tmplst.SortByPieces([3, 2])
|
|
else SortByPiece(tmplst, U, 2);
|
|
else SortByPiece(tmplst, U, 2);
|
|
end;
|
|
end;
|
|
MixedCaseList(tmplst);
|
|
Dest.Assign(tmplst);
|
|
finally
|
|
tmplst.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure ListPtByProvider(Dest: TStrings; ProviderIEN: Int64);
|
|
{ lists all patients associated with a given provider: DFN^Patient Name }
|
|
begin
|
|
CallV('ORQPT PROVIDER PATIENTS', [ProviderIEN]);
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtByTeam(Dest: TStrings; TeamIEN: Integer);
|
|
{ lists all patients associated with a given team: DFN^Patient Name }
|
|
begin
|
|
CallV('ORQPT TEAM PATIENTS', [TeamIEN]);
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtBySpecialty(Dest: TStrings; SpecialtyIEN: Integer);
|
|
{ lists all patients associated with a given specialty: DFN^Patient Name }
|
|
begin
|
|
CallV('ORQPT SPECIALTY PATIENTS', [SpecialtyIEN]);
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtByClinic(Dest: TStrings; ClinicIEN: Integer; FirstDt, LastDt: string); //TFMDateTime);
|
|
{ lists all patients associated with a given clinic: DFN^Patient Name^App't }
|
|
var
|
|
i: Integer;
|
|
x, ATime, APlace, Sort: string;
|
|
begin
|
|
Sort := GetDfltSort();
|
|
CallV('ORQPT CLINIC PATIENTS', [ClinicIEN, FirstDt, LastDt]);
|
|
with RPCBrokerV do
|
|
begin
|
|
if Sort = 'P' then
|
|
SortByPiece(TStringList(Results), U, 4)
|
|
else
|
|
SortByPiece(TStringList(Results), U, 2);
|
|
for i := 0 to Results.Count - 1 do
|
|
begin
|
|
x := Results[i];
|
|
ATime := Piece(x, U, 4);
|
|
APlace := Piece(x, U, 3);
|
|
ATime := FormatFMDateTime('hh:nn mmm dd, yyyy', MakeFMDateTime(ATime));
|
|
SetPiece(x, U, 3, ATime);
|
|
x := x + U + APlace;
|
|
Results[i] := x;
|
|
end;
|
|
MixedCaseList(Results);
|
|
Dest.Assign(Results);
|
|
end;
|
|
end;
|
|
|
|
procedure ListPtByWard(Dest: TStrings; WardIEN: Integer);
|
|
{ lists all patients associated with a given ward: DFN^Patient Name^Room/Bed }
|
|
var
|
|
Sort: string;
|
|
begin
|
|
Sort := GetDfltSort();
|
|
CallV('ORWPT BYWARD', [WardIEN]);
|
|
if Sort = 'R' then
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 3)
|
|
else
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
// VWPT ADDITIONS FOR ENHANCED PATIENT LOOKUP
|
|
procedure ListPtByOther (Dest: Tstrings; const othertext: string;caption:string );//:string; radbutton:Tobject);
|
|
var
|
|
i: Integer;
|
|
x,Afieldname: string;
|
|
begin
|
|
|
|
CallV('ORWPT OTHER-RADIOBUTTONS',[othertext, caption]);
|
|
//SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtByTimson (Dest: Tstrings; const othertext: string);//
|
|
|
|
var
|
|
i: Integer;
|
|
x,Afieldname: string;
|
|
begin
|
|
|
|
CallV('ORWPT ENHANCED PATLOOKUP',[othertext]);
|
|
//SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
|
|
|
|
//END VWPT ADDITIONS
|
|
procedure ListPtByLast5(Dest: TStrings; const Last5: string);
|
|
var
|
|
i: Integer;
|
|
x, ADate, AnSSN: string;
|
|
begin
|
|
{ Lists all patients found in the BS and BS5 xrefs that match Last5: DFN^Patient Name }
|
|
CallV('ORWPT LAST5', [UpperCase(Last5)]);
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
|
begin
|
|
x := Results[i];
|
|
ADate := Piece(x, U, 3);
|
|
AnSSN := Piece(x, U, 4);
|
|
if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
|
|
if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
|
|
SetPiece(x, U, 3, AnSSN + ' ' + ADate);
|
|
Results[i] := x;
|
|
end;
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtByRPLLast5(Dest: TStrings; const Last5: string);
|
|
var
|
|
i: Integer;
|
|
x, ADate, AnSSN: string;
|
|
begin
|
|
{ Lists patients from RPL list that match Last5: DFN^Patient Name }
|
|
CallV('ORWPT LAST5 RPL', [UpperCase(Last5)]);
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
|
begin
|
|
x := Results[i];
|
|
ADate := Piece(x, U, 3);
|
|
AnSSN := Piece(x, U, 4);
|
|
if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
|
|
if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
|
|
SetPiece(x, U, 3, AnSSN + ' ' + ADate);
|
|
Results[i] := x;
|
|
end;
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtByFullSSN(Dest: TStrings; const FullSSN: string);
|
|
{ lists all patients found in the SSN xref that match FullSSN: DFN^Patient Name }
|
|
var
|
|
i: integer;
|
|
x, ADate, AnSSN: string;
|
|
begin
|
|
x := FullSSN;
|
|
i := Pos('-', x);
|
|
while i > 0 do
|
|
begin
|
|
x := Copy(x, 1, i-1) + Copy(x, i+1, 12);
|
|
i := Pos('-', x);
|
|
end;
|
|
CallV('ORWPT FULLSSN', [UpperCase(x)]);
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
|
begin
|
|
x := Results[i];
|
|
ADate := Piece(x, U, 3);
|
|
AnSSN := Piece(x, U, 4);
|
|
if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
|
|
if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
|
|
SetPiece(x, U, 3, AnSSN + ' ' + ADate);
|
|
Results[i] := x;
|
|
end;
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtByRPLFullSSN(Dest: TStrings; const FullSSN: string);
|
|
{ lists all patients found in the SSN xref that match FullSSN: DFN^Patient Name }
|
|
var
|
|
i: integer;
|
|
x, ADate, AnSSN: string;
|
|
begin
|
|
x := FullSSN;
|
|
i := Pos('-', x);
|
|
while i > 0 do
|
|
begin
|
|
x := Copy(x, 1, i-1) + Copy(x, i+1, 12);
|
|
i := Pos('-', x);
|
|
end;
|
|
CallV('ORWPT FULLSSN RPL', [UpperCase(x)]);
|
|
SortByPiece(TStringList(RPCBrokerV.Results), U, 2);
|
|
with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
|
begin
|
|
x := Results[i];
|
|
ADate := Piece(x, U, 3);
|
|
AnSSN := Piece(x, U, 4);
|
|
if IsFMDate(ADate) then ADate := FormatFMDateTimeStr('mmm d, yyyy', ADate);
|
|
if IsSSN(AnSSN) then AnSSN := FormatSSN(AnSSN);
|
|
SetPiece(x, U, 3, AnSSN + ' ' + ADate);
|
|
Results[i] := x;
|
|
end;
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure ListPtTop(Dest: TStrings);
|
|
{ currently returns the last patient selected }
|
|
begin
|
|
CallV('ORWPT TOP', [nil]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
function SubSetOfPatients(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of patients (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWPT LIST ALL', [StartFrom, Direction]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function MakeRPLPtList(RPLList: string): string;
|
|
{ Creates "RPL" Restricted Patient List based on Team List info in user's record. }
|
|
begin
|
|
result := sCallV('ORQPT MAKE RPL', [RPLList]);
|
|
end;
|
|
|
|
function ReadRPLPtList(RPLJobNumber: string; const StartFrom: string; Direction: Integer) : TStrings;
|
|
{ returns a pointer to a list of patients (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORQPT READ RPL', [RPLJobNumber, StartFrom, Direction]);
|
|
MixedCaseList(RPCBrokerV.Results);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
procedure KillRPLPtList(RPLJobNumber: string);
|
|
begin
|
|
CallV('ORQPT KILL RPL', [RPLJobNumber]);
|
|
end;
|
|
|
|
{ Patient Specific Calls }
|
|
|
|
function CalcAge(BirthDate, DeathDate: TFMDateTime): Integer;
|
|
{ calculates age based on today's date and a birthdate (in Fileman format) }
|
|
begin
|
|
if (DeathDate > BirthDate) then
|
|
Result := Trunc(DeathDate - BirthDate) div 10000
|
|
else
|
|
Result := Trunc(FMToday - BirthDate) div 10000
|
|
end;
|
|
|
|
procedure CheckSensitiveRecordAccess(const DFN: string; var AccessStatus: Integer;
|
|
var MessageText: string);
|
|
begin
|
|
CallV('DG SENSITIVE RECORD ACCESS', [DFN]);
|
|
AccessStatus := -1;
|
|
MessageText := '';
|
|
with RPCBrokerV do
|
|
begin
|
|
if Results.Count > 0 then
|
|
begin
|
|
AccessStatus := StrToIntDef(Results[0], -1);
|
|
Results.Delete(0);
|
|
if Results.Count > 0 then MessageText := Results.Text;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckRemotePatient(var Dest: string; Patient, ASite: string; var AccessStatus: Integer);
|
|
|
|
begin
|
|
CallV('XWB DIRECT RPC', [ASite, 'ORWCIRN RESTRICT', 0, Patient]);
|
|
AccessStatus := -1;
|
|
Dest := '';
|
|
with RPCBrokerV do
|
|
begin
|
|
if Results.Count > 0 then
|
|
begin
|
|
if Results[0] = '' then Results.Delete(0);
|
|
end;
|
|
if Results.Count > 0 then
|
|
begin
|
|
if (length(piece(Results[0],'^',2)) > 0) and ((StrToIntDef(piece(Results[0],'^',1),0) = -1)) then
|
|
begin
|
|
AccessStatus := -1;
|
|
Dest := piece(Results[0],'^',2);
|
|
end
|
|
else
|
|
begin
|
|
AccessStatus := StrToIntDef(Results[0], -1);
|
|
Results.Delete(0);
|
|
if Results.Count > 0 then Dest := Results.Text;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CurrentLocationForPatient(const DFN: string; var ALocation: Integer; var AName: string; var ASvc: string);
|
|
var
|
|
x: string;
|
|
begin
|
|
x := sCallV('ORWPT INPLOC', [DFN]);
|
|
ALocation := StrToIntDef(Piece(x, U, 1), 0);
|
|
AName := Piece(x, U, 2);
|
|
ASvc := Piece(x, U, 3);
|
|
end;
|
|
|
|
function DateOfDeath(const DFN: string): TFMDateTime;
|
|
{ returns 0 or the date a patient died }
|
|
begin
|
|
Result := MakeFMDateTime(sCallV('ORWPT DIEDON', [DFN]));
|
|
end;
|
|
|
|
function GetPtIDInfo(const DFN: string): TPtIDInfo; //*DFN*
|
|
{ returns the identifiers displayed upon patient selection
|
|
//VWPT ADD HRN ,ALT HRN (FUTURE)
|
|
Pieces: SSN[1]^DOB[2]^SEX[3]^VET[4]^SC%[5]^WARD[6]^RM-BED[7]^NAME[8]^HRN[9]^ALTHRN[10] }
|
|
// Pieces: SSN[1]^DOB[2]^SEX[3]^VET[4]^SC%[5]^WARD[6]^RM-BED[7]^NAME[8] }
|
|
var
|
|
x: string;
|
|
begin
|
|
x := sCallV('ORWPT ID INFO', [DFN]);
|
|
with Result do // map string into TPtIDInfo record
|
|
begin
|
|
Name := MixedCase(Piece(x, U, 8)); // Name
|
|
SSN := Piece(x, U, 1);
|
|
DOB := Piece(x, U, 2);
|
|
Age := '';
|
|
if IsSSN(SSN) then SSN := FormatSSN(Piece(x, U, 1)); // SSN (PID)
|
|
if IsFMDate(DOB) then DOB := FormatFMDateTimeStr('mmm dd,yyyy', DOB); // Date of Birth
|
|
//Age := IntToStr(CalcAge(MakeFMDateTime(Piece(x, U, 2)))); // Age
|
|
Sex := Piece(x, U, 3); // Sex
|
|
if Length(Sex) = 0 then Sex := 'U';
|
|
case Sex[1] of
|
|
'F','f': Sex := 'Female';
|
|
'M','m': Sex := 'Male';
|
|
else Sex := 'Unknown';
|
|
end;
|
|
if Piece(x, U, 4) = 'Y' then Vet := 'Veteran' else Vet := ''; // Veteran?
|
|
if Length(Piece(x, U, 5)) > 0 // % Service Connected
|
|
then SCSts := Piece(x, U, 5) + '% Service Connected'
|
|
else SCSts := '';
|
|
Location := Piece(x, U, 6); // Inpatient Location
|
|
RoomBed := Piece(x, U, 7); // Inpatient Room-Bed
|
|
// VWPT ADD HRN
|
|
HRN := Piece(x, U, 9);
|
|
AltHRN := Piece(x, U, 10);
|
|
end;
|
|
end;
|
|
|
|
function HasLegacyData(const DFN: string; var AMsg: string): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
AMsg := '';
|
|
CallV('ORWPT LEGACY', [DFN]);
|
|
with RPCBrokerV do if Results.Count > 0 then
|
|
begin
|
|
Result := Results[0] = '1';
|
|
for i := 1 to Results.Count - 1 do AMsg := AMsg + Results[i] + CRLF;
|
|
end;
|
|
end;
|
|
|
|
function LogSensitiveRecordAccess(const DFN: string): Boolean;
|
|
begin
|
|
Result := sCallV('DG SENSITIVE RECORD BULLETIN', [DFN]) = '1';
|
|
end;
|
|
|
|
function MeansTestRequired(const DFN: string; var AMsg: string): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
AMsg := '';
|
|
CallV('DG CHK PAT/DIV MEANS TEST', [DFN]);
|
|
with RPCBrokerV do if Results.Count > 0 then
|
|
begin
|
|
Result := Results[0] = '1';
|
|
for i := 1 to Results.Count - 1 do AMsg := AMsg + Results[i] + CRLF;
|
|
end;
|
|
end;
|
|
|
|
function RestrictedPtRec(const DFN: string): Boolean; //*DFN*
|
|
{ returns true if the record for a patient identified by DFN is restricted }
|
|
begin
|
|
Result := Piece(sCallV('ORWPT SELCHK', [DFN]), U, 1) = '1';
|
|
end;
|
|
|
|
procedure SelectPatient(const DFN: string; var PtSelect: TPtSelect); //*DFN*
|
|
{ selects the patient (updates DISV, calls Pt Select actions) & returns key fields
|
|
Pieces: NAME[1]^SEX[2]^DOB[3]^SSN[4]^LOCIEN[5]^LOCNAME[6]^ROOMBED[7]^CWAD[8]^SENSITIVE[9]^
|
|
//VWPT add HRN and ALTERNATE HRN used with PID hl7 segments
|
|
ADMITTIME[10]^CONVERTED[11]^SVCONN[12]^SC%[13]^ICN[14]^Age[15]^TreatSpec[16]^HRN[17]^AltHRN[18] }
|
|
// BEFORE THIS VWPT WAS ADMITTIME[10]^CONVERTED[11]^SVCONN[12]^SC%[13]^ICN[14]^Age[15]^TreatSpec[16] }
|
|
var
|
|
x: string;
|
|
begin
|
|
x := sCallV('ORWPT SELECT', [DFN]);
|
|
with PtSelect do
|
|
begin
|
|
Name := Piece(x, U, 1);
|
|
ICN := Piece(x, U, 14);
|
|
SSN := FormatSSN(Piece(x, U, 4));
|
|
DOB := MakeFMDateTime(Piece(x, U, 3));
|
|
Age := StrToIntDef(Piece(x, U, 15), 0);
|
|
//Age := CalcAge(DOB, DateOfDeath(DFN));
|
|
if Length(Piece(x, U, 2)) > 0 then Sex := Piece(x, U, 2)[1] else Sex := 'U';
|
|
LocationIEN := StrToIntDef(Piece(x, U, 5), 0);
|
|
Location := Piece(x, U, 6);
|
|
RoomBed := Piece(x, U, 7);
|
|
SpecialtyIEN := StrToIntDef(Piece(x, u, 16), 0);
|
|
CWAD := Piece(x, U, 8);
|
|
Restricted := Piece(x, U, 9) = '1';
|
|
AdmitTime := MakeFMDateTime(Piece(x, U, 10));
|
|
ServiceConnected := Piece(x, U, 12) = '1';
|
|
SCPercent := StrToIntDef(Piece(x, U, 13), 0);
|
|
|
|
//VWPT ADD HRN AltHRN (future)
|
|
HRN := Piece(x, U, 17);
|
|
AltHRN := Piece(x, U, 18);
|
|
end;
|
|
x := sCallV('ORWPT1 PRCARE', [DFN]);
|
|
with PtSelect do
|
|
begin
|
|
PrimaryTeam := Piece(x, U, 1);
|
|
PrimaryProvider := Piece(x, U, 2);
|
|
if Length(Location) > 0 then
|
|
begin
|
|
Attending := Piece(x, U, 3);
|
|
x := sCallV('ORWPT INPLOC', [DFN]);
|
|
WardService := Piece(x, U, 3);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function SimilarRecordsFound(const DFN: string; var AMsg: string): Boolean;
|
|
begin
|
|
Result := False;
|
|
AMsg := '';
|
|
CallV('DG CHK BS5 XREF Y/N', [DFN]);
|
|
with RPCBrokerV do if Results.Count > 0 then
|
|
begin
|
|
Result := Results[0] = '1';
|
|
Results.Delete(0);
|
|
AMsg := Results.Text;
|
|
end;
|
|
(*
|
|
CallV('DG CHK BS5 XREF ARRAY', [DFN]);
|
|
with RPCBrokerV do if Results.Count > 0 then
|
|
begin
|
|
Result := Results[0] = '1';
|
|
for i := 1 to Results.Count - 1 do
|
|
begin
|
|
if Piece(Results[i], U, 1) = '0' then AMsg := AMsg + Copy(Results[i], 3, Length(Results[i])) + CRLF;
|
|
if Piece(Results[i], U, 1) = '1' then AMsg := AMsg + Piece(Results[i], U, 3) + #9 +
|
|
FormatFMDateTimeStr('mmm dd,yyyy', Piece(Results[i], U, 4)) + #9 + Piece(Results[i], U, 5) + CRLF;
|
|
end;
|
|
end;
|
|
*)
|
|
end;
|
|
|
|
function GetDFNFromICN(AnICN: string): string;
|
|
begin
|
|
Result := Piece(sCallV('VAFCTFU CONVERT ICN TO DFN', [AnICN]), U, 1);
|
|
end;
|
|
|
|
{ Encounter specific calls }
|
|
|
|
function GetEncounterText(const DFN: string; Location: integer; Provider: Int64): TEncounterText; //*DFN*
|
|
{ returns resolved external values Pieces: LOCNAME[1]^PROVNAME[2]^ROOMBED[3] }
|
|
var
|
|
x: string;
|
|
begin
|
|
x := sCallV('ORWPT ENCTITL', [DFN, Location, Provider]);
|
|
with Result do
|
|
begin
|
|
LocationName := Piece(x, U, 1);
|
|
LocationAbbr := Piece(x, U, 2);
|
|
RoomBed := Piece(x, U, 3);
|
|
ProviderName := Piece(x, U, 4);
|
|
// ProviderName := sCallV('ORWU1 NAMECVT', [Provider]);
|
|
end;
|
|
end;
|
|
|
|
procedure ListApptAll(Dest: TStrings; const DFN: string; From: TFMDateTime = 0;
|
|
Thru: TFMDateTime = 0);
|
|
{ lists appts/visits for a patient (uses same call as cover sheet)
|
|
V|A;DateTime;LocIEN^DateTime^LocName^Status }
|
|
const
|
|
SKIP_ADMITS = 1;
|
|
begin
|
|
CallV('ORWCV VST', [Patient.DFN, From, Thru, SKIP_ADMITS]);
|
|
with RPCBrokerV do
|
|
begin
|
|
InvertStringList(TStringList(Results));
|
|
MixedCaseList(Results);
|
|
SetListFMDateTime('mmm dd,yyyy hh:nn', TStringList(Results), U, 2);
|
|
Dest.Assign(Results);
|
|
end;
|
|
(*
|
|
CallV('ORWPT APPTLST', [DFN]);
|
|
with RPCBrokerV do
|
|
begin
|
|
SortByPiece(TStringList(Results), U, 1);
|
|
InvertStringList(TStringList(Results));
|
|
for i := 0 to Results.Count - 1 do
|
|
begin
|
|
x := Results[i];
|
|
ATime := Piece(x, U, 1);
|
|
ATime := FormatFMDateTime('mmm dd, yyyy hh:nn', MakeFMDateTime(ATime));
|
|
SetPiece(x, U, 5, ATime);
|
|
Results[i] := x;
|
|
end;
|
|
Dest.Assign(Results);
|
|
end;
|
|
*)
|
|
end;
|
|
|
|
procedure ListAdmitAll(Dest: TStrings; const DFN: string); //*DFN*
|
|
{ lists all admissions for a patient: MovementTime^LocIEN^LocName^Type }
|
|
var
|
|
i: Integer;
|
|
ATime, x: string;
|
|
begin
|
|
CallV('ORWPT ADMITLST', [DFN]);
|
|
with RPCBrokerV do
|
|
begin
|
|
for i := 0 to Results.Count - 1 do
|
|
begin
|
|
x := Results[i];
|
|
ATime := Piece(x, U, 1);
|
|
ATime := FormatFMDateTime('mmm dd, yyyy hh:nn', MakeFMDateTime(ATime));
|
|
SetPiece(x, U, 5, ATime);
|
|
Results[i] := x;
|
|
end;
|
|
Dest.Assign(Results);
|
|
end;
|
|
end;
|
|
|
|
function SubSetOfLocations(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of locations (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU HOSPLOC', [StartFrom, Direction]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubSetOfNewLocs(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ Returns a pointer to a list of locations (for use in a long list box) - the return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call!
|
|
Filtered by C, W, and Z types - i.e., Clinics, Wards, and "Other" type locations.}
|
|
begin
|
|
CallV('ORWU1 NEWLOC', [StartFrom, Direction]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubSetOfInpatientLocations(const StartFrom: string; Direction: Integer): TStrings;
|
|
{ returns a pointer to a list of locations (for use in a long list box) - The return value is
|
|
a pointer to RPCBrokerV.Results, so the data must be used BEFORE the next broker call! }
|
|
begin
|
|
CallV('ORWU INPLOC', [StartFrom, Direction]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
{ Remote Data Access calls }
|
|
|
|
function HasRemoteData(const DFN: string; var ALocations: TStringList): Boolean;
|
|
begin
|
|
CallV('ORWCIRN FACLIST', [DFN]);
|
|
ALocations.Assign(RPCBrokerV.Results);
|
|
Result := not (Piece(RPCBrokerV.Results[0], U, 1) = '-1');
|
|
|
|
// '-1^NO DFN'
|
|
// '-1^PATIENT NOT IN DATABASE'
|
|
// '-1^NO MPI Node'
|
|
// '-1^NO ICN'
|
|
// '-1^Parameter missing.'
|
|
// '-1^No patient DFN.'
|
|
// '-1^Could not find Treating Facilities'
|
|
// '-1^Remote access not allowed' <===parameter ORWCIRN REMOTE DATA ALLOW
|
|
end;
|
|
|
|
function CheckHL7TCPLink: Boolean;
|
|
begin
|
|
CallV('ORWCIRN CHECKLINK',[nil]);
|
|
Result := RPCBrokerV.Results[0] = '1';
|
|
end;
|
|
|
|
function UseVistaWeb: Boolean;
|
|
begin;
|
|
CallV('ORWCIRN VISTAWEB',[nil]);
|
|
result := RPCBrokerV.Results[0] = '1';
|
|
end;
|
|
|
|
function GetVistaWebAddress(value: string): string;
|
|
begin
|
|
CallV('ORWCIRN WEBADDR', [value]);
|
|
result := RPCBrokerV.Results[0];
|
|
end;
|
|
|
|
procedure ChangeVistaWebParam(value: string);
|
|
begin
|
|
CallV('ORWCIRN WEBCH',[value]);
|
|
end;
|
|
|
|
function GetDefaultPrinter(DUZ: Int64; Location: integer): string;
|
|
begin
|
|
Result := sCallV('ORWRP GET DEFAULT PRINTER', [DUZ, Location]) ;
|
|
end;
|
|
|
|
initialization
|
|
uFMToday := 0;
|
|
|
|
end.
|