1183 lines
41 KiB
Plaintext
1183 lines
41 KiB
Plaintext
|
unit UBAGlobals;
|
||
|
|
|
||
|
|
{$OPTIMIZATION OFF}
|
||
|
|
|
||
|
|
{$define debug}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, rOrders;
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{Problem List Record Used To Add New DX From SignOrders Form }
|
||
|
|
TBAPLRec = class(TObject)
|
||
|
|
constructor Create(PLlist:TStringList);
|
||
|
|
function BuildProblemListDxEntry(pDxCode:string):TStringList;
|
||
|
|
function FMToDateTime(FMDateTime: string): TDateTime;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
{patient qualifiers}
|
||
|
|
TBAPLPt=class(TObject)
|
||
|
|
PtVAMC:string;
|
||
|
|
PtDead:string;
|
||
|
|
PtBid:string;
|
||
|
|
PtServiceConnected:boolean;
|
||
|
|
PtAgentOrange:boolean;
|
||
|
|
PtRadiation:boolean;
|
||
|
|
PtEnvironmental:boolean;
|
||
|
|
PtHNC:boolean;
|
||
|
|
PtMST:boolean;
|
||
|
|
constructor Create(Alist:TStringList);
|
||
|
|
function GetGMPDFN(dfn:string;name:String):string;
|
||
|
|
public
|
||
|
|
function rpcInitPt(const PatientDFN: string): TStrings ;
|
||
|
|
procedure LoadPatientParams(AList:TstringList);
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBAGlobals = class(TObject)
|
||
|
|
private
|
||
|
|
FOrderNum: string;
|
||
|
|
protected
|
||
|
|
public
|
||
|
|
constructor Create;
|
||
|
|
published
|
||
|
|
property OrderNum: string read FOrderNum write FOrderNum;
|
||
|
|
procedure AddBAPCEDiag(DiagStr:string);
|
||
|
|
procedure ClearBAPCEDiagList;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBADxRecord = class(TObject)
|
||
|
|
FExistingRecordID: string;
|
||
|
|
FOrderID: string;
|
||
|
|
FBADxCode: string; //Primary Dx
|
||
|
|
FBASecDx1: string; //Secondary Dx 1
|
||
|
|
FBASecDx2: string; //Secondary Dx 2
|
||
|
|
FBASecDx3: string; //Secondary Dx 3
|
||
|
|
FDxDescCode: string;
|
||
|
|
FDxDesc1: string;
|
||
|
|
FDxDesc2: string;
|
||
|
|
FDxDesc3: string;
|
||
|
|
FTreatmentFactors: string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBACopiedOrderFlags = class
|
||
|
|
OrderID: string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBATreatmentFactorsInRec = class(TObject)
|
||
|
|
FBAOrderID: string;
|
||
|
|
FBAEligible: string;
|
||
|
|
FBATFactors: string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBAUnsignedBillingRec = class(TObject)
|
||
|
|
FBAOrderID: string;
|
||
|
|
FBASTSFlags: string;
|
||
|
|
FBADxCode: string;
|
||
|
|
FBASecDx1: string;
|
||
|
|
FBASecDx2: string;
|
||
|
|
FBASecDx3: string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBAConsultOrderRec = class(TObject)
|
||
|
|
FBAOrderID: string;
|
||
|
|
FBADxCode: string;
|
||
|
|
FBASecDx1: string;
|
||
|
|
FBASecDx2: string;
|
||
|
|
FBASecDx3: string;
|
||
|
|
FBATreatmentFactors: string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBAClearedBillingRec = class(TObject)
|
||
|
|
FBAOrderID: string;
|
||
|
|
FBASTSFlags: string;
|
||
|
|
FBADxCode: string;
|
||
|
|
FBASecDx1: string;
|
||
|
|
FBASecDx2: string;
|
||
|
|
FBASecDx3: string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBAFactorsRec = class(TObject)
|
||
|
|
FBAFactorActive : boolean;
|
||
|
|
FBAFactorSC : string;
|
||
|
|
FBAFactorMST : string;
|
||
|
|
FBAFactorAO : string;
|
||
|
|
FBAFactorIR : string;
|
||
|
|
FBAFactorEC : string;
|
||
|
|
FBAFactorHNC : string;
|
||
|
|
FBAFactorCV : string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBAPLFactorsIN = class(TOBject)
|
||
|
|
FPatientID : string; // UProblems.piece 1
|
||
|
|
FBADxText : string; // UProblems.piece 2
|
||
|
|
FBADxCode : string; // UProblems.piece 3
|
||
|
|
FBASC : string; // UProblems.piece 5
|
||
|
|
FBASC_YN : string; // UProblems.piece 6
|
||
|
|
FBATreatFactors : string; //(......)
|
||
|
|
end;
|
||
|
|
|
||
|
|
TBACBStsFlagsIN = class(TOBject) // Y/N/U
|
||
|
|
CB_Sts_Flags :string;
|
||
|
|
// CB_SC :string;
|
||
|
|
CB_AO :string;
|
||
|
|
CB_IR :string;
|
||
|
|
CB_EC :string;
|
||
|
|
CB_MST :string;
|
||
|
|
CB_HNC :string;
|
||
|
|
CB_CV :string;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string); //BAPHII 1.3.1
|
||
|
|
procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string); //BAPHII 1.3.1
|
||
|
|
function GetPrimaryDx(thisOrderID: string) : string; //BAPHII 1.3.1
|
||
|
|
function tempDxNodeExists(thisOrderID: string) : boolean;
|
||
|
|
function GetDxNodeIndex(thisOrderID: string) : smallint;
|
||
|
|
function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
|
||
|
|
function CountSelectedOrders(const Caller: smallint) : smallint;
|
||
|
|
function CompareOrderDx(const Caller: smallint) : boolean;
|
||
|
|
procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
|
||
|
|
procedure DestroyDxList;
|
||
|
|
procedure SetBADxList;
|
||
|
|
procedure SimpleAddTempDxList(thisOrderID: string);
|
||
|
|
procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
|
||
|
|
function AllSelectedDxBlank(const Caller: smallint) : boolean;
|
||
|
|
function SecondaryDxFull(thisOrderID: string) : boolean;
|
||
|
|
procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
|
||
|
|
procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
|
||
|
|
procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
|
||
|
|
procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
|
||
|
|
procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
|
||
|
|
procedure BACopyOrder(sourceOrderList: TStringList); //BAPHII 1.3.2
|
||
|
|
procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string); //BAPHII 1.3.2
|
||
|
|
procedure CopyTreatmentFactorsDxsToRenewedOrder; //BAPHII 1.3.2
|
||
|
|
function GetTFCIForOrder(thisIndex: integer) : string; //BAPHII 1.3.2
|
||
|
|
procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
|
||
|
|
|
||
|
|
procedure ResetOrderID(fromID: string; toID: string);
|
||
|
|
procedure RemoveOrderFromDxList(thisOrderID: string);
|
||
|
|
function IsUserNurseProvider(pUserID: int64): boolean;
|
||
|
|
function GetPatientTFactors(pOrderList:TStringList): String;
|
||
|
|
|
||
|
|
var
|
||
|
|
BAGlobals : TBAGlobals;
|
||
|
|
BAPLPt : TBAPLPt;
|
||
|
|
BAPLRec : TBAPLRec;
|
||
|
|
PLlist : TStringList;
|
||
|
|
BADiagnosisList : TStringList;
|
||
|
|
BALocation : integer;
|
||
|
|
BAPCEDiagList : TStringList;
|
||
|
|
BAOrderIDList : TStringList;
|
||
|
|
tempDxList : TList;
|
||
|
|
globalDxRec : TBADxRecord;
|
||
|
|
UnsignedBillingRec : TBAUnsignedBillingRec;
|
||
|
|
ClearedBillingRec : TBAClearedBillingRec;
|
||
|
|
ConsultOrderRec : TBAConsultOrderRec;
|
||
|
|
BAFactorsInRec : TBATreatmentFactorsInRec;
|
||
|
|
BAFactorsRec : TBAFactorsRec;
|
||
|
|
BAOrderList : TStringList;
|
||
|
|
UpdatedBAOrderList: TStringList;
|
||
|
|
ChangeItemOrderNum: string;
|
||
|
|
i : integer;
|
||
|
|
OrderIDList : TStringList;
|
||
|
|
OrderBillableList : TStrings;
|
||
|
|
BAOrderID : string;
|
||
|
|
BILLING_AWARE : boolean;
|
||
|
|
|
||
|
|
BAtmpOrderList : TStringList;
|
||
|
|
BAFlagsIN : string;
|
||
|
|
BAFlagsOUT : TStringList;
|
||
|
|
|
||
|
|
SourceOrderID : string; //BAPHII 1.3.2
|
||
|
|
TargetOrderID : string; //BAPHII 1.3.2
|
||
|
|
BACopiedOrderFlags: TStringList; //BAPHII 1.3.2
|
||
|
|
BANurseConsultOrders: TStringList;
|
||
|
|
|
||
|
|
// Used to display Dx's on fordersSign and fReview grids
|
||
|
|
Dx1 : string;
|
||
|
|
Dx2 : string;
|
||
|
|
Dx3 : string;
|
||
|
|
Dx4 : string;
|
||
|
|
TFactors : string;
|
||
|
|
SC,AO,IR : string;
|
||
|
|
MST,HNC,CV,EC : string;
|
||
|
|
PLFactorsIndexes : TStringList;
|
||
|
|
BAHoldPrimaryDx : string; // used to verify primart dx has been changed.
|
||
|
|
BAPrimaryDxChanged: boolean;
|
||
|
|
// OrdersReqDxLst : TStringList; // List of selected Orders flagged collect DX Y/N
|
||
|
|
NonBillableOrderList : TStringList; // contains reference to those selected orders that are non billable
|
||
|
|
OrderListSCEI : TSTringList; // OrderID Exists SCEI are required.
|
||
|
|
UnsignedOrders : TStringList; // List of Orders from fReview when "don't sign" action
|
||
|
|
BAUnSignedOrders : TStringList; // OrderID^StsFlags ie., 12345^NNNNNNN
|
||
|
|
BATFHints : TStringList;
|
||
|
|
BASelectedList : TStringList; // contains list of orders selected for signature.
|
||
|
|
BAConsultDxList: TStringList; // contains dx^code^DxRequired(consults Only) selected for consults.
|
||
|
|
BAConsultPLFlags: TStringList; // orderid^flags contains TF's if dx is selected from Problem list and Problem had TF associated.
|
||
|
|
BAFWarningShown: boolean; // flag used to determine if Inactive ICD Code has been shown.
|
||
|
|
BAPersonalDX: boolean;
|
||
|
|
// BAConsultOrdersRequireDx: TStringList; //orderid - if orderid exists - consult order that requires dx...
|
||
|
|
BADeltedOrders: TStringList;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore;
|
||
|
|
|
||
|
|
procedure RemoveOrderFromDxList(thisOrderID: string);
|
||
|
|
{
|
||
|
|
This routine written for CQ4589. Called from fOrdersDC.ExecuteDCOrders().
|
||
|
|
}
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
if tempDxList.Count > 0 then
|
||
|
|
for i := 0 to tempDxList.Count-1 do
|
||
|
|
if tempDxNodeExists(thisOrderID) then
|
||
|
|
if ((TBADxRecord(tempDxList[i]).FOrderID = thisOrderID) and (tempDxList[i] <> nil)) then
|
||
|
|
begin
|
||
|
|
//tempDxList.Items[i] := nil; //remove reference to this item, effectively deleting it from the list (see Delphi help)
|
||
|
|
BACopiedOrderFlags.Clear;
|
||
|
|
UBAGlobals.SourceOrderID := '';
|
||
|
|
UBAGlobals.TargetOrderID := '';
|
||
|
|
tempDxList.Delete(i); //remove this item from the CIDC Dx list
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ResetOrderID(fromID: string; toID: string);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to tempDxList.Count-1 do
|
||
|
|
begin
|
||
|
|
if TBADxRecord(tempDxList[i]).FOrderID = fromID then
|
||
|
|
TBADxRecord(tempDxList[i]).FOrderID := toID;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetTFCIForOrder(thisIndex: integer) : string;
|
||
|
|
{
|
||
|
|
Retrieve BA flags for 'thisOrderID', and convert them to CPRS type uSignItems.StsChar array.
|
||
|
|
}
|
||
|
|
begin
|
||
|
|
Result := BACopiedOrderFlags[thisIndex];
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to tempDxList.Count - 1 do
|
||
|
|
if TBADxRecord(tempDxList[i]).FOrderID = thisTargetOrderID then
|
||
|
|
TBADxRecord(tempDxList[i]).FTreatmentFactors := thisCheckBoxStatus;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure BACopyOrder(sourceOrderList: TStringList);
|
||
|
|
{ BAPHII 1.3.2
|
||
|
|
Copy source order to target order, including Dx's, Dx descriptions, Treatment Factors and Clinical Indicators
|
||
|
|
}
|
||
|
|
var
|
||
|
|
newList,rList: TStringList;
|
||
|
|
i: integer;
|
||
|
|
x: string;
|
||
|
|
|
||
|
|
begin
|
||
|
|
newList := TStringList.Create;
|
||
|
|
rList := TSTRingList.Create;
|
||
|
|
newList.Clear;
|
||
|
|
rList.Clear;
|
||
|
|
|
||
|
|
CopyDxRecord(UBAGlobals.SourceOrderID, UBAGlobals.TargetOrderID); //copy dx's to tempDxList record
|
||
|
|
newList.Add(UBAGlobals.SourceOrderID);
|
||
|
|
rList := rpcGetUnsignedOrdersBillingData(newList);
|
||
|
|
|
||
|
|
if RList.Count > 0 then
|
||
|
|
begin
|
||
|
|
for i := 0 to rList.Count-1 do
|
||
|
|
begin
|
||
|
|
x := rList.Strings[i];
|
||
|
|
BACopiedOrderFlags.Add(TargetOrderID + '^' + Piece(x,U,2) );
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
BACopiedOrderFlags.Add(TargetOrderID + '^' + frmSignOrders.GetCheckBoxStatus(sourceOrderID) );
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string);
|
||
|
|
{
|
||
|
|
BAPHII 1.3.2
|
||
|
|
}
|
||
|
|
var
|
||
|
|
sourceOrderList: TStringList;
|
||
|
|
sourceOrderID: TStringList;
|
||
|
|
targetOrderIDLst: TStringList;
|
||
|
|
begin
|
||
|
|
//Retrieve TF's/CI's from SOURCE Order
|
||
|
|
sourceOrderList := TStringList.Create;
|
||
|
|
targetOrderIDLst := TStringList.Create;
|
||
|
|
sourceOrderList.Clear;
|
||
|
|
targetOrderIDLst.Clear;
|
||
|
|
sourceOrderID := TStringList.Create;
|
||
|
|
sourceOrderID.Clear;
|
||
|
|
sourceOrderID.Add(Piece(pSourceOrderID, ';', 1));
|
||
|
|
targetOrderIDLst.Add(pTargetOrderID);
|
||
|
|
{ if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130}
|
||
|
|
rpcNonBillableOrders(targetOrderIDLst);
|
||
|
|
if IsOrderBillable(pTargetOrderID) then
|
||
|
|
begin
|
||
|
|
tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
|
||
|
|
BACopyOrder(sourceOrderList);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CopyTreatmentFactorsDxsToRenewedOrder;
|
||
|
|
{
|
||
|
|
BAPHII 1.3.2
|
||
|
|
}
|
||
|
|
var
|
||
|
|
sourceOrderList: TStringList;
|
||
|
|
sourceOrderID: TStringList;
|
||
|
|
targetOrderList: TStringList;
|
||
|
|
begin
|
||
|
|
//Retrieve TF's/CI's from SOURCE Order
|
||
|
|
sourceOrderList := TStringList.Create;
|
||
|
|
sourceOrderList.Clear;
|
||
|
|
sourceOrderID := TStringList.Create;
|
||
|
|
sourceOrderID.Clear;
|
||
|
|
targetOrderList := TStringList.Create;
|
||
|
|
targetOrderList.Clear;
|
||
|
|
sourceOrderID.Add(Piece(UBAGlobals.sourceOrderID, ';', 1));
|
||
|
|
{ if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130}
|
||
|
|
rpcNonBillableOrders(targetOrderList);
|
||
|
|
if IsOrderBillable(UBAGLobals.TargetOrderID) then
|
||
|
|
begin
|
||
|
|
tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
|
||
|
|
BACopyOrder(sourceOrderList); //BAPHII 1.3.2
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string);
|
||
|
|
{ //existingRecord //targetOrderID }
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
thisRec: TBADxRecord;
|
||
|
|
begin
|
||
|
|
if UBAGlobals.tempDxNodeExists(thisOrderID) then
|
||
|
|
begin
|
||
|
|
if Assigned(tempDxList) then
|
||
|
|
|
||
|
|
try
|
||
|
|
for i := 0 to (tempDxList.Count - 1) do
|
||
|
|
begin
|
||
|
|
thisRec := TBADxRecord(tempDxList.Items[i]);
|
||
|
|
|
||
|
|
if Assigned(thisRec) then
|
||
|
|
if (thisRec.FOrderID = thisOrderID) then
|
||
|
|
begin
|
||
|
|
thisRec.FBADxCode := thisRecord.FBADxCode;
|
||
|
|
thisRec.FBASecDx1 := thisRecord.FBASecDx1;
|
||
|
|
thisRec.FBASecDx2 := thisRecord.FBASecDx2;
|
||
|
|
thisRec.FBASecDx3 := thisRecord.FBASecDx3;
|
||
|
|
thisRec.FTreatmentFactors := thisRecord.FTreatmentFactors;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string);
|
||
|
|
{
|
||
|
|
BAPHII 1.3.1
|
||
|
|
Copy contents of one TBADxRecord to another.
|
||
|
|
If target record does NOT exist, then add it to the Dx list.
|
||
|
|
If target record DOES exist, then change its contents to those of source record.
|
||
|
|
}
|
||
|
|
var
|
||
|
|
thisRecord: TBADxRecord;
|
||
|
|
thatRecord: TBADxRecord;
|
||
|
|
billingInfo: TstringList;
|
||
|
|
orderList: TStringList;
|
||
|
|
begin
|
||
|
|
thisRecord := TBADxRecord.Create;
|
||
|
|
thatRecord := TBADxRecord.Create;
|
||
|
|
billingInfo := TStringList.Create;
|
||
|
|
orderList := TStringList.Create;
|
||
|
|
if Assigned(billingInfo) then billingInfo.Clear;
|
||
|
|
if Assigned(orderList) then orderList.Clear;
|
||
|
|
|
||
|
|
if tempDxNodeExists(sourceOrderID) then
|
||
|
|
GetBADxListForOrder(thisRecord, sourceOrderID); //load data from source
|
||
|
|
|
||
|
|
if not tempDxNodeExists(targetOrderID) then
|
||
|
|
begin
|
||
|
|
SimpleAddTempDxList(targetOrderID);
|
||
|
|
orderList.Add(sourceOrderID);
|
||
|
|
billingInfo := rpcRetrieveSelectedOrderInfo(orderList);
|
||
|
|
if billingInfo.Count > 0 then
|
||
|
|
begin
|
||
|
|
thisRecord.FBADxCode := Piece(billingInfo.Strings[0],U,4) + U +
|
||
|
|
Piece(billingInfo.Strings[0],U,3);
|
||
|
|
thisRecord.FBASecDx1 := Piece(billingInfo.Strings[0],U,6) + U +
|
||
|
|
Piece(billingInfo.Strings[0],U,5);
|
||
|
|
thisRecord.FBASecDx2 := Piece(billingInfo.Strings[0],U,8) + U +
|
||
|
|
Piece(billingInfo.Strings[0],U,7);
|
||
|
|
thisRecord.FBASecDx3 := Piece(billingInfo.Strings[0],U,10) + U +
|
||
|
|
Piece(billingInfo.Strings[0],U,9);
|
||
|
|
if thisRecord.FBADxCode = CARET then thisRecord.FBADxCode := DXREC_INIT_FIELD_VAL;
|
||
|
|
if thisRecord.FBASecDx1 = CARET then thisRecord.FBASecDx1 := DXREC_INIT_FIELD_VAL ;
|
||
|
|
if thisRecord.FBASecDx2 = CARET then thisRecord.FBASecDx2 := DXREC_INIT_FIELD_VAL ;
|
||
|
|
if thisRecord.FBASecDx3 = CARET then thisRecord.FBASecDx3 := DXREC_INIT_FIELD_VAL ;
|
||
|
|
|
||
|
|
end
|
||
|
|
else
|
||
|
|
PutBADxListForOrder(thisRecord, targetOrderID);
|
||
|
|
//copy source data to temporary record
|
||
|
|
with thatRecord do
|
||
|
|
begin
|
||
|
|
FOrderID := targetOrderID;
|
||
|
|
FBADxCode := thisRecord.FBADxCode;
|
||
|
|
FBASecDx1 := thisRecord.FBASecDx1;
|
||
|
|
FBASecDx2 := thisRecord.FBASecDx2;
|
||
|
|
FBASecDx3 := thisRecord.FBASecDx3;
|
||
|
|
PutBADxListForOrder(thatRecord, targetOrderID);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
function GetPrimaryDx(thisOrderID: string) : string;
|
||
|
|
{
|
||
|
|
BAPHII 1.3.1
|
||
|
|
}
|
||
|
|
var
|
||
|
|
retVal: TBADxRecord;
|
||
|
|
begin
|
||
|
|
retVal := TBADxRecord.Create;
|
||
|
|
GetBADxListForOrder(retVal, thisOrderID);
|
||
|
|
Result := retVal.FBADxCode;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function AllSelectedDxBlank(const Caller: smallint) : boolean;
|
||
|
|
var
|
||
|
|
i: smallint;
|
||
|
|
selectedOrderID: string;
|
||
|
|
begin
|
||
|
|
Result := true;
|
||
|
|
|
||
|
|
case Caller of
|
||
|
|
F_ORDERS_SIGN: begin
|
||
|
|
try
|
||
|
|
for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
|
||
|
|
if (frmSignOrders.clstOrders.Selected[i]) then
|
||
|
|
begin
|
||
|
|
selectedOrderID := TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
|
||
|
|
if (tempDxNodeExists(selectedOrderID)) then
|
||
|
|
Result := false;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
F_REVIEW: begin
|
||
|
|
try
|
||
|
|
for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
|
||
|
|
if (fReview.frmReview.lstReview.Selected[i]) then
|
||
|
|
begin
|
||
|
|
selectedOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID;
|
||
|
|
if tempDxNodeExists(selectedOrderID) then
|
||
|
|
Result := false;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end; //case
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetDxNodeIndex(thisOrderID: string) : smallint;
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
thisRec: TBADxRecord;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
if Assigned(tempDxList) then
|
||
|
|
|
||
|
|
try
|
||
|
|
for i := 0 to (tempDxList.Count - 1) do
|
||
|
|
begin
|
||
|
|
thisRec := TBADxRecord(tempDxList.Items[i]);
|
||
|
|
if Assigned(thisRec) then
|
||
|
|
if (thisRec.FOrderID = thisOrderID) then
|
||
|
|
Result := i;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
|
||
|
|
var
|
||
|
|
i: smallint;
|
||
|
|
begin
|
||
|
|
Result := false;
|
||
|
|
|
||
|
|
// If the number of Dx's in the lists differs, then bail
|
||
|
|
if (List1.Count <> List2.Count) then
|
||
|
|
begin
|
||
|
|
Result := false;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
List1.Sort;
|
||
|
|
List2.Sort;
|
||
|
|
|
||
|
|
try
|
||
|
|
for i := 0 to (List1.Count - 1) do
|
||
|
|
if (List1.Strings[i] <> List2.Strings[i]) then
|
||
|
|
Result := false
|
||
|
|
else
|
||
|
|
Result := true;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function CountSelectedOrders(const Caller: smallint) : smallint;
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
selectedOrders: smallint;
|
||
|
|
begin
|
||
|
|
selectedOrders := 0;
|
||
|
|
|
||
|
|
// How many orders selected?
|
||
|
|
case Caller of
|
||
|
|
F_ORDERS_SIGN: begin
|
||
|
|
try
|
||
|
|
for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
|
||
|
|
if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
|
||
|
|
Inc(selectedOrders);
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
F_REVIEW: begin
|
||
|
|
try
|
||
|
|
for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
|
||
|
|
if (fReview.frmReview.lstReview.Selected[i]) then
|
||
|
|
Inc(selectedOrders);
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end; //case
|
||
|
|
|
||
|
|
Result := selectedOrders;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
function CompareOrderDx(const Caller: smallint) : boolean;
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
firstSelectedID: string;
|
||
|
|
thisOrderID: string;
|
||
|
|
firstDxRec: TBADxRecord;
|
||
|
|
compareDxRec: TBADxRecord;
|
||
|
|
thisStringList: TStringList;
|
||
|
|
thatStringList: TStringList;
|
||
|
|
begin
|
||
|
|
Result := false;
|
||
|
|
firstSelectedID := '';
|
||
|
|
firstDxRec := nil;
|
||
|
|
firstDxRec := TBADxRecord.Create;
|
||
|
|
thisStringList := TStringList.Create;
|
||
|
|
thisStringList.Clear;
|
||
|
|
thatStringList := TStringList.Create;
|
||
|
|
thatStringList.Clear;
|
||
|
|
|
||
|
|
case Caller of
|
||
|
|
F_ORDERS_SIGN: begin
|
||
|
|
try
|
||
|
|
for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
|
||
|
|
if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
|
||
|
|
begin
|
||
|
|
firstSelectedID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
F_REVIEW: begin
|
||
|
|
try
|
||
|
|
for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
|
||
|
|
if (fReview.frmReview.lstReview.Selected[i]) then
|
||
|
|
begin
|
||
|
|
firstSelectedID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end; //case
|
||
|
|
|
||
|
|
firstDxRec := TBADxRecord.Create;
|
||
|
|
InitializeNewDxRec(firstDxRec);
|
||
|
|
GetBADxListForOrder(firstDxRec, firstSelectedID);
|
||
|
|
|
||
|
|
// first string to compare
|
||
|
|
thisStringList.Add(firstDxRec.FBADxCode);
|
||
|
|
thisStringList.Add(firstDxRec.FBASecDx1);
|
||
|
|
thisStringList.Add(firstDxRec.FBASecDx2);
|
||
|
|
thisStringList.Add(firstDxRec.FBASecDx3);
|
||
|
|
|
||
|
|
case Caller of
|
||
|
|
F_ORDERS_SIGN: begin
|
||
|
|
try
|
||
|
|
for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
|
||
|
|
if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
|
||
|
|
begin
|
||
|
|
thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
|
||
|
|
// If order ID is same as the first selected order, then skip it
|
||
|
|
if thisOrderID = firstSelectedID then
|
||
|
|
Continue
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
compareDxRec := TBADxRecord.Create;
|
||
|
|
InitializeNewDxRec(compareDxRec);
|
||
|
|
GetBADxListForOrder(compareDxRec, thisOrderID);
|
||
|
|
|
||
|
|
thatStringList.Add(compareDxRec.FBADxCode);
|
||
|
|
thatStringList.Add(compareDxRec.FBASecDx1);
|
||
|
|
thatStringList.Add(compareDxRec.FBASecDx2);
|
||
|
|
thatStringList.Add(compareDxRec.FBASecDx3);
|
||
|
|
|
||
|
|
if DiagnosesMatch(thisStringList, thatStringList) then
|
||
|
|
Result := true;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
F_REVIEW: begin
|
||
|
|
try
|
||
|
|
for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
|
||
|
|
if (fReview.frmReview.lstReview.Selected[i]) then
|
||
|
|
begin
|
||
|
|
thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
|
||
|
|
// If order ID is same as the first selected order, then skip it
|
||
|
|
if thisOrderID = firstSelectedID then
|
||
|
|
Continue
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
compareDxRec := TBADxRecord.Create;
|
||
|
|
InitializeNewDxRec(compareDxRec);
|
||
|
|
GetBADxListForOrder(compareDxRec, thisOrderID);
|
||
|
|
|
||
|
|
thatStringList.Add(compareDxRec.FBADxCode);
|
||
|
|
thatStringList.Add(compareDxRec.FBASecDx1);
|
||
|
|
thatStringList.Add(compareDxRec.FBASecDx2);
|
||
|
|
thatStringList.Add(compareDxRec.FBASecDx3);
|
||
|
|
|
||
|
|
if DiagnosesMatch(thisStringList, thatStringList) then
|
||
|
|
Result := true;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end; //case
|
||
|
|
|
||
|
|
if Assigned(thisStringList) then
|
||
|
|
FreeAndNil(thisStringList);
|
||
|
|
|
||
|
|
if Assigned(thatStringList) then
|
||
|
|
FreeAndNil(thatStringList);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
thisRec: TBADxRecord;
|
||
|
|
begin
|
||
|
|
if UBAGlobals.tempDxNodeExists(thisOrderID) then
|
||
|
|
begin
|
||
|
|
|
||
|
|
if Assigned(tempDxList) then
|
||
|
|
for i := 0 to (tempDxList.Count - 1) do
|
||
|
|
begin
|
||
|
|
thisRec := TBADxRecord(tempDxList.Items[i]);
|
||
|
|
|
||
|
|
if Assigned(thisRec) then
|
||
|
|
if (thisRec.FOrderID = thisOrderID) then
|
||
|
|
begin
|
||
|
|
with thisRetVal do
|
||
|
|
begin
|
||
|
|
FOrderID := thisRec.FOrderID;
|
||
|
|
FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
|
||
|
|
FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
|
||
|
|
FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
|
||
|
|
FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure DestroyDxList;
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
if Assigned(tempDxList) then
|
||
|
|
for i := 0 to pred(UBAGlobals.tempDxList.Count) do
|
||
|
|
TObject(tempDxList[i]).Free;
|
||
|
|
|
||
|
|
tempDxList := nil;
|
||
|
|
FreeAndNil(tempDxList);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SimpleAddTempDxList(thisOrderID: string);
|
||
|
|
var
|
||
|
|
tempDxRec: TBADxRecord;
|
||
|
|
begin
|
||
|
|
frmBALocalDiagnoses.LoadTempRec(tempDxRec, thisOrderID);
|
||
|
|
UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SetBADxList;
|
||
|
|
var
|
||
|
|
i: smallint;
|
||
|
|
begin
|
||
|
|
if not Assigned(UBAGlobals.tempDxList) then
|
||
|
|
begin
|
||
|
|
UBAGlobals.tempDxList := TList.Create;
|
||
|
|
UBAGlobals.tempDxList.Count := 0;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
//Kill the old Dx list
|
||
|
|
for i := 0 to pred(UBAGlobals.tempDxList.Count) do
|
||
|
|
TObject(UBAGlobals.tempDxList[i]).Free;
|
||
|
|
|
||
|
|
UBAGlobals.tempDxList := nil;
|
||
|
|
|
||
|
|
//Create new Dx list for newly selected patient
|
||
|
|
if not Assigned(UBAGlobals.tempDxList) then
|
||
|
|
begin
|
||
|
|
UBAGlobals.tempDxList := TList.Create;
|
||
|
|
UBAGlobals.tempDxList.Count := 0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
foundRec: TBADxRecord;
|
||
|
|
begin
|
||
|
|
if UBAGlobals.tempDxNodeExists(thisOrderID) then
|
||
|
|
begin
|
||
|
|
foundRec := TBADxRecord.Create;
|
||
|
|
|
||
|
|
if Assigned(tempDxList) then
|
||
|
|
try
|
||
|
|
for i := 0 to (tempDxList.Count - 1) do
|
||
|
|
begin
|
||
|
|
foundRec := TBADxRecord(tempDxList.Items[i]);
|
||
|
|
|
||
|
|
if Assigned(thisRec) then
|
||
|
|
if (thisOrderID = foundRec.FOrderID) then
|
||
|
|
begin
|
||
|
|
with foundRec do
|
||
|
|
begin
|
||
|
|
FOrderID := thisRec.FOrderID;
|
||
|
|
FBADxCode := thisRec.FBADxCode;
|
||
|
|
FBASecDx1 := thisRec.FBASecDx1;
|
||
|
|
FBASecDx2 := thisRec.FBASecDx2;
|
||
|
|
FBASecDx3 := thisRec.FBASecDx3;
|
||
|
|
PutBADxListForOrder(foundRec, thisOrderID);
|
||
|
|
end;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function SecondaryDxFull(thisOrderID: string) : boolean;
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
thisRec: TBADxRecord;
|
||
|
|
begin
|
||
|
|
Result := false;
|
||
|
|
|
||
|
|
try
|
||
|
|
for i := 0 to tempDxList.Count - 1 do
|
||
|
|
begin
|
||
|
|
thisRec := TBADxRecord(tempDxList.Items[i]);
|
||
|
|
|
||
|
|
if Assigned(thisRec) then
|
||
|
|
if thisRec.FOrderID = thisOrderID then
|
||
|
|
begin
|
||
|
|
if (thisRec.FBADxCode <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
||
|
|
if (thisRec.FBASecDx1 <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
||
|
|
if (thisRec.FBASecDx2 <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
||
|
|
if (thisRec.FBASecDx3 <> UBAConst.DXREC_INIT_FIELD_VAL) then
|
||
|
|
Result := true;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
|
||
|
|
// Add a Secondary Dx to the first open slot in DxRec, if there IS an open slot
|
||
|
|
var
|
||
|
|
thisRec: TBADxRecord;
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
|
||
|
|
try
|
||
|
|
for i := 0 to tempDxList.Count - 1 do
|
||
|
|
begin
|
||
|
|
thisRec := TBADxRecord(tempDxList.Items[i]);
|
||
|
|
|
||
|
|
if thisRec.FOrderID = thisOrderID then
|
||
|
|
begin
|
||
|
|
if (thisRec.FBASecDx1 = UBAConst.DXREC_INIT_FIELD_VAL) then
|
||
|
|
thisRec.FBASecDx1 := thisDxCode
|
||
|
|
else
|
||
|
|
if (thisRec.FBASecDx2 = UBAConst.DXREC_INIT_FIELD_VAL) then
|
||
|
|
thisRec.FBASecDx2 := thisDxCode
|
||
|
|
else
|
||
|
|
if (thisRec.FBASecDx3 = UBAConst.DXREC_INIT_FIELD_VAL) then
|
||
|
|
thisRec.FBASecDx3 := thisDxCode;
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
|
||
|
|
begin
|
||
|
|
with thisDxRec do
|
||
|
|
begin
|
||
|
|
FBAOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBATreatmentFactors:= UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
|
||
|
|
begin
|
||
|
|
with thisDxRec do
|
||
|
|
begin
|
||
|
|
FExistingRecordID := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
|
||
|
|
begin
|
||
|
|
with thisUnsignedRec do
|
||
|
|
begin
|
||
|
|
FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
FBASTSFlags := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
FBADxCode := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx1 := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx2 := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
FBASecDx3 := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
|
||
|
|
begin
|
||
|
|
with thisTFactorsRecIn do
|
||
|
|
begin
|
||
|
|
FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
FBAEligible := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
FBATFactors := UNSIGNED_REC_INIT_FIELD_VAL;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
constructor TBAGlobals.Create;
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
end;
|
||
|
|
// This procedure is called from uPCE.pas only -- do not delete.....
|
||
|
|
procedure TBAGlobals.AddBAPCEDiag(DiagStr:string);
|
||
|
|
begin
|
||
|
|
if (BAPCEDiagList.Count <= 0) then
|
||
|
|
BAPCEDiagList.Add('^Encounter Diagnoses');
|
||
|
|
|
||
|
|
BAPCEDiagList.Add(DiagStr);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TBAGlobals.ClearBAPCEDiagList;
|
||
|
|
begin
|
||
|
|
|
||
|
|
BAPCEDiagList.Clear;
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TBAPLRec.Create;
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TBAPLRec.BuildProblemListDxEntry(pDxCode:string): TStringList;
|
||
|
|
// StringList used to store DX Codes selected from Encounter Form
|
||
|
|
var
|
||
|
|
BADxIEN: string;
|
||
|
|
BAProviderStr, BAProviderName : string;
|
||
|
|
AList: TStringList;
|
||
|
|
begin
|
||
|
|
// Build Problem List record to be saved for selection.
|
||
|
|
PLlist := TStringList.Create;
|
||
|
|
AList := TStringList.Create;
|
||
|
|
AList.Clear;
|
||
|
|
PLlist.Clear;
|
||
|
|
BALocation := Encounter.Location;
|
||
|
|
BAProviderStr := IntToStr(Encounter.Provider);
|
||
|
|
BAProviderName := Encounter.ProviderName;
|
||
|
|
BADxIEN := sCallV('ORWDBA7 GETIEN9', [Piece(pDxCode,U,1)]);
|
||
|
|
BAPLPt.LoadPatientParams(AList);
|
||
|
|
|
||
|
|
//BAPLPt.PtVAMC
|
||
|
|
PLlist.Add('GMPFLD(.01)='+'"' +BADxIEN+ '^'+Piece(pDxCode,U,1)+'"');
|
||
|
|
PLlist.Add('GMPFLD(.03)=' +'"'+'0^' +'"');
|
||
|
|
PLlist.Add('GMPFLD(.05)=' + '"' +'^'+Piece(pDxCode,U,2)+ '"');
|
||
|
|
PLlist.Add('GMPFLD(.08)=' + '"'+ '^'+FloatToStr(FMToday)+'"');
|
||
|
|
PLlist.Add('GMPFLD(.12)=' + '"' + 'A^ACTIVE'+ '"');
|
||
|
|
PLlist.Add('GMPFLD(.13)=' + '"' + '^'+ '"');
|
||
|
|
PLlist.Add('GMPFLD(1.01)=' + '"'+ Piece(pDxCode,U,2) + '"');
|
||
|
|
PLlist.Add('GMPFLD(1.02)=' + '"'+'P' + '"');
|
||
|
|
PLlist.Add('GMPFLD(1.03)=' + '"'+ BAProviderStr + '^'+ BAProviderName + '"');
|
||
|
|
PLlist.Add('GMPFLD(1.04)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
|
||
|
|
PLlist.Add('GMPFLD(1.05)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
|
||
|
|
PLlist.Add('GMPFLD(1.08)=' +'"' + IntToStr(BALocation) + '^' + Encounter.LocationName + '"');
|
||
|
|
PLlist.Add('GMPFLD(1.09)=' + '"'+ FloatToStr(FMToday) +'"');
|
||
|
|
PLlist.Add('GMPFLD(10,0)=' + '"'+'0'+ '"');
|
||
|
|
Result := PLlist;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TBAPLRec.FMToDateTime(FMDateTime: string): TDateTime;
|
||
|
|
var
|
||
|
|
x, Year: string;
|
||
|
|
begin
|
||
|
|
{ Note: TDateTime cannot store month only or year only dates }
|
||
|
|
x := FMDateTime + '0000000';
|
||
|
|
if Length(x) > 12 then x := Copy(x, 1, 12);
|
||
|
|
if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
|
||
|
|
Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
|
||
|
|
x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
|
||
|
|
Result := StrToDateTime(x);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{-------------------------- TPLPt Class ----------------------}
|
||
|
|
constructor TBAPLPT.Create(Alist:TStringList);
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to AList.Count - 1 do
|
||
|
|
case i of
|
||
|
|
0: PtVAMC := Copy(Alist[i],1,999);
|
||
|
|
1: PtDead := AList[i];
|
||
|
|
2: PtServiceConnected := (AList[i] = '1');
|
||
|
|
3: PtAgentOrange := (AList[i] = '1');
|
||
|
|
4: PtRadiation := (AList[i] = '1');
|
||
|
|
5: PtEnvironmental := (AList[i] = '1');
|
||
|
|
6: PtBID := Alist[i];
|
||
|
|
7: PtHNC := (AList[i] = '1');
|
||
|
|
8: PtMST := (AList[i] = '1');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TBAPLPt.GetGMPDFN(dfn:string;name:string):string;
|
||
|
|
begin
|
||
|
|
Result := dfn + u + name + u + PtBID + u + PtDead;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TBAPLPt.LoadPatientParams(AList:TstringList);
|
||
|
|
begin
|
||
|
|
AList.Assign(rpcInitPt(Patient.DFN));
|
||
|
|
BAPLPt := TBAPLPt.create(Alist);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TBAPLPt.rpcInitPt(const PatientDFN: string): TStrings ; //*DFN*
|
||
|
|
begin
|
||
|
|
CallV('ORQQPL INIT PT',[PatientDFN]);
|
||
|
|
Result := RPCBrokerV.Results;
|
||
|
|
end ;
|
||
|
|
|
||
|
|
function tempDxNodeExists(thisOrderID: string) : boolean;
|
||
|
|
// Returns true if a node with the specified Order ID exists, false otherwise.
|
||
|
|
var
|
||
|
|
i: integer;
|
||
|
|
thisRec: TBADxRecord;
|
||
|
|
begin
|
||
|
|
Result := false;
|
||
|
|
if Assigned(tempDxList) then
|
||
|
|
try
|
||
|
|
for i := 0 to (tempDxList.Count - 1) do
|
||
|
|
begin
|
||
|
|
thisRec := TBADxRecord(tempDxList.Items[i]);
|
||
|
|
|
||
|
|
if Assigned(thisRec) then
|
||
|
|
if (thisRec.FOrderID = thisOrderID) then
|
||
|
|
begin
|
||
|
|
Result := true;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
on EListError do
|
||
|
|
begin
|
||
|
|
{$ifdef debug}ShowMessage('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// HDS00003380
|
||
|
|
function IsUserNurseProvider(pUserID: int64):boolean;
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
if BILLING_AWARE then
|
||
|
|
begin
|
||
|
|
if (pUserID <> 0) and PersonHasKey(pUserID, 'PROVIDER') then
|
||
|
|
if (uCore.User.OrderRole = OR_NURSE) then
|
||
|
|
Result := True;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetPatientTFactors(pOrderList:TStringList):String;
|
||
|
|
begin
|
||
|
|
Result := '';
|
||
|
|
Result := sCallV('ORWDBA1 SCLST',[Patient.DFN,pOrderList]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
Initialization
|
||
|
|
BAPrimaryDxChanged := False;
|
||
|
|
BAFWarningShown := False;
|
||
|
|
BAPersonalDX := False;
|
||
|
|
BAHoldPrimaryDx := DXREC_INIT_FIELD_VAL;
|
||
|
|
NonBillableOrderList := TStringList.Create;
|
||
|
|
BAPCEDiagList := TStringList.Create;
|
||
|
|
OrderListSCEI := TStringList.Create;
|
||
|
|
BAOrderList := TStringList.Create;
|
||
|
|
UnSignedOrders := TStringList.Create;
|
||
|
|
BAOrderIDList := TStringList.Create;
|
||
|
|
BAUnSignedOrders := TStringList.Create;
|
||
|
|
BATFHints := TStringList.Create;
|
||
|
|
BAFactorsRec := TBAFactorsRec.Create;
|
||
|
|
BAFactorsInRec := TBATreatmentFactorsInRec.Create;
|
||
|
|
BASelectedList := TStringList.Create;
|
||
|
|
PLFactorsIndexes := TStringList.Create;
|
||
|
|
BAtmpOrderList := TStringList.Create;
|
||
|
|
BACopiedOrderFlags := TStringList.Create; //BAPHII 1.3.2
|
||
|
|
OrderIDList := TStringList.Create;
|
||
|
|
BAConsultDxList := TStringList.Create;
|
||
|
|
BAConsultPLFlags := TStringList.Create;
|
||
|
|
BANurseConsultOrders := TStringList.Create;
|
||
|
|
BADeltedOrders := TStringList.Create;
|
||
|
|
// BAConsultOrdersRequireDx := TStringList.Create;
|
||
|
|
BAConsultDxList.Clear;
|
||
|
|
NonBillableOrderList.Clear;
|
||
|
|
OrderListSCEI.Clear;
|
||
|
|
UnSignedOrders.Clear;
|
||
|
|
BAOrderIDList.Clear;
|
||
|
|
BAUnSignedOrders.Clear;
|
||
|
|
BATFHints.Clear;
|
||
|
|
PLFactorsIndexes.Clear;
|
||
|
|
BASelectedList.Clear;
|
||
|
|
BAtmpOrderList.Clear;
|
||
|
|
OrderIDList.Clear;
|
||
|
|
BAConsultPLFlags.Clear;
|
||
|
|
BAPCEDiagList.Clear;
|
||
|
|
BANurseConsultOrders.Clear;
|
||
|
|
BADeltedOrders.Clear;
|
||
|
|
//BAConsultOrdersRequireDx.Clear;
|
||
|
|
|
||
|
|
end.
|
||
|
|
|
||
|
|
|
||
|
|
|