Module

UBAGlobals

Path

C:\CPRS\CPRS30\BA\UBAGlobals.pas

Last Modified

7/15/2014 3:26:34 PM

Initialization Code

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;
  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;

end.

Units Used in Interface

Name Comments
rOrders -
uConst -

Units Used in Implementation

Name Comments
fBALocalDiagnoses -
fOrdersSign -
fReview -
rCore -
rPCE -
UBAConst -
UBACore -
UBAMessages -
uCore -
uPCE -

Classes

Name Comments
TBACBStsFlagsIN Y/N/U
TBAClearedBillingRec -
TBAConsultOrderRec -
TBACopiedOrderFlags -
TBADxRecord -
TBAFactorsRec -
TBAGlobals -
TBAPLFactorsIN -
TBAPLPt Patient qualifiers
TBAPLRec Problem List Record Used To Add New DX From SignOrders Form
TBATreatmentFactorsInRec -
TBAUnsignedBillingRec -

Procedures

Name Owner Declaration Scope Comments
AddBAPCEDiag TBAGlobals procedure AddBAPCEDiag(DiagStr:string); Published This procedure is called from uPCE.pas only -- do not delete.....
AddSecondaryDx - procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string); Interfaced Add a Secondary Dx to the first open slot in DxRec, if there IS an open slot
BACopyOrder - procedure BACopyOrder(sourceOrderList: TStringList); Interfaced
BAPHII 1.3.2
BAPHII 1.3.2
 Copy source order to target order, including Dx's, Dx descriptions, Treatment Factors and Clinical Indicators
ClearBAPCEDiagList TBAGlobals procedure ClearBAPCEDiagList; Published -
CopyDxRecord - procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string); Interfaced
BAPHII 1.3.1
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.
CopyTFCIToTargetOrder - procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string); Interfaced -
CopyTreatmentFactorsDxsToCopiedOrder - procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string); Interfaced
BAPHII 1.3.2
BAPHII 1.3.2
CopyTreatmentFactorsDxsToRenewedOrder - procedure CopyTreatmentFactorsDxsToRenewedOrder; Interfaced
BAPHII 1.3.2
BAPHII 1.3.2
DestroyDxList - procedure DestroyDxList; Interfaced -
GetBADxListForOrder - procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string); Interfaced -
InitializeConsultOrderRec - procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec); Interfaced -
InitializeNewDxRec - procedure InitializeNewDxRec(var thisDxRec: TBADxRecord); Interfaced -
InitializeTFactorsInRec - procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec); Interfaced -
InitializeUnsignedOrderRec - procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec); Interfaced -
LoadPatientParams TBAPLPt procedure LoadPatientParams(AList:TstringList); Public -
PutBADxListForOrder - procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string); Interfaced
BAPHII 1.3.1
//existingRecord        //targetOrderID
RemoveOrderFromDxList - procedure RemoveOrderFromDxList(thisOrderID: string); Interfaced This routine written for CQ4589. Called from fOrdersDC.ExecuteDCOrders().
ResetOrderID - procedure ResetOrderID(fromID: string; toID: string); Interfaced -
SetBADxList - procedure SetBADxList; Interfaced -
SetBADxListForOrder - procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string); Interfaced -
SimpleAddTempDxList - procedure SimpleAddTempDxList(thisOrderID: string); Interfaced -

Functions

Name Owner Declaration Scope Comments
AllSelectedDxBlank - function AllSelectedDxBlank(const Caller: smallint) : boolean; Interfaced -
BuildProblemListDxEntry TBAPLRec function BuildProblemListDxEntry(pDxCode:string):TStringList; Public/Published StringList used to store DX Codes selected from Encounter Form
CompareOrderDx - function CompareOrderDx(const Caller: smallint) : boolean; Interfaced -
CountSelectedOrders - function CountSelectedOrders(const Caller: smallint) : smallint; Interfaced -
DiagnosesMatch - function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean; Interfaced -
FMToDateTime TBAPLRec function FMToDateTime(FMDateTime: string): TDateTime; Public/Published -
GetDxNodeIndex - function GetDxNodeIndex(thisOrderID: string) : smallint; Interfaced -
GetGMPDFN TBAPLPt function GetGMPDFN(dfn:string;name:String):string; Public/Published -
GetPatientTFactors - function GetPatientTFactors(pOrderList:TStringList): String; Interfaced -
GetPrimaryDx - function GetPrimaryDx(thisOrderID: string) : string; Interfaced
BAPHII 1.3.1
BAPHII 1.3.1
GetTFCIForOrder - function GetTFCIForOrder(thisIndex: integer) : string; Interfaced
BAPHII 1.3.2
Retrieve BA flags for 'thisOrderID', and convert them to CPRS type uSignItems.StsChar array.
IsUserNurseProvider - function IsUserNurseProvider(pUserID: int64): boolean; Interfaced HDS00003380
rpcInitPt TBAPLPt function rpcInitPt(const PatientDFN: string): TStrings ; Public DFN*
SecondaryDxFull - function SecondaryDxFull(thisOrderID: string) : boolean; Interfaced -
tempDxNodeExists - function tempDxNodeExists(thisOrderID: string) : boolean; Interfaced Returns true if a node with the specified Order ID exists, false otherwise.

Global Variables

Name Type Declaration Comments
AO UnicodeString SC,AO,IR : string; -
BAConsultDxList TStringList BAConsultDxList: TStringList; Contains dx^code^DxRequired(consults Only) selected for consults.
BAConsultPLFlags TStringList BAConsultPLFlags: TStringList; Orderid^flags contains TF's if dx is selected from Problem list and Problem had TF associated.
BACopiedOrderFlags TStringList BACopiedOrderFlags: TStringList; BAPHII 1.3.2
BADeltedOrders TStringList BADeltedOrders: TStringList; -
BADiagnosisList TStringList BADiagnosisList : TStringList; -
BAFactorsInRec TBATreatmentFactorsInRec BAFactorsInRec : TBATreatmentFactorsInRec; -
BAFactorsRec TBAFactorsRec BAFactorsRec : TBAFactorsRec; -
BAFlagsIN UnicodeString BAFlagsIN : string; -
BAFlagsOUT TStringList BAFlagsOUT : TStringList; -
BAFWarningShown Boolean BAFWarningShown: boolean; Flag used to determine if Inactive ICD Code has been shown.
BAGlobals TBAGlobals BAGlobals : TBAGlobals; -
BAHoldPrimaryDx UnicodeString BAHoldPrimaryDx : string; Used to verify primart dx has been changed.
BALocation Integer BALocation : integer; -
BANurseConsultOrders TStringList BANurseConsultOrders: TStringList; -
BAOrderID UnicodeString BAOrderID : string; -
BAOrderIDList TStringList BAOrderIDList : TStringList; -
BAOrderList TStringList BAOrderList : TStringList; -
BAPCEDiagList TStringList BAPCEDiagList : TStringList; -
BAPersonalDX Boolean BAPersonalDX: boolean; -
BAPLPt TBAPLPt BAPLPt : TBAPLPt; -
BAPLRec TBAPLRec BAPLRec : TBAPLRec; -
BAPrimaryDxChanged Boolean BAPrimaryDxChanged: boolean; -
BASelectedList TStringList BASelectedList : TStringList; Contains list of orders selected for signature.
BATFHints TStringList BATFHints : TStringList; -
BAtmpOrderList TStringList BAtmpOrderList : TStringList; -
BAUnSignedOrders TStringList BAUnSignedOrders : TStringList; OrderID^StsFlags ie., 12345^NNNNNNN
BILLING_AWARE Boolean BILLING_AWARE : boolean; -
ChangeItemOrderNum UnicodeString ChangeItemOrderNum: string; -
ClearedBillingRec TBAClearedBillingRec ClearedBillingRec : TBAClearedBillingRec; -
ConsultOrderRec TBAConsultOrderRec ConsultOrderRec : TBAConsultOrderRec; -
CV UnicodeString MST,HNC,CV,SHD,EC : string; -
Dx1 UnicodeString Dx1 : string; Used to display Dx's on fordersSign and fReview grids
Dx2 UnicodeString Dx2 : string; -
Dx3 UnicodeString Dx3 : string; -
Dx4 UnicodeString Dx4 : string; -
EC UnicodeString MST,HNC,CV,SHD,EC : string; -
globalDxRec TBADxRecord globalDxRec : TBADxRecord; -
HNC UnicodeString MST,HNC,CV,SHD,EC : string; -
i Integer i : integer; -
IR UnicodeString SC,AO,IR : string; -
MST UnicodeString MST,HNC,CV,SHD,EC : string; -
NonBillableOrderList TStringList NonBillableOrderList : TStringList; Contains reference to those selected orders that are non billable
OrderBillableList TStrings OrderBillableList : TStrings; -
OrderIDList TStringList OrderIDList : TStringList; -
OrderListSCEI TStringList OrderListSCEI : TSTringList; OrderID Exists SCEI are required.
PLFactorsIndexes TStringList PLFactorsIndexes : TStringList; -
PLlist TStringList PLlist : TStringList; -
SC UnicodeString SC,AO,IR : string; -
SHD UnicodeString MST,HNC,CV,SHD,EC : string; -
SourceOrderID UnicodeString SourceOrderID : string; BAPHII 1.3.2
TargetOrderID UnicodeString TargetOrderID : string; BAPHII 1.3.2
tempDxList TList tempDxList : TList; -
TFactors UnicodeString TFactors : string; -
UnsignedBillingRec TBAUnsignedBillingRec UnsignedBillingRec : TBAUnsignedBillingRec; -
UnsignedOrders TStringList UnsignedOrders : TStringList; List of Orders from fReview when "don't sign" action
UpdatedBAOrderList TStringList UpdatedBAOrderList: TStringList; -


Module Source

1      unit UBAGlobals;
2     
3     {$OPTIMIZATION OFF}
4     
5     {$define debug}
6     
7     interface
8     
9     uses
10      Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, rOrders;
11    
12    type
13    
14     {Problem List Record Used To Add New DX From SignOrders Form }
15     TBAPLRec = class(TObject)
16      constructor Create(PLlist:TStringList);
17       function BuildProblemListDxEntry(pDxCode:string):TStringList;
18       function FMToDateTime(FMDateTime: string): TDateTime;
19    
20     end;
21    
22     {patient qualifiers}
23     TBAPLPt=class(TObject)
24       PtVAMC:string;
25       PtDead:string;
26       PtBid:string;
27       PtServiceConnected:boolean;
28       PtAgentOrange:boolean;
29       PtRadiation:boolean;
30       PtEnvironmental:boolean;
31       PtHNC:boolean;
32       PtMST:boolean;
33       PtSHAD:boolean;
34       constructor Create(Alist:TStringList);
35       function GetGMPDFN(dfn:string;name:String):string;
36     public
37       function rpcInitPt(const PatientDFN: string): TStrings ;
38       procedure LoadPatientParams(AList:TstringList);
39    
40     end;
41    
42      TBAGlobals = class(TObject)
43      private
44         FOrderNum: string;
45        protected
46      public
47         constructor Create;
48      published
49         property  OrderNum: string read FOrderNum write FOrderNum;
50         procedure AddBAPCEDiag(DiagStr:string);
51         procedure ClearBAPCEDiagList;
52      end;
53    
54     TBADxRecord = class(TObject)
55         FExistingRecordID: string;
56         FOrderID: string;
57         FBADxCode: string; //Primary Dx
58         FBASecDx1: string; //Secondary Dx 1
59         FBASecDx2: string; //Secondary Dx 2
60         FBASecDx3: string; //Secondary Dx 3
61         FDxDescCode: string;
62         FDxDesc1: string;
63         FDxDesc2: string;
64         FDxDesc3: string;
65         FTreatmentFactors: string;
66     end;
67    
68     TBACopiedOrderFlags = class
69         OrderID: string;
70    end;
71    
72     TBATreatmentFactorsInRec = class(TObject)
73         FBAOrderID:   string;
74         FBAEligible:  string;
75         FBATFactors:  string;
76     end;
77    
78     TBAUnsignedBillingRec = class(TObject)
79         FBAOrderID:  string;
80         FBASTSFlags: string;
81         FBADxCode:   string;
82         FBASecDx1:   string;
83         FBASecDx2:   string;
84         FBASecDx3:   string;
85     end;
86    
87     TBAConsultOrderRec = class(TObject)
88        FBAOrderID:  string;
89        FBADxCode:   string;
90        FBASecDx1:   string;
91        FBASecDx2:   string;
92        FBASecDx3:   string;
93        FBATreatmentFactors: string;
94     end;
95    
96     TBAClearedBillingRec = class(TObject)
97         FBAOrderID:  string;
98         FBASTSFlags: string;
99         FBADxCode:   string;
100        FBASecDx1:   string;
101        FBASecDx2:   string;
102        FBASecDx3:   string;
103    end;
104   
105     TBAFactorsRec = class(TObject)
106        FBAFactorActive    : boolean;
107        FBAFactorSC        : string;
108        FBAFactorMST       : string;
109        FBAFactorAO        : string;
110        FBAFactorIR        : string;
111        FBAFactorEC        : string;
112        FBAFactorHNC       : string;
113        FBAFactorCV        : string;
114        FBAFactorSHAD       : string;
115     end;
116   
117     TBAPLFactorsIN = class(TOBject)
118         FPatientID         : string; // UProblems.piece 1
119         FBADxText          : string; // UProblems.piece 2
120         FBADxCode          : string; // UProblems.piece 3
121         FBASC              : string; // UProblems.piece 5
122         FBASC_YN           : string; // UProblems.piece 6
123         FBATreatFactors    : string; //(......)
124     end;
125   
126     TBACBStsFlagsIN = class(TOBject) // Y/N/U
127        CB_Sts_Flags       :string;
128     //   CB_SC              :string;
129        CB_AO              :string;
130        CB_IR              :string;
131        CB_EC              :string;
132        CB_MST             :string;
133        CB_HNC             :string;
134        CB_CV              :string;
135        CB_SHAD             :string;
136     end;
137   
138   procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string); //BAPHII 1.3.1
139   procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string); //BAPHII 1.3.1
140   function  GetPrimaryDx(thisOrderID: string) : string; //BAPHII 1.3.1
141   function  tempDxNodeExists(thisOrderID: string) : boolean;
142   function  GetDxNodeIndex(thisOrderID: string) : smallint;
143   function  DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
144   function  CountSelectedOrders(const Caller: smallint) : smallint;
145   function  CompareOrderDx(const Caller: smallint) : boolean;
146   procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
147   procedure DestroyDxList;
148   procedure SetBADxList;
149   procedure SimpleAddTempDxList(thisOrderID: string);
150   procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
151   function  AllSelectedDxBlank(const Caller: smallint) : boolean;
152   function  SecondaryDxFull(thisOrderID: string) : boolean;
153   procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
154   procedure InitializeNewDxRec(var thisDxRec:  TBADxRecord);
155   procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
156   procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
157   procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
158   procedure BACopyOrder(sourceOrderList: TStringList);  //BAPHII 1.3.2
159   procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string); //BAPHII 1.3.2
160   procedure CopyTreatmentFactorsDxsToRenewedOrder; //BAPHII 1.3.2
161   function GetTFCIForOrder(thisIndex: integer) : string; //BAPHII 1.3.2
162   procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
163   
164   procedure ResetOrderID(fromID: string; toID: string);
165   procedure RemoveOrderFromDxList(thisOrderID: string);
166   function IsUserNurseProvider(pUserID: int64): boolean;
167   function GetPatientTFactors(pOrderList:TStringList): String;
168   
169   var
170     BAGlobals         : TBAGlobals;
171     BAPLPt            : TBAPLPt;
172     BAPLRec           : TBAPLRec;
173     PLlist            : TStringList;
174     BADiagnosisList   : TStringList;
175     BALocation        : integer;
176     BAPCEDiagList     : TStringList;
177     BAOrderIDList    : TStringList;
178     tempDxList        : TList;
179     globalDxRec       : TBADxRecord;
180     UnsignedBillingRec   : TBAUnsignedBillingRec;
181     ClearedBillingRec    : TBAClearedBillingRec;
182     ConsultOrderRec      : TBAConsultOrderRec;
183     BAFactorsInRec        : TBATreatmentFactorsInRec;
184     BAFactorsRec      : TBAFactorsRec;
185     BAOrderList       : TStringList;
186     UpdatedBAOrderList: TStringList;
187     ChangeItemOrderNum: string;
188     i                 : integer;
189     OrderIDList       : TStringList;
190     OrderBillableList : TStrings;
191     BAOrderID         : string;
192     BILLING_AWARE     : boolean;
193   
194     BAtmpOrderList    : TStringList;
195     BAFlagsIN         : string;
196     BAFlagsOUT        : TStringList;
197   
198     SourceOrderID     : string; //BAPHII 1.3.2
199     TargetOrderID     : string; //BAPHII 1.3.2
200     BACopiedOrderFlags: TStringList; //BAPHII 1.3.2
201     BANurseConsultOrders: TStringList;
202   
203    // Used to display Dx's on fordersSign and fReview grids
204     Dx1               : string;
205     Dx2               : string;
206     Dx3               : string;
207     Dx4               : string;
208     TFactors          : string;
209     SC,AO,IR          : string;
210     MST,HNC,CV,SHD,EC : string;
211     PLFactorsIndexes  : TStringList;
212     BAHoldPrimaryDx   : string;     //  used to verify primart dx has been changed.
213     BAPrimaryDxChanged: boolean;
214     NonBillableOrderList : TStringList;  // contains reference to those selected orders that are non billable
215     OrderListSCEI    : TSTringList;  //   OrderID Exists SCEI are required.
216     UnsignedOrders   : TStringList;  //    List of Orders from fReview when "don't sign" action
217     BAUnSignedOrders  : TStringList;  // OrderID^StsFlags  ie., 12345^NNNNNNN
218     BATFHints        : TStringList;
219     BASelectedList   : TStringList;  //  contains list of orders selected for signature.
220     BAConsultDxList: TStringList; //  contains dx^code^DxRequired(consults Only) selected for consults.
221     BAConsultPLFlags: TStringList;  // orderid^flags contains TF's if dx is selected from Problem list and Problem had TF associated.
222     BAFWarningShown: boolean;       // flag used to determine if Inactive ICD Code has been shown.
223     BAPersonalDX:  boolean;
224     BADeltedOrders: TStringList;
225   
226   implementation
227   
228   uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore,
229     VAUtils;
230   
231   procedure RemoveOrderFromDxList(thisOrderID: string);
232   {
233     This routine written for CQ4589.  Called from fOrdersDC.ExecuteDCOrders().
234   }
235   var
236     i: integer;
237   begin
238      if tempDxList.Count > 0 then
239         for i := 0 to tempDxList.Count-1 do
240           if tempDxNodeExists(thisOrderID) then
241              if ((TBADxRecord(tempDxList[i]).FOrderID = thisOrderID) and (tempDxList[i] <> nil)) then
242                 begin
243                 //tempDxList.Items[i] := nil; //remove reference to this item, effectively deleting it from the list (see Delphi help)
244                 BACopiedOrderFlags.Clear;
245                 UBAGlobals.SourceOrderID := '';
246                 UBAGlobals.TargetOrderID := '';
247                 tempDxList.Delete(i); //remove this item from the CIDC Dx list
248                 end;
249   end;
250   
251   procedure ResetOrderID(fromID: string; toID: string);
252   var
253     i: integer;
254   begin
255      for i := 0 to tempDxList.Count-1 do
256      begin
257        if TBADxRecord(tempDxList[i]).FOrderID = fromID then
258           TBADxRecord(tempDxList[i]).FOrderID := toID;
259        end;
260   end;
261   
262   function GetTFCIForOrder(thisIndex: integer) : string;
263   {
264    Retrieve BA flags for 'thisOrderID', and convert them to CPRS type uSignItems.StsChar array.
265   }
266   begin
267     Result := BACopiedOrderFlags[thisIndex];
268   end;
269   
270   procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
271   var
272     i: integer;
273   begin
274     for i := 0 to tempDxList.Count - 1 do
275        if TBADxRecord(tempDxList[i]).FOrderID = thisTargetOrderID then
276           TBADxRecord(tempDxList[i]).FTreatmentFactors := thisCheckBoxStatus;
277   end;
278   
279   procedure BACopyOrder(sourceOrderList: TStringList);
280   { BAPHII 1.3.2
281    Copy source order to target order, including Dx's, Dx descriptions, Treatment Factors and Clinical Indicators
282   }
283   var
284     newList,rList: TStringList;
285     i: integer;
286     x: string;
287   
288   begin
289      newList := TStringList.Create;
290      rList := TSTRingList.Create;
291      newList.Clear;
292      rList.Clear;
293   
294      CopyDxRecord(UBAGlobals.SourceOrderID, UBAGlobals.TargetOrderID); //copy dx's to tempDxList record
295      newList.Add(UBAGlobals.SourceOrderID);
296      rList := rpcGetUnsignedOrdersBillingData(newList);
297   
298      if RList.Count > 0 then
299      begin
300         for i := 0 to rList.Count-1 do
301         begin
302            x := rList.Strings[i];
303            BACopiedOrderFlags.Add(TargetOrderID + '^' + Piece(x,U,2) );
304         end;
305       end
306       else
307         begin
308           BACopiedOrderFlags.Add(TargetOrderID + '^' + frmSignOrders.GetCheckBoxStatus(sourceOrderID) );
309         end;
310   end;
311   
312   procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string);
313   {
314    BAPHII 1.3.2
315   }
316   var
317      sourceOrderList: TStringList;
318      sourceOrderID: TStringList;
319      targetOrderIDLst: TStringList;
320   begin
321        //Retrieve TF's/CI's from SOURCE Order
322           sourceOrderList := TStringList.Create;
323           targetOrderIDLst := TStringList.Create;
324           sourceOrderList.Clear;
325           targetOrderIDLst.Clear;
326           sourceOrderID := TStringList.Create;
327           sourceOrderID.Clear;
328           sourceOrderID.Add(Piece(pSourceOrderID, ';', 1));
329           targetOrderIDLst.Add(pTargetOrderID);
330        { if targetORderID is not billable do not create entry in BADXRecord - List  fix HDS00003130}
331           rpcNonBillableOrders(targetOrderIDLst);
332           if IsOrderBillable(pTargetOrderID) then
333           begin
334              tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
335              BACopyOrder(sourceOrderList);
336           end;
337   end;
338   
339   procedure CopyTreatmentFactorsDxsToRenewedOrder;
340   {
341    BAPHII 1.3.2
342   }
343   var
344      sourceOrderList: TStringList;
345      sourceOrderID: TStringList;
346      targetOrderList: TStringList;
347   begin
348        //Retrieve TF's/CI's from SOURCE Order
349         sourceOrderList := TStringList.Create;
350         sourceOrderList.Clear;
351         sourceOrderID := TStringList.Create;
352         sourceOrderID.Clear;
353         targetOrderList := TStringList.Create;
354         targetOrderList.Clear;
355         sourceOrderID.Add(Piece(UBAGlobals.sourceOrderID, ';', 1));
356         { if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130}
357         rpcNonBillableOrders(targetOrderList);
358         if IsOrderBillable(UBAGLobals.TargetOrderID) then
359         begin
360            tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
361            BACopyOrder(sourceOrderList); //BAPHII 1.3.2
362         end;
363   end;
364   
365   procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string);
366   {                              //existingRecord        //targetOrderID  }
367   var
368     i: integer;
369     thisRec: TBADxRecord;
370   begin
371      if UBAGlobals.tempDxNodeExists(thisOrderID) then
372        begin
373        if Assigned(tempDxList) then
374   
375        try
376           for i := 0 to (tempDxList.Count - 1) do
377             begin
378              thisRec := TBADxRecord(tempDxList.Items[i]);
379   
380              if Assigned(thisRec) then
381                if (thisRec.FOrderID = thisOrderID) then
382                   begin
383                      thisRec.FBADxCode := thisRecord.FBADxCode;
384                      thisRec.FBASecDx1 := thisRecord.FBASecDx1;
385                      thisRec.FBASecDx2 := thisRecord.FBASecDx2;
386                      thisRec.FBASecDx3 := thisRecord.FBASecDx3;
387                      thisRec.FTreatmentFactors := thisRecord.FTreatmentFactors;
388                   end;
389              end;
390   
391        except
392           on EListError do
393              begin
394              {$ifdef debug}ShowMsg('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
395              raise;
396              end;
397        end;
398        end;
399   end;
400   
401   procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string);
402    {
403        BAPHII 1.3.1
404        Copy contents of one TBADxRecord to another.
405        If target record does NOT exist, then add it to the Dx list.
406        If target record DOES exist, then change its contents to those of source record.
407    }
408      var
409     thisRecord: TBADxRecord;
410     thatRecord: TBADxRecord;
411     billingInfo: TstringList;
412     orderList:  TStringList;
413   begin
414      thisRecord := TBADxRecord.Create;
415      thatRecord := TBADxRecord.Create;
416      billingInfo := TStringList.Create;
417      orderList   := TStringList.Create;
418      if Assigned(billingInfo) then billingInfo.Clear;
419      if Assigned(orderList) then orderList.Clear;
420   
421      if tempDxNodeExists(sourceOrderID) then
422        GetBADxListForOrder(thisRecord, sourceOrderID); //load data from source
423   
424       if not tempDxNodeExists(targetOrderID) then
425       begin
426          SimpleAddTempDxList(targetOrderID);
427          orderList.Add(sourceOrderID);
428          billingInfo := rpcRetrieveSelectedOrderInfo(orderList);
429          if billingInfo.Count > 0 then
430          begin
431              thisRecord.FBADxCode := Piece(billingInfo.Strings[0],U,4) + U +
432                                      Piece(billingInfo.Strings[0],U,3);
433              thisRecord.FBASecDx1 := Piece(billingInfo.Strings[0],U,6) + U +
434                                      Piece(billingInfo.Strings[0],U,5);
435              thisRecord.FBASecDx2 := Piece(billingInfo.Strings[0],U,8) + U +
436                                      Piece(billingInfo.Strings[0],U,7);
437              thisRecord.FBASecDx3 := Piece(billingInfo.Strings[0],U,10) + U +
438                                      Piece(billingInfo.Strings[0],U,9);
439              if thisRecord.FBADxCode = CARET then thisRecord.FBADxCode := DXREC_INIT_FIELD_VAL;
440              if thisRecord.FBASecDx1 = CARET then thisRecord.FBASecDx1 := DXREC_INIT_FIELD_VAL ;
441              if thisRecord.FBASecDx2 = CARET then thisRecord.FBASecDx2 := DXREC_INIT_FIELD_VAL ;
442              if thisRecord.FBASecDx3 = CARET then thisRecord.FBASecDx3 := DXREC_INIT_FIELD_VAL ;
443   
444          end
445          else
446              PutBADxListForOrder(thisRecord, targetOrderID);
447         //copy source data to temporary record
448          with thatRecord do
449            begin
450               FOrderID :=  targetOrderID;
451               FBADxCode := thisRecord.FBADxCode;
452               FBASecDx1 := thisRecord.FBASecDx1;
453               FBASecDx2 := thisRecord.FBASecDx2;
454               FBASecDx3 := thisRecord.FBASecDx3;
455               PutBADxListForOrder(thatRecord, targetOrderID);
456            end;
457       end;
458   end;
459   
460   
461   function GetPrimaryDx(thisOrderID: string) : string;
462   {
463   BAPHII 1.3.1
464   }
465   var
466     retVal: TBADxRecord;
467   begin
468     retVal := TBADxRecord.Create;
469     GetBADxListForOrder(retVal, thisOrderID);
470     Result := retVal.FBADxCode;
471   end;
472   
473   function AllSelectedDxBlank(const Caller: smallint) : boolean;
474   var
475     i: smallint;
476     selectedOrderID: string;
477   begin
478     Result := true;
479   
480     case Caller of
481        F_ORDERS_SIGN: begin
482                          try
483                             for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
484                                 if (frmSignOrders.clstOrders.Selected[i]) then
485                                    begin
486                                    selectedOrderID :=  TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
487                                    if (tempDxNodeExists(selectedOrderID)) then
488                                         Result := false;
489                                    end;
490                          except
491                              on EListError do
492                                begin
493                                 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
494                                 raise;
495                                end;
496                          end;
497                       end;
498        F_REVIEW:      begin
499                          try
500                             for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
501                                 if (fReview.frmReview.lstReview.Selected[i]) then
502                                    begin
503                                    selectedOrderID :=  TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID;
504                                    if tempDxNodeExists(selectedOrderID) then
505                                         Result := false;
506                                    end;
507                          except
508                              on EListError do
509                                begin
510                                 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
511                                 raise;
512                                end;
513                          end;
514                       end;
515     end; //case
516   end;
517   
518   function GetDxNodeIndex(thisOrderID: string) : smallint;
519   var
520     i: integer;
521     thisRec: TBADxRecord;
522   begin
523     Result := 0;
524   
525      if Assigned(tempDxList) then
526   
527      try
528           for i := 0 to (tempDxList.Count - 1) do
529              begin
530               thisRec := TBADxRecord(tempDxList.Items[i]);
531               if Assigned(thisRec) then
532                 if (thisRec.FOrderID = thisOrderID) then
533                    Result := i;
534               end;
535     except
536         on EListError do
537           begin
538            {$ifdef debug}ShowMsg('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
539            raise;
540           end;
541     end;
542   end;
543   
544   function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
545   var
546     i: smallint;
547   begin
548     Result := false;
549   
550     // If the number of Dx's in the lists differs, then bail
551     if (List1.Count <> List2.Count) then
552        begin
553        Result := false;
554        Exit;
555        end;
556   
557     List1.Sort;
558     List2.Sort;
559   
560     try
561        for i := 0 to (List1.Count - 1) do
562           if (List1.Strings[i] <> List2.Strings[i]) then
563              Result := false
564           else
565              Result := true;
566     except
567         on EListError do
568           begin
569            {$ifdef debug}ShowMsg('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
570            raise;
571           end;
572     end;
573   end;
574   
575   function CountSelectedOrders(const Caller: smallint) : smallint;
576   var
577     i: integer;
578     selectedOrders: smallint;
579   begin
580     selectedOrders := 0;
581   
582     // How many orders selected?
583     case Caller of
584        F_ORDERS_SIGN: begin
585                          try
586                             for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
587                                 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
588                                      Inc(selectedOrders);
589                          except
590                             on EListError do
591                                begin
592                                {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
593                                raise;
594                                end;
595                          end;
596                       end;
597        F_REVIEW:      begin
598                          try
599                             for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
600                                 if (fReview.frmReview.lstReview.Selected[i]) then
601                                      Inc(selectedOrders);
602                          except
603                             on EListError do
604                                begin
605                                {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
606                                raise;
607                                end;
608                          end;
609                       end;
610     end; //case
611   
612     Result := selectedOrders;
613   
614   end;
615   
616   function CompareOrderDx(const Caller: smallint) : boolean;
617   var
618     i: integer;
619     firstSelectedID: string;
620     thisOrderID: string;
621     firstDxRec: TBADxRecord;
622     compareDxRec: TBADxRecord;
623     thisStringList: TStringList;
624     thatStringList: TStringList;
625   begin
626     Result := false;
627     firstSelectedID := '';
628     firstDxRec := nil;
629     firstDxRec := TBADxRecord.Create;
630     thisStringList := TStringList.Create;
631     thisStringList.Clear;
632     thatStringList := TStringList.Create;
633     thatStringList.Clear;
634   
635     case Caller of
636        F_ORDERS_SIGN: begin
637                          try
638                             for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
639                                 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
640                                    begin
641                                    firstSelectedID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
642                                    Break;
643                                    end;
644                          except
645                             on EListError do
646                                begin
647                                {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
648                                raise;
649                                end;
650                          end;
651                       end;
652        F_REVIEW:      begin
653                          try
654                             for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
655                                 if (fReview.frmReview.lstReview.Selected[i]) then
656                                    begin
657                                    firstSelectedID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
658                                    Break;
659                                    end;
660                          except
661                             on EListError do
662                                begin
663                                {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
664                                raise;
665                                end;
666                          end;
667                       end;
668     end; //case
669   
670     firstDxRec := TBADxRecord.Create;
671     InitializeNewDxRec(firstDxRec);
672     GetBADxListForOrder(firstDxRec, firstSelectedID);
673   
674     // first string to compare
675     thisStringList.Add(firstDxRec.FBADxCode);
676     thisStringList.Add(firstDxRec.FBASecDx1);
677     thisStringList.Add(firstDxRec.FBASecDx2);
678     thisStringList.Add(firstDxRec.FBASecDx3);
679   
680     case Caller of
681        F_ORDERS_SIGN: begin
682                          try
683                             for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
684                                 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
685                                    begin
686                                    thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
687                                    // If order ID is same as the first selected order, then skip it
688                                    if thisOrderID = firstSelectedID then
689                                         Continue
690                                    else
691                                        begin
692                                        compareDxRec := TBADxRecord.Create;
693                                        InitializeNewDxRec(compareDxRec);
694                                        GetBADxListForOrder(compareDxRec, thisOrderID);
695   
696                                        thatStringList.Add(compareDxRec.FBADxCode);
697                                        thatStringList.Add(compareDxRec.FBASecDx1);
698                                        thatStringList.Add(compareDxRec.FBASecDx2);
699                                        thatStringList.Add(compareDxRec.FBASecDx3);
700   
701                                        if DiagnosesMatch(thisStringList, thatStringList) then
702                                            Result := true;
703                                        end;
704                                    end;
705                          except
706                             on EListError do
707                                begin
708                                {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
709                                raise;
710                                end;
711                          end;
712                       end;
713        F_REVIEW:      begin
714                          try
715                             for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
716                                 if (fReview.frmReview.lstReview.Selected[i]) then
717                                    begin
718                                    thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
719                                    // If order ID is same as the first selected order, then skip it
720                                    if thisOrderID = firstSelectedID then
721                                         Continue
722                                    else
723                                        begin
724                                        compareDxRec := TBADxRecord.Create;
725                                        InitializeNewDxRec(compareDxRec);
726                                        GetBADxListForOrder(compareDxRec, thisOrderID);
727   
728                                        thatStringList.Add(compareDxRec.FBADxCode);
729                                        thatStringList.Add(compareDxRec.FBASecDx1);
730                                        thatStringList.Add(compareDxRec.FBASecDx2);
731                                        thatStringList.Add(compareDxRec.FBASecDx3);
732   
733                                        if DiagnosesMatch(thisStringList, thatStringList) then
734                                            Result := true;
735                                        end;
736                                    end;
737                             except
738                             on EListError do
739                                begin
740                                {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
741                                raise;
742                                end;
743                             end;
744                       end;
745     end; //case
746   
747     if Assigned(thisStringList) then
748        FreeAndNil(thisStringList);
749   
750     if Assigned(thatStringList) then
751        FreeAndNil(thatStringList);
752   end;
753   
754   procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
755   var
756     i: integer;
757     thisRec: TBADxRecord;
758   begin
759      if UBAGlobals.tempDxNodeExists(thisOrderID) then
760        begin
761   
762        if Assigned(tempDxList) then
763        for i := 0 to (tempDxList.Count - 1) do
764        begin
765           thisRec := TBADxRecord(tempDxList.Items[i]);
766   
767                    if Assigned(thisRec) then
768                      if (thisRec.FOrderID = thisOrderID) then
769                         begin
770                         with thisRetVal do
771                             begin
772                                FOrderID := thisRec.FOrderID;
773                                FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
774                                FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
775                                FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
776                                FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
777                             end;
778                         end;
779                    end;
780           end;
781   end;
782   
783   procedure DestroyDxList;
784   var
785      i: integer;
786   begin
787     if Assigned(tempDxList) then
788        for i := 0 to pred(UBAGlobals.tempDxList.Count) do
789           TObject(tempDxList[i]).Free;
790   
791        tempDxList := nil;
792        FreeAndNil(tempDxList);
793   end;
794   
795   procedure SimpleAddTempDxList(thisOrderID: string);
796   var
797      tempDxRec: TBADxRecord;
798   begin
799        frmBALocalDiagnoses.LoadTempRec(tempDxRec, thisOrderID);
800        UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec));
801   end;
802   
803   procedure SetBADxList;
804   var
805     i: smallint;
806   begin
807     if not Assigned(UBAGlobals.tempDxList) then
808        begin
809        UBAGlobals.tempDxList := TList.Create;
810        UBAGlobals.tempDxList.Count := 0;
811        end
812     else
813        begin
814        //Kill the old Dx list
815        for i := 0 to pred(UBAGlobals.tempDxList.Count) do
816           TObject(UBAGlobals.tempDxList[i]).Free;
817   
818        UBAGlobals.tempDxList := nil;
819   
820        //Create new Dx list for newly selected patient
821         if not Assigned(UBAGlobals.tempDxList) then
822            begin
823            UBAGlobals.tempDxList := TList.Create;
824            UBAGlobals.tempDxList.Count := 0;
825            end;
826        end;
827   end;
828   
829   procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
830   var
831     i: integer;
832     foundRec: TBADxRecord;
833   begin
834      if UBAGlobals.tempDxNodeExists(thisOrderID) then
835        begin
836        foundRec := TBADxRecord.Create;
837   
838        if Assigned(tempDxList) then
839              try
840                for i := 0 to (tempDxList.Count - 1) do
841                   begin
842                    foundRec := TBADxRecord(tempDxList.Items[i]);
843   
844                    if Assigned(thisRec) then
845                      if (thisOrderID = foundRec.FOrderID) then
846                         begin
847                         with foundRec do
848                             begin
849                             FOrderID := thisRec.FOrderID;
850                             FBADxCode := thisRec.FBADxCode;
851                             FBASecDx1 := thisRec.FBASecDx1;
852                             FBASecDx2 := thisRec.FBASecDx2;
853                             FBASecDx3 := thisRec.FBASecDx3;
854                             PutBADxListForOrder(foundRec, thisOrderID);
855                         end;
856                         Break;
857                         end;
858                    end;
859              except
860                 on EListError do
861                    begin
862                    {$ifdef debug}ShowMsg('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
863                    raise;
864                    end;
865              end;
866        end;
867   end;
868   
869   function SecondaryDxFull(thisOrderID: string) : boolean;
870   var
871     i: integer;
872     thisRec: TBADxRecord;
873   begin
874     Result := false;
875   
876        try
877           for i := 0 to tempDxList.Count - 1 do
878              begin
879              thisRec := TBADxRecord(tempDxList.Items[i]);
880   
881              if Assigned(thisRec) then
882                  if thisRec.FOrderID = thisOrderID then
883                     begin
884                     if (thisRec.FBADxCode <> UBAConst.DXREC_INIT_FIELD_VAL) then
885                        if (thisRec.FBASecDx1 <> UBAConst.DXREC_INIT_FIELD_VAL) then
886                           if (thisRec.FBASecDx2 <> UBAConst.DXREC_INIT_FIELD_VAL) then
887                              if (thisRec.FBASecDx3 <> UBAConst.DXREC_INIT_FIELD_VAL) then
888                                 Result := true;
889                     end;
890              end;
891        except
892           on EListError do
893              begin
894              {$ifdef debug}ShowMsg('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
895              raise;
896              end;
897        end;
898   end;
899   
900   procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
901   // Add a Secondary Dx to the first open slot in DxRec, if there IS an open slot
902   var
903     thisRec: TBADxRecord;
904     i: integer;
905   begin
906   
907     try
908        for i := 0 to tempDxList.Count - 1 do
909           begin
910           thisRec := TBADxRecord(tempDxList.Items[i]);
911   
912           if thisRec.FOrderID = thisOrderID then
913              begin
914              if (thisRec.FBASecDx1 = UBAConst.DXREC_INIT_FIELD_VAL) then
915                 thisRec.FBASecDx1 := thisDxCode
916              else
917                 if (thisRec.FBASecDx2 = UBAConst.DXREC_INIT_FIELD_VAL) then
918                    thisRec.FBASecDx2 := thisDxCode
919              else
920                 if (thisRec.FBASecDx3 = UBAConst.DXREC_INIT_FIELD_VAL) then
921                    thisRec.FBASecDx3 := thisDxCode;
922              end
923           end;
924     except
925        on EListError do
926           begin
927           {$ifdef debug}ShowMsg('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
928           raise;
929           end;
930     end;
931   end;
932   
933   procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
934   begin
935     with thisDxRec do
936     begin
937        FBAOrderID   := UBAConst.DXREC_INIT_FIELD_VAL;
938        FBADxCode    := UBAConst.DXREC_INIT_FIELD_VAL;
939        FBASecDx1    := UBAConst.DXREC_INIT_FIELD_VAL;
940        FBASecDx2    := UBAConst.DXREC_INIT_FIELD_VAL;
941        FBASecDx3    := UBAConst.DXREC_INIT_FIELD_VAL;
942        FBATreatmentFactors:= UBAConst.DXREC_INIT_FIELD_VAL;
943     end;
944   end;
945   
946   
947   procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
948   begin
949     with thisDxRec do
950        begin
951        FExistingRecordID := UBAConst.DXREC_INIT_FIELD_VAL;
952        FOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
953        FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
954        FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
955        FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
956        FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
957      end;
958   end;
959   
960   procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
961   begin
962       with thisUnsignedRec do
963       begin
964          FBAOrderID    := UNSIGNED_REC_INIT_FIELD_VAL;
965          FBASTSFlags   := UNSIGNED_REC_INIT_FIELD_VAL;
966          FBADxCode     := UNSIGNED_REC_INIT_FIELD_VAL;
967          FBASecDx1     := UNSIGNED_REC_INIT_FIELD_VAL;
968          FBASecDx2     := UNSIGNED_REC_INIT_FIELD_VAL;
969          FBASecDx3     := UNSIGNED_REC_INIT_FIELD_VAL;
970     end;
971   end;
972   
973   procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
974   begin
975       with thisTFactorsRecIn do
976       begin
977          FBAOrderID     :=  UNSIGNED_REC_INIT_FIELD_VAL;
978          FBAEligible    :=  UNSIGNED_REC_INIT_FIELD_VAL;
979          FBATFactors    :=  UNSIGNED_REC_INIT_FIELD_VAL;
980       end;
981   end;
982   constructor TBAGlobals.Create;
983   begin
984     inherited Create;
985   end;
986   // This procedure is called from uPCE.pas only --  do not delete.....
987   procedure TBAGlobals.AddBAPCEDiag(DiagStr:string);
988   begin
989     if (BAPCEDiagList.Count <= 0) then
990       BAPCEDiagList.Add('^Encounter Diagnoses');
991   
992     BAPCEDiagList.Add(DiagStr);
993   end;
994   
995   procedure TBAGlobals.ClearBAPCEDiagList;
996   begin
997   
998      BAPCEDiagList.Clear;
999   end;
1000  
1001  constructor TBAPLRec.Create;
1002  begin
1003    inherited Create;
1004  end;
1005  
1006  function TBAPLRec.BuildProblemListDxEntry(pDxCode:string): TStringList;
1007  // StringList used to store DX Codes selected from Encounter Form
1008  var
1009    BADxIEN: string;
1010    BAProviderStr, BAProviderName : string;
1011    AList: TStringList;
1012  begin
1013  // Build Problem List record to be saved for selection.
1014    PLlist     := TStringList.Create;
1015    AList      := TStringList.Create;
1016    AList.Clear;
1017    PLlist.Clear;
1018    BALocation := Encounter.Location;
1019    BAProviderStr := IntToStr(Encounter.Provider);
1020    BAProviderName := Encounter.ProviderName;
1021    BADxIEN :=  sCallV('ORWDBA7 GETIEN9', [Piece(pDxCode,U,1)]);
1022    BAPLPt.LoadPatientParams(AList);
1023  
1024    //BAPLPt.PtVAMC
1025    PLlist.Add('GMPFLD(.01)='+'"' +BADxIEN+ '^'+Piece(pDxCode,U,1)+'"');
1026    PLlist.Add('GMPFLD(.03)=' +'"'+'0^' +'"');
1027    PLlist.Add('GMPFLD(.05)=' + '"' +'^'+Piece(pDxCode,U,2)+ '"');
1028    PLlist.Add('GMPFLD(.08)=' + '"'+ '^'+FloatToStr(FMToday)+'"');
1029    PLlist.Add('GMPFLD(.12)=' + '"' + 'A^ACTIVE'+ '"');
1030    PLlist.Add('GMPFLD(.13)=' + '"' + '^'+ '"');
1031    PLlist.Add('GMPFLD(1.01)=' + '"'+ Piece(pDxCode,U,2) + '"');
1032    PLlist.Add('GMPFLD(1.02)=' + '"'+'P' + '"');
1033    PLlist.Add('GMPFLD(1.03)=' + '"'+ BAProviderStr + '^'+ BAProviderName + '"');
1034    PLlist.Add('GMPFLD(1.04)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
1035    PLlist.Add('GMPFLD(1.05)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
1036    PLlist.Add('GMPFLD(1.08)=' +'"' + IntToStr(BALocation) + '^' + Encounter.LocationName + '"');
1037    PLlist.Add('GMPFLD(1.09)=' + '"'+ FloatToStr(FMToday) +'"');
1038    PLlist.Add('GMPFLD(10,0)=' + '"'+'0'+ '"');
1039    Result := PLlist;
1040    
1041  end;
1042  
1043  function TBAPLRec.FMToDateTime(FMDateTime: string): TDateTime;
1044  var
1045    x, Year: string;
1046  begin
1047    { Note: TDateTime cannot store month only or year only dates }
1048    x := FMDateTime + '0000000';
1049    if Length(x) > 12 then x := Copy(x, 1, 12);
1050    if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
1051    Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
1052    x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
1053    Result := StrToDateTime(x);
1054  end;
1055  
1056  {-------------------------- TPLPt Class ----------------------}
1057  constructor TBAPLPT.Create(Alist:TStringList);
1058  var
1059    i: integer;
1060  begin
1061    for i := 0 to AList.Count - 1 do
1062      case i of
1063        0: PtVAMC             := Copy(Alist[i],1,999);
1064        1: PtDead             := AList[i];
1065        2: PtServiceConnected := (AList[i] = '1');
1066        3: PtAgentOrange      := (AList[i] = '1');
1067        4: PtRadiation        := (AList[i] = '1');
1068        5: PtEnvironmental    := (AList[i] = '1');
1069        6: PtBID              := Alist[i];
1070        7: PtHNC              := (AList[i] = '1');
1071        8: PtMST              := (AList[i] = '1');
1072        9: PtSHAD              := (AList[i] = '1');
1073      end;
1074  end;
1075  
1076  function TBAPLPt.GetGMPDFN(dfn:string;name:string):string;
1077  begin
1078    Result := dfn + u + name + u + PtBID + u + PtDead;
1079  end;
1080  
1081  procedure TBAPLPt.LoadPatientParams(AList:TstringList);
1082  begin
1083    FastAssign(rpcInitPt(Patient.DFN), AList);
1084    BAPLPt := TBAPLPt.Create(Alist);
1085  end;
1086  
1087  function TBAPLPt.rpcInitPt(const PatientDFN: string): TStrings ;  //*DFN*
1088  begin
1089     CallV('ORQQPL INIT PT',[PatientDFN]);
1090     Result := RPCBrokerV.Results;
1091  end ;
1092  
1093  function tempDxNodeExists(thisOrderID: string) : boolean;
1094  // Returns true if a node with the specified Order ID exists, false otherwise.
1095  var
1096    i: integer;
1097    thisRec: TBADxRecord;
1098  begin
1099    Result := false;
1100    if Assigned(tempDxList) then
1101       try
1102          for i := 0 to (tempDxList.Count - 1) do
1103             begin
1104              thisRec := TBADxRecord(tempDxList.Items[i]);
1105  
1106              if Assigned(thisRec) then
1107                if (thisRec.FOrderID = thisOrderID) then
1108                   begin
1109                   Result := true;
1110                   Break;
1111                   end;
1112              end;
1113       except
1114          on EListError do
1115             begin
1116             {$ifdef debug}ShowMsg('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
1117             raise;
1118             end;
1119       end;
1120  end;
1121   // HDS00003380
1122  function IsUserNurseProvider(pUserID: int64):boolean;
1123  begin
1124     Result := False;
1125     if BILLING_AWARE then
1126     begin
1127        if (pUserID <> 0) and PersonHasKey(pUserID, 'PROVIDER') then
1128           if (uCore.User.OrderRole = OR_NURSE)  then
1129              Result := True;
1130     end;
1131  end;
1132  
1133  function GetPatientTFactors(pOrderList:TStringList):String;
1134  begin
1135     Result := '';
1136     Result := sCallV('ORWDBA1 SCLST',[Patient.DFN,pOrderList]);
1137  end;
1138  
1139  
1140  Initialization
1141    BAPrimaryDxChanged := False;
1142    BAFWarningShown    := False;
1143    BAPersonalDX       := False;
1144    BAHoldPrimaryDx      :=  DXREC_INIT_FIELD_VAL;
1145    NonBillableOrderList := TStringList.Create;
1146    BAPCEDiagList        := TStringList.Create;
1147    OrderListSCEI        := TStringList.Create;
1148    BAOrderList          := TStringList.Create;
1149    UnSignedOrders       := TStringList.Create;
1150    BAOrderIDList        := TStringList.Create;
1151    BAUnSignedOrders     := TStringList.Create;
1152    BATFHints            := TStringList.Create;
1153    BAFactorsRec         := TBAFactorsRec.Create;
1154    BAFactorsInRec       := TBATreatmentFactorsInRec.Create;
1155    BASelectedList       := TStringList.Create;
1156    PLFactorsIndexes     := TStringList.Create;
1157    BAtmpOrderList       := TStringList.Create;
1158    BACopiedOrderFlags   := TStringList.Create; //BAPHII 1.3.2
1159    OrderIDList          := TStringList.Create;
1160    BAConsultDxList      := TStringList.Create;
1161    BAConsultPLFlags     := TStringList.Create;
1162    BANurseConsultOrders := TStringList.Create;
1163    BADeltedOrders       := TStringList.Create;
1164    BAConsultDxList.Clear;
1165    NonBillableOrderList.Clear;
1166    OrderListSCEI.Clear;
1167    UnSignedOrders.Clear;
1168    BAOrderIDList.Clear;
1169    BAUnSignedOrders.Clear;
1170    BATFHints.Clear;
1171    PLFactorsIndexes.Clear;
1172    BASelectedList.Clear;
1173    BAtmpOrderList.Clear;
1174    OrderIDList.Clear;
1175    BAConsultPLFlags.Clear;
1176    BAPCEDiagList.Clear;
1177    BANurseConsultOrders.Clear;
1178    BADeltedOrders.Clear;
1179  
1180  end.

Module Calls (2 levels)


UBAGlobals
 ├uConst
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals...
 │ └UBACore
 ├fBALocalDiagnoses
 │ ├fAutoSz
 │ ├fPCELex
 │ ├uConsults
 │ ├rPCE
 │ ├UBAGlobals...
 │ ├UBACore...
 │ ├uCore...
 │ ├rCore...
 │ ├rOrders...
 │ ├fOrdersSign
 │ ├UBAConst
 │ ├UBAMessages
 │ ├fReview
 │ ├fODConsult
 │ └fFrame
 ├fOrdersSign...
 ├fReview...
 ├uCore...
 ├rCore...
 ├UBAConst
 └UBACore...

Module Called-By (2 levels)


                  UBAGlobals
                   rOrders┤ 
                   fPage┤ │ 
                   uCore┤ │ 
                 uOrders┤ │ 
                 fODBase┤ │ 
                 rODBase┤ │ 
           UBAGlobals...┤ │ 
                 UBACore┤ │ 
                  fFrame┤ │ 
                 fOrders┤ │ 
               fOCAccept┤ │ 
            fOCMonograph┤ │ 
                 uODBase┤ │ 
       fBALocalDiagnoses┤ │ 
                  fCover┤ │ 
             fOrdersSign┤ │ 
                   fMeds┤ │ 
                fProbEdt┤ │ 
               fConsults┤ │ 
         fReminderDialog┤ │ 
                   fLabs┤ │ 
                 fReview┤ │ 
            fCSRemaining┤ │ 
              uSignItems┤ │ 
               fODDietLT┤ │ 
                 rODDiet┤ │ 
            fOrdersPrint┤ │ 
           fDefaultEvent┤ │ 
            fOrdersRenew┤ │ 
                 fODDiet┤ │ 
                fOrderVw┤ │ 
               fOrdersDC┤ │ 
               fOrdersCV┤ │ 
                  fODGen┤ │ 
                fODMedIn┤ │ 
               fODMedOut┤ │ 
             fConsultAct┤ │ 
                  fODRad┤ │ 
                  fODLab┤ │ 
                fODBBank┤ │ 
                 fODMeds┤ │ 
                 fODAuto┤ │ 
                 fOMNavA┤ │ 
         fOrderSaveQuick┤ │ 
                  fOMSet┤ │ 
             fOrdersHold┤ │ 
           fOrdersUnhold┤ │ 
            fOrdersAlert┤ │ 
              fOrderFlag┤ │ 
            fOrderUnflag┤ │ 
          fOrdersRelease┤ │ 
                 fOMHTML┤ │ 
               fODMedNVA┤ │ 
fODChangeUnreleasedRenew┤ │ 
          fOrdersOnChart┤ │ 
      fOrdersEvntRelease┤ │ 
         fOrdersComplete┤ │ 
           fOrdersVerify┤ │ 
           fOrderComment┤ │ 
         fODReleaseEvent┤ │ 
              fOCSession┤ │ 
               fOrdersTS┤ │ 
              mEvntDelay┤ │ 
               fODActive┤ │ 
             fOrdersCopy┤ │ 
                fMedCopy┤ │ 
     fActivateDeactivate┤ │ 
           fOrdersRefill┤ │ 
        fODChangeEvtDisp┤ │ 
            fRenewOutMed┘ │ 
                uOrders...┤ 
                fODBase...┤ 
                UBACore...┤ 
                 fFrame...┤ 
                fOrders...┤ 
      fBALocalDiagnoses...┤ 
                   fPCELex┤ 
    fBALocalDiagnoses...┤ │ 
              fDiagnoses┤ │ 
            fPCEBaseMain┤ │ 
     fBAOptionsDiagnoses┤ │ 
              fODConsult┤ │ 
                 fODProc┤ │ 
               fEditProc┤ │ 
            fEditConsult┘ │ 
                      rPCE┤ 
              uOrders...┤ │ 
              uReminders┤ │ 
                    uPCE┤ │ 
    fBALocalDiagnoses...┤ │ 
              fPCELex...┤ │ 
         fEncounterFrame┤ │ 
              fVisitType┤ │ 
           mVisitRelated┤ │ 
           fDiagnoses...┤ │ 
         fPCEBaseMain...┤ │ 
              fProcedure┤ │ 
               fPCEOther┤ │ 
           fImmunization┤ │ 
               fSkinTest┤ │ 
              fPatientEd┤ │ 
           fHealthFactor┤ │ 
                   fExam┤ │ 
              fEncVitals┤ │ 
              mCoPayDesc┤ │ 
                  fNotes┤ │ 
                  fEncnt┤ │ 
                  fProbs┤ │ 
             fProbEdt...┤ │ 
                fProbLex┤ │ 
            fConsults...┤ │ 
                 fDCSumm┤ │ 
      fReminderDialog...┤ │ 
  fBAOptionsDiagnoses...┤ │ 
                fSurgery┤ │ 
           fODConsult...┤ │ 
              fODProc...┤ │ 
            fAddlSigners┤ │ 
            fDCSummProps┤ │ 
            fEditProc...┤ │ 
         fEditConsult...┤ │ 
                    fGAF┤ │ 
               fHFSearch┘ │ 
             fDiagnoses...┤ 
                    fPtSel┤ 
               fFrame...┤ │ 
             fPtSelOptns┤ │ 
                 fDupPts┘ │ 
            fOrdersSign...┤ 
             mCoPayDesc...┤ 
                fReview...┤ 
    fBAOptionsDiagnoses...┤ 
             uSignItems...┤ 
           fOrdersRenew...┤ 
             fODConsult...┤ 
           fEditConsult...┤ 
         fOrdersRelease...┘