iSharkFly-Open
/
VistA-cprs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-cprs/CPRS-Chart/Orders/rODBase.pas

867 lines
27 KiB
Plaintext
Raw Blame History

unit rODBase;
interface
uses SysUtils, Windows, Classes, ORNet, ORFn, uCore, uConst, rOrders;
type
TPrompt = class
ID: string;
IEN: Integer;
Sequence: Double;
FmtCode: string;
Omit: string;
Leading: string;
Trailing: string;
NewLine: Boolean;
WrapWP: Boolean;
Children: string;
IsChild: Boolean;
end;
TResponse = class
PromptIEN: Integer;
PromptID: string;
Instance: Integer;
IValue: string;
EValue: string;
end;
TDialogItem = class
ID: string;
Required: Boolean;
Hidden: Boolean;
Prompt: string;
DataType: Char;
Domain: string;
EDefault: string;
IDefault: string;
HelpText: string;
CrossRef: string;
ScreenRef: string;
end;
TDialogNames = record
Internal: string;
Display: string;
BaseIEN: Integer;
BaseName: string;
end;
TConstructOrder = record
DialogName: string;
LeadText: string;
TrailText: string;
DGroup: Integer;
OrderItem: Integer;
DelayEvent: Char;
PTEventPtr: String; // ptr to #100.2
EventPtr: String; // ptr to #100.5
Specialty: Integer;
Effective: TFMDateTime;
LogTime: TFMDateTime;
OCList: TStringList;
DigSig: string;
ResponseList: TList;
IsIMODialog: boolean; //imo
IsEventDefaultOR: Integer;
end;
TPFSSActive = record
PFSSActive: boolean;
PFSSChecked: boolean;
end;
{ General Calls }
function AskAnotherOrder(ADialog: Integer): Boolean;
function DisplayGroupByName(const AName: string): Integer;
function DisplayGroupForDialog(const DialogName: string): Integer;
procedure IdentifyDialog(var DialogNames: TDialogNames; ADialog: Integer);
procedure LoadDialogDefinition(Dest: TList; const DialogName: string);
procedure LoadOrderPrompting(Dest: TList; ADialog: Integer);
//procedure LoadResponses(Dest: TList; const OrderID: string);
procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
//procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer); // no longer used
function OIMessage(IEN: Integer): string;
function OrderMenuStyle: Integer;
function ResolveScreenRef(const ARef: string): string;
function SubsetOfEntries(const StartFrom: string; Direction: Integer;
const XRef, GblRef, ScreenRef: string): TStrings;
function SubSetOfOrderItems(const StartFrom: string; Direction: Integer;
const XRef: string): TStrings;
function GetDefaultCopay(AnOrderID: string): String;
procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
function IsPFSSActive: boolean;
{ Quick Order Calls }
//function DisplayNameForOD(const InternalName: string): string;
function GetQuickName(const CRC: string): string;
procedure LoadQuickListForOD(Dest: TStrings; DGroup: Integer);
procedure SaveQuickListForOD(Src: TStrings; DGroup: Integer);
//procedure PutQuickName(DialogIEN: Integer; const DisplayName: string);
procedure PutQuickOrder(var NewIEN: Integer; const CRC, DisplayName: string; DGroup: Integer;
ResponseList: TList);
{ Medication Calls }
function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string;
procedure AppendMedRoutes(Dest: TStrings);
procedure CheckAuthForMeds(var x: string);
function DispenseMessage(AnIEN: Integer): string;
procedure LookupRoute(const AName: string; var ID, Abbreviation: string);
function MedIsSupply(AnIEN: Integer): Boolean;
function QuantityMessage(AnIEN: Integer): string;
function RequiresCopay(DispenseDrug: Integer): Boolean;
procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char);
function MedTypeIsIV(AnIEN: Integer): Boolean;
function ODForMedIn: TStrings;
function OIForMedIn(AnIEN: Integer): TStrings;
function ODForIVFluids: TStrings;
function ODForMedOut: TStrings;
function OIForMedOut(AnIEN: Integer): TStrings;
function RatedDisabilities: string;
//function ValidIVRate(const x: string): Boolean;
procedure ValidateIVRate(var x: string);
function ValidSchedule(const x: string; PSType: Char = 'I'): Integer;
function ValidQuantity(const x: string): Boolean;
{ Vitals Calls }
function ODForVitals: TStrings;
implementation
uses TRPCB, uOrders, uODBase;
var
uLastDispenseIEN: Integer;
uLastDispenseMsg: string;
uLastQuantityMsg: string;
uMedRoutes: TStringList;
uPFSSActive: TPFSSActive;
{ Common Internal Calls }
procedure SetupORDIALOG(AParam: TParamRecord; ResponseList: TList; IsIV: boolean = False);
const
MAX_STR_LEN = 74;
var
i,j,ALine,odIdx,piIdx : Integer;
Subs, x, ODtxt, thePI: string;
WPStrings: TStringList;
IVDuration, IVDurVal: string;
begin
piIdx := 0;
odIdx := 0;
IVDuration := '';
IVDurVal := '';
AParam.PType := list;
for j := 0 to ResponseList.Count - 1 do
begin
if TResponse(ResponseList.Items[j]).PromptID = 'SIG' then
begin
ODtxt := TResponse(ResponseList.Items[j]).EValue;
odIdx := j;
end;
if TResponse(ResponseList.Items[j]).PromptID = 'PI' then
thePI := TResponse(ResponseList.Items[j]).EValue;
if Length(Trim(thePI)) > 0 then
piIdx := Pos(thePI, ODtxt);
if piIdx > 0 then
begin
Delete(ODtxt,piIdx,Length(thePI));
TResponse(ResponseList.Items[odIdx]).EValue := ODtxt;
end;
if (IsIV and (TResponse(ResponseList.Items[j]).PromptID = 'DAYS')) then
begin
IVDuration := TResponse(ResponseList.Items[j]).EValue;
if (Length(IVDuration) > 1) then
begin
if (Pos('TOTAL',upperCase(IVDuration))>0) or (Pos('FOR',upperCase(IVDuration))>0) then continue;
if (Pos('H',upperCase(IVDuration))>0) then
begin
IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'hours';
end
else if (Pos('D',upperCase(IVDuration))>0) then
begin
IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'days';
end
else if ((Pos('ML',upperCase(IVDuration))>0) or (Pos('CC',upperCase(IVDuration))>0)) then
begin
IVDurVal := Copy(IVDuration,1,length(IVDuration)-2);
TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'ml';
end
else if (Pos('L',upperCase(IVDuration))>0) then
begin
IVDurVal := Copy(IVDuration,0,length(IVDuration)-1);
TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'L';
end;
end;
end;
end;
with AParam, ResponseList do for i := 0 to Count - 1 do
begin
with TResponse(Items[i]) do
begin
Subs := IntToStr(PromptIEN) + ',' + IntToStr(Instance);
if IValue = TX_WPTYPE then
begin
WPStrings := TStringList.Create;
try
WPStrings.Text := EValue;
LimitStringLength(WPStrings, MAX_STR_LEN);
x := 'ORDIALOG("WP",' + Subs + ')';
Mult[Subs] := x;
for ALine := 0 to WPStrings.Count - 1 do
begin
x := '"WP",' + Subs + ',' + IntToStr(ALine+1) + ',0';
Mult[x] := WPStrings[ALine];
end; {for}
finally
WPStrings.Free;
end; {try}
end
else Mult[Subs] := IValue;
end; {with TResponse}
end; {with AParam}
end;
{ Quick Order Calls }
//function DisplayNameForOD(const InternalName: string): string;
//begin
// Result := sCallV('ORWDXQ DLGNAME', [InternalName]);
//end;
function GetQuickName(const CRC: string): string;
begin
Result := sCallV('ORWDXQ GETQNAM', [CRC]);
end;
procedure LoadQuickListForOD(Dest: TStrings; DGroup: Integer);
begin
CallV('ORWDXQ GETQLST', [DGroup]);
Dest.Assign(RPCBrokerV.Results);
end;
procedure SaveQuickListForOD(Src: TStrings; DGroup: Integer);
begin
CallV('ORWDXQ PUTQLST', [DGroup, Src]);
// ignore return value for now
end;
//procedure PutQuickName(DialogIEN: Integer; const DisplayName: string);
//begin
// CallV('ORWDXQ PUTQNAM', [DialogIEN, DisplayName]);
// // ignore return value for now
//end;
procedure PutQuickOrder(var NewIEN: Integer; const CRC, DisplayName: string; DGroup: Integer;
ResponseList: TList);
begin
with RPCBrokerV do
begin
ClearParameters := True;
RemoteProcedure := 'ORWDXQ DLGSAVE';
Param[0].PType := literal;
Param[0].Value := CRC;
Param[1].PType := literal;
Param[1].Value := DisplayName;
Param[2].PType := literal;
Param[2].Value := IntToStr(DGroup);
SetupORDIALOG(Param[3], ResponseList);
CallBroker;
if Results.Count = 0 then Exit; // error creating order
NewIEN := StrToIntDef(Results[0], 0);
end;
end;
{ General Calls }
function AskAnotherOrder(ADialog: Integer): Boolean;
begin
Result := sCallV('ORWDX AGAIN', [ADialog]) = '1';
end;
function DisplayGroupByName(const AName: string): Integer;
begin
Result := StrToIntDef(sCallV('ORWDX DGNM', [AName]), 0);
end;
function DisplayGroupForDialog(const DialogName: string): Integer;
begin
Result := StrToIntDef(sCallV('ORWDX DGRP', [DialogName]),0);
end;
procedure IdentifyDialog(var DialogNames: TDialogNames; ADialog: Integer);
var
x: string;
begin
x := sCallV('ORWDXM DLGNAME', [ADialog]);
with DialogNames do
begin
Internal := Piece(x, U, 1);
Display := Piece(x, U, 2);
BaseIEN := StrToIntDef(Piece(x, U, 3), 0);
BaseName := Piece(x, U, 4);
end;
end;
procedure LoadDialogDefinition(Dest: TList; const DialogName: string);
{ loads a list of TPrompt records
Pieces: PromptID[1]^PromptIEN[2]^FmtSeq[3]^Fmt[4]^Omit[5]^Lead[6]^Trail[7]^NwLn[8]^Wrap[9]^Children[10]^IsChild[11] }
var
i: Integer;
APrompt: TPrompt;
begin
CallV('ORWDX DLGDEF', [DialogName]);
with RPCBrokerV do for i := 0 to Results.Count - 1 do
begin
APrompt := TPrompt.Create;
with APrompt do
begin
ID := Piece(Results[i], U, 1);
IEN := StrToIntDef(Piece(Results[i], U, 2), 0);
if Length(Piece(Results[i], U, 3)) > 0
then Sequence := StrToFloat(Piece(Results[i], U, 3))
else Sequence := 0;
FmtCode := Piece(Results[i], U, 4);
Omit := Piece(Results[i], U, 5);
Leading := Piece(Results[i], U, 6);
Trailing := Piece(Results[i], U, 7);
NewLine := Piece(Results[i], U, 8) = '1';
WrapWP := Piece(Results[i], U, 9) = '1';
Children := Piece(Results[i], U, 10);
IsChild := Piece(Results[i], U, 11) = '1';
end;
Dest.Add(APrompt);
end;
end;
procedure LoadOrderPrompting(Dest: TList; ADialog: Integer);
// ID^REQ^HID^PROMPT^TYPE^DOMAIN^DEFAULT^IDFLT^HELP
var
i: Integer;
DialogItem: TDialogItem;
begin
CallV('ORWDXM PROMPTS', [ADialog]);
DialogItem := nil;
with RPCBrokerV do for i := 0 to Results.Count - 1 do
begin
if CharAt(Results[i], 1) = '~' then
begin
DialogItem := TDialogItem.Create; // create a new dialog item
with DialogItem do
begin
Results[i] := Copy(Results[i], 2, Length(Results[i]));
ID := Piece(Results[i], U, 1);
Required := Piece(Results[i], U, 2) = '1';
Hidden := Piece(Results[i], U, 3) = '1';
Prompt := Piece(Results[i], U, 4);
DataType := CharAt(Piece(Results[i], U, 5), 1);
Domain := Piece(Results[i], U, 6);
EDefault := Piece(Results[i], U, 7);
IDefault := Piece(Results[i], U, 8);
HelpText := Piece(Results[i], U, 9);
CrossRef := Piece(Results[i], U, 10);
ScreenRef := Piece(Results[i], U, 11);
if Hidden then DataType := 'H'; // if hidden, use 'Hidden' type
end;
Dest.Add(DialogItem);
end;
if (CharAt(Results[i], 1) = 't') and (DialogItem <> nil) then // use last DialogItem
with DialogItem do EDefault := EDefault + Copy(Results[i], 2, Length(Results[i])) + CRLF;
end;
end;
procedure ExtractToResponses(Dest: TList; var HasObjects: boolean);
{ load a list with TResponse records, assumes source strings are in RPCBrokerV.Results }
var
i: Integer;
AResponse: TResponse;
WPContainsObjects, TxContainsObjects: boolean;
TempBroker: TStrings;
begin
i := 0;
HasObjects := FALSE;
TempBroker := TStringlist.Create;
TempBroker.Assign(RPCBrokerV.Results);
try
with TempBroker do while i < Count do
begin
if CharAt(Strings[i], 1) = '~' then
begin
AResponse := TResponse.Create;
with AResponse do
begin
PromptIEN := StrToIntDef(Piece(Copy(Strings[i], 2, 255), U, 1), 0);
Instance := StrToIntDef(Piece(Strings[i], U, 2), 0);
PromptID := Piece(Strings[i], U, 3);
Inc(i);
while (i < Count) and (CharAt(Strings[i], 1) <> '~') do
begin
if CharAt(Strings[i], 1) = 'i' then IValue := Copy(Strings[i], 2, 255);
if CharAt(Strings[i], 1) = 'e' then EValue := Copy(Strings[i], 2, 255);
if CharAt(Strings[i], 1) = 't' then
begin
if Length(EValue) > 0 then EValue := EValue + CRLF;
EValue := EValue + Copy(Strings[i], 2, 255);
IValue := TX_WPTYPE; // signals that this is a word processing field
end;
Inc(i);
end; {while i}
if IValue <> TX_WPTYPE then ExpandOrderObjects(IValue, TxContainsObjects);
ExpandOrderObjects(EValue, WPContainsObjects);
HasObjects := HasObjects or WPContainsObjects or TxContainsObjects;
Dest.Add(AResponse);
end; {with AResponse}
end; {if CharAt}
end; {With RPCBrokerV}
finally
TempBroker.Free;
end;
end;
procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
begin
CallV('ORWDX LOADRSP', [OrderID]);
ExtractToResponses(Dest, HasObjects);
end;
procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
var
i: Integer;
x, y, z: string;
begin
with RPCBrokerV do
begin
ClearParameters := True;
RemoteProcedure := 'ORWDX SAVE';
Param[0].PType := literal;
Param[0].Value := Patient.DFN; //*DFN*
Param[1].PType := literal;
Param[1].Value := IntToStr(Encounter.Provider);
Param[2].PType := literal;
(*if loc > 0 then Param[2].Value := IntToStr(Loc)
else Param[2].Value := IntToStr(Encounter.Location);*)
Param[2].Value := IntToStr(Encounter.Location);
Param[3].PType := literal;
Param[3].Value := ConstructOrder.DialogName;
Param[4].PType := literal;
Param[4].Value := IntToStr(ConstructOrder.DGroup);
Param[5].PType := literal;
Param[5].Value := IntToStr(ConstructOrder.OrderItem);
Param[6].PType := literal;
Param[6].Value := AnOrder.EditOf; // null if new order, otherwise ORIFN of original
if (ConstructOrder.DGroup = IVDisp) then
SetupORDIALOG(Param[7], ConstructOrder.ResponseList, True)
else
SetupORDIALOG(Param[7], ConstructOrder.ResponseList);
if Length(ConstructOrder.LeadText) > 0
then Param[7].Mult['"ORLEAD"'] := ConstructOrder.LeadText;
if Length(ConstructOrder.TrailText) > 0
then Param[7].Mult['"ORTRAIL"'] := ConstructOrder.TrailText;
Param[7].Mult['"ORCHECK"'] := IntToStr(ConstructOrder.OCList.Count);
with ConstructOrder do for i := 0 to OCList.Count - 1 do
begin
// put quotes around everything to prevent broker from choking
y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) +
'","' + IntToStr(i+1) + '"';
Param[7].Mult[y] := Pieces(OCList[i], U, 2, 4);
end;
if ConstructOrder.DelayEvent in ['A','D','T','M','O'] then
Param[7].Mult['"OREVENT"'] := ConstructOrder.PTEventPtr;
if ConstructOrder.LogTime > 0
then Param[7].Mult['"ORSLOG"'] := FloatToStr(ConstructOrder.LogTime);
Param[7].Mult['"ORTS"'] := IntToStr(Patient.Specialty); // pass in treating specialty for ORTS
Param[8].PType := literal;
Param[8].Value := ConstructOrder.DigSig;
if Constructorder.IsIMODialog then
begin
Param[9].PType := literal; //IMO
Param[9].Value := FloatToStr(Encounter.DateTime);
end else
begin
Param[9].PType := literal; //IMO
Param[9].Value := '';
end;
Param[10].PType := literal;
Param[10].Value := OrderSource;
Param[11].PType := literal;
Param[11].Value := IntToStr(Constructorder.IsEventDefaultOR);
CallBroker;
if Results.Count = 0 then Exit; // error creating order
x := Results[0];
Results.Delete(0);
y := '';
while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
begin
y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
Results.Delete(0);
end;
if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
z := '';
if (Results.Count > 0) and (Results[0] = '|') then
begin
Results.Delete(0);
while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
begin
z := z + Copy(Results[0], 2, Length(Results[0]));
Results.Delete(0);
end;
end;
SetOrderFields(AnOrder, x, y, z);
end;
end;
{ no longer used -
procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer);
var
i: Integer;
y: string;
begin
CallV('ORWDXM AUTOACK', [Patient.DFN, Encounter.Provider, Encounter.Location, ADialog]);
with RPCBrokerV do if Results.Count > 0 then
begin
y := '';
for i := 1 to Results.Count - 1 do
y := y + Copy(Results[i], 2, Length(Results[i])) + CRLF;
if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
SetOrderFields(AnOrder, Results[0], y);
end;
end;
}
function OIMessage(IEN: Integer): string;
begin
CallV('ORWDX MSG', [IEN]);
with RPCBrokerV.Results do SetString(Result, GetText, Length(Text));
end;
function OrderMenuStyle: Integer;
begin
Result := StrToIntDef(sCallV('ORWDXM MSTYLE', [nil]), 0);
end;
function ResolveScreenRef(const ARef: string): string;
begin
Result := sCallV('ORWDXM RSCRN', [ARef]);
end;
function SubSetOfOrderItems(const StartFrom: string; Direction: Integer;
const XRef: string): TStrings;
{ returns a pointer to a list of orderable items matching an S.xxx cross reference (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('ORWDX ORDITM', [StartFrom, Direction, XRef]);
Result := RPCBrokerV.Results;
end;
function GetDefaultCopay(AnOrderID: string): String;
begin
with RPCBrokerV do
begin
ClearParameters := True;
RemoteProcedure := 'ORWDPS4 CPLST';
Param[0].PType := literal;
Param[0].Value := Patient.DFN;
Param[1].PType := list;
Param[1].Mult['1'] := AnOrderID;
end;
CallBroker;
if RPCBrokerV.Results.Count > 0 then
Result := RPCBrokerV.Results[0]
else
Result := '';
end;
procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
var
temp,CPExems: string;
CoPayValue: array [1..7] of Char;
i: integer;
begin
// SC AO IR EC MST HNC CV
CoPayValue[1] := 'N';
CoPayValue[2] := 'N';
CoPayValue[3] := 'N';
CoPayValue[4] := 'N';
CoPayValue[5] := 'N';
CoPayValue[6] := 'N';
CoPayValue[7] := 'N';
temp := Pieces(CoPayInfo,'^',2,6);
i := 1;
while Length(Piece(temp,'^',i))>0 do
begin
if Piece(Piece(temp,'^',i),';',1) = 'SC' then
begin
if Piece( Piece(temp,'^',i),';',2) = '1' then
CoPayValue[1] := 'C'
else
CopayValue[1] := 'U';
end;
if Piece(Piece(temp,'^',i),';',1) = 'AO' then
begin
if Piece( Piece(temp,'^',i),';',2) = '1' then
CoPayValue[2] := 'C'
else
CopayValue[2] := 'U';
end;
if Piece(Piece(temp,'^',i),';',1) = 'IR' then
begin
if Piece( Piece(temp,'^',i),';',2) = '1' then
CoPayValue[3] := 'C'
else
CopayValue[3] := 'U';
end;
if Piece(Piece(temp,'^',i),';',1) = 'EC' then
begin
if Piece( Piece(temp,'^',i),';',2) = '1' then
CoPayValue[4] := 'C'
else
CopayValue[4] := 'U';
end;
if Piece(Piece(temp,'^',i),';',1) = 'MST' then
begin
if Piece( Piece(temp,'^',i),';',2) = '1' then
CoPayValue[5] := 'C'
else
CopayValue[5] := 'U';
end;
if Piece(Piece(temp,'^',i),';',1) = 'HNC' then
begin
if Piece( Piece(temp,'^',i),';',2) = '1' then
CoPayValue[6] := 'C'
else
CopayValue[6] := 'U';
end;
if Piece(Piece(temp,'^',i),';',1) = 'CV' then
begin
if Piece( Piece(temp,'^',i),';',2) = '1' then
CoPayValue[7] := 'C'
else
CopayValue[7] := 'U';
end;
i := i + 1;
end;
CPExems := CoPayValue[1] + CoPayValue[2] + CoPayValue[3] + CoPayValue[4]
+ CoPayValue[5] + CoPayValue[6] + CoPayValue[7];
CPExems := AnOrderId + '^' + CPExems;
with RPCBrokerV do
begin
ClearParameters := True;
RemoteProcedure := 'ORWDPS4 CPINFO';
Param[0].PType := list;
Param[0].Mult['1'] := CPExems;
CallBroker;
end;
end;
function SubsetOfEntries(const StartFrom: string; Direction: Integer;
const XRef, GblRef, ScreenRef: string): TStrings;
{ returns a pointer to a list of file entries (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('ORWDOR LKSCRN', [StartFrom, Direction, XRef, GblRef, ScreenRef]);
Result := RPCBrokerV.Results;
end;
procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
begin
ErrMsg := sCallV('ORWDOR VALNUM', [x, Dom]);
if ErrMsg = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
end;
function IsPFSSActive: boolean;
begin
with uPFSSActive do
if not PFSSChecked then
begin
PFSSActive := (sCallV('ORWPFSS IS PFSS ACTIVE?', [nil]) = '1');
PFSSChecked := True;
end;
Result := uPFSSActive.PFSSActive
end;
{ Medication Calls }
procedure AppendMedRoutes(Dest: TStrings);
var
i: Integer;
x: string;
begin
if uMedRoutes = nil then
begin
CallV('ORWDPS32 ALLROUTE', [nil]);
with RPCBrokerV do
begin
uMedRoutes := TStringList.Create;
uMedRoutes.Assign(Results);
for i := 0 to Results.Count - 1 do if Length(Piece(Results[i], U, 3)) > 0 then
begin
x := Piece(Results[i], U, 1) + U + Piece(Results[i], U, 3) +
' (' + Piece(Results[i], U, 2) + ')' + U + Piece(Results[i], U, 3);
uMedRoutes.Add(x);
end; {if Length}
SortByPiece(uMedRoutes, U, 2);
end; {with RPCBrokerV}
end; {if uMedRoutes}
Dest.AddStrings(uMedRoutes);
end;
procedure CheckAuthForMeds(var x: string);
begin
x := Piece(sCallV('ORWDPS32 AUTH', [Encounter.Provider]), U, 2);
end;
function DispenseMessage(AnIEN: Integer): string;
var
x: string;
begin
if AnIEN = uLastDispenseIEN then Result := uLastDispenseMsg else
begin
x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
uLastDispenseIEN := AnIEN;
uLastDispenseMsg := Piece(x, U, 1);
uLastQuantityMsg := Piece(x, U, 2);
Result := uLastDispenseMsg;
end;
end;
function QuantityMessage(AnIEN: Integer): string;
var
x: string;
begin
if AnIEN = uLastDispenseIEN then Result := uLastQuantityMsg else
begin
x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
uLastDispenseIEN := AnIEN;
uLastDispenseMsg := Piece(x, U, 1);
uLastQuantityMsg := Piece(x, U, 2);
Result := uLastQuantityMsg;
end;
end;
function RequiresCopay(DispenseDrug: Integer): Boolean;
begin
Result := sCallV('ORWDPS32 SCSTS', [Patient.DFN, DispenseDrug]) = '1';
end;
procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char);
begin
CallV('ORWDPS32 FORMALT', [AnIEN, PSType]);
AList.Assign(RPCBrokerV.Results);
end;
procedure LookupRoute(const AName: string; var ID, Abbreviation: string);
var
x: string;
begin
x := sCallV('ORWDPS32 VALROUTE', [AName]);
ID := Piece(x, U, 1);
Abbreviation := Piece(x, U, 2);
end;
function MedIsSupply(AnIEN: Integer): Boolean;
begin
Result := sCallV('ORWDPS32 ISSPLY', [AnIEN]) = '1';
end;
function MedTypeIsIV(AnIEN: Integer): Boolean;
begin
Result := sCallV('ORWDPS32 MEDISIV', [AnIEN]) = '1';
end;
function ODForMedIn: TStrings;
{ Returns init values for inpatient meds dialog. The results must be used immediately. }
begin
CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE]);
Result := RPCBrokerV.Results;
end;
function ODForIVFluids: TStrings;
{ Returns init values for IV Fluids dialog. The results must be used immediately. }
begin
CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS]);
Result := RPCBrokerV.Results;
end;
function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string;
begin
Result := sCallV('ORWDPS32 IVAMT', [AnIEN, FluidType]);
end;
function ODForMedOut: TStrings;
{ Returns init values for outpatient meds dialog. The results must be used immediately. }
begin
CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT]);
Result := RPCBrokerV.Results;
end;
function OIForMedIn(AnIEN: Integer): TStrings;
{ Returns init values for inpatient meds order item. The results must be used immediately. }
begin
CallV('ORWDPS32 OISLCT', [AnIEN, PST_UNIT_DOSE, Patient.DFN]);
Result := RPCBrokerV.Results;
end;
function OIForMedOut(AnIEN: Integer): TStrings;
{ Returns init values for outpatient meds order item. The results must be used immediately. }
begin
CallV('ORWDPS32 OISLCT', [AnIEN, PST_OUTPATIENT, Patient.DFN]);
Result := RPCBrokerV.Results;
end;
function RatedDisabilities: string;
{ Returns a list of rated disabilities, if any, for a patient }
begin
CallV('ORWPCE SCDIS', [Patient.DFN]);
Result := RPCBrokerV.Results.Text;
end;
procedure ValidateIVRate(var x: string);
begin
x := sCallV('ORWDPS32 VALRATE', [x]);
end;
//function ValidIVRate(const x: string): Boolean;
//{ returns true if the text entered as the IV rate is valid }
//begin
// Result := sCallV('ORWDPS32 VALRATE', [x]) = '1';
//end;
function ValidSchedule(const x: string; PSType: Char = 'I'): Integer;
{ returns 1 if schedule is valid, 0 if schedule is not valid, -1 pharmacy routine not there }
begin
Result := StrToIntDef(sCallV('ORWDPS32 VALSCH', [x, PSType]), -1);
end;
function ValidQuantity(const x: string): Boolean;
{ returns true if the text entered as the quantity is valid }
begin
Result := sCallV('ORWDPS32 VALQTY', [Trim(x)]) = '1';
end;
function ODForVitals: TStrings;
{ Returns init values for vitals dialog. The results must be used immediately. }
begin
CallV('ORWDOR VMSLCT', [nil]);
Result := RPCBrokerV.Results;
end;
initialization
uLastDispenseIEN := 0;
uLastDispenseMsg := '';
finalization
if uMedRoutes <> nil then uMedRoutes.Free;
end.
Reference in New Issue View Git Blame Copy Permalink