Module

UBACore

Path

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

Last Modified

7/15/2014 3:26:34 PM

Comments

.$define debug

Units Used in Interface

Name Comments
fFrame -
UBAGlobals -
uConst -

Units Used in Implementation

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

Procedures

Name Owner Declaration Scope Comments
AttachPLTFactorsToDx - procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string); Interfaced -
BALoadStsFlagsAsIs - procedure BALoadStsFlagsAsIs(StsFlagsIN: string); Interfaced This code is to handle adding Problem List(only) TF's when selected
BuildSaveUnsignedList - procedure BuildSaveUnsignedList(pOrderList: TStringList); Interfaced -
BuildTFHintRec - procedure BuildTFHintRec; Interfaced
BuildTFHintRec is meant to run once, first user of the session
  contains the information to be displayed while mouse-over in fOrdersSign and fReview.
ClearSelectedOrderDiagnoses - procedure ClearSelectedOrderDiagnoses(pOrderIDList: TStringList); Interfaced -
CompleteConsultOrderRec - procedure CompleteConsultOrderRec(pOrderID: string; pDxList: TStringList); Interfaced -
CompleteUnsignedBillingInfo - procedure CompleteUnsignedBillingInfo(pOrderList: TStringList); Interfaced -
DeleteDCOrdersFromCopiedList - procedure DeleteDCOrdersFromCopiedList(pOrderID:string); Interfaced Delete dc'd orders from BACopiedOrderList to keep things in sync.
GetBAStatus - procedure GetBAStatus(pProvider:int64; pPatientDFN: string); Interfaced -
LoadConsultOrderRec - procedure LoadConsultOrderRec(var thisRetVal: TBAConsultOrderRec; pOrderID: String; pDxList: TStringList); Interfaced -
LoadTFactorsInRec - procedure LoadTFactorsInRec(var thisRetVal: TBATreatmentFactorsInRec; pOrderID:string; pEligible: string; pTFactors:string); Global -
LoadUnsignedOrderRec - procedure LoadUnsignedOrderRec(var thisRetVal: TBAUnsignedBillingRec;UnsignedBillingInfo:string); Interfaced -
rpcBuildSCIEList - procedure rpcBuildSCIEList(pOrderList: TList); Interfaced -
rpcGetProviderPatientDaysDx - procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string); Interfaced -
rpcGetSC4Orders - procedure rpcGetSC4Orders; Interfaced Returns Eligible Treatment Factors for a given patient
rpcSaveBillingDxEntered - procedure rpcSaveBillingDxEntered; Interfaced
Save dx enteries regardless of being mandatory....
if not mandatory and user enters dx.
rpcSaveCIDCData - procedure rpcSaveCIDCData(pCIDCList: TStringList); Interfaced -
rpcSaveNurseConsultOrder - procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList); Interfaced -
rpcSetBillingAwareSwitch - procedure rpcSetBillingAwareSwitch(encProvider: int64; pPatientDFN: string); Interfaced
Returns value used to bypass Billing Aware if needed.
  turns off visual and functionality
SaveBillingData - procedure SaveBillingData(pBillingData:TStringList); Interfaced -
SaveUnsignedOrders - procedure SaveUnsignedOrders(pOrderRec:String); Interfaced -
SetTreatmentFactors - procedure SetTreatmentFactors(TFactors: string); Interfaced This code is to handle adding Problem List(only) TF's when selected
UpdateBAConsultOrderList - procedure UpdateBAConsultOrderList(pDcOrders: TStringList); Interfaced -

Functions

Name Owner Declaration Scope Comments
AddProviderPatientDaysDx - function AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList; Interfaced -
AttachDxToOrderList - function AttachDxToOrderList(pOrderList:TStringList):TStringList; Interfaced -
BADxEntered - function BADxEntered:boolean; Interfaced
Main logic to determine if dx has been entered for order that requires dx
-----------------  MAIN CIDC DX HAS BEEN ENTERED LOGIC  ---------------------------

orderStatus: integer;
BuildConsultDxRec - function BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string; Interfaced -
ConvertPIMTreatmentFactors - function ConvertPIMTreatmentFactors(pTFactors:string):string; Interfaced -
GetConsultFlags - function GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string; Interfaced -
GetUnsignedOrderFlags - function GetUnsignedOrderFlags(pOrderID: string; pFlagList: TStringList):string; Interfaced Returns STSFlags if found
IsAllOrdersNA - function IsAllOrdersNA(pOrderList:TStringList):boolean; Interfaced -
IsCIDCProvider - function IsCIDCProvider(encProvider:int64):boolean; Interfaced
Verify CIDC Master Switch and Provider is CIDC Enabled.
  Patient insurance check is bypassed.  (hds7564)
IsICD9CodeActive - function IsICD9CodeActive(ACode: string; LexApp: string; ADate:TFMDateTime = 0): boolean; Interfaced -
IsOrderBillable - function IsOrderBillable(pOrderID: string):boolean; Interfaced
UBAGlobals.NonBillableOrderList must be populated prior to calling this function.
 call   rpcNonBillableOrders to populate List.
OrderRequiresSCEI - function OrderRequiresSCEI(pOrderID :String): boolean; Interfaced -
OrdersHaveDx - function OrdersHaveDx(pOrderList:TStringList):boolean; Interfaced -
PrepOrderID - function PrepOrderID(pOrderID:String): String; Interfaced -
ProcessProblemTFactors - function ProcessProblemTFactors(pText:String):String; Interfaced
Parse string return Treatment Factors when text inlcudes multiple "(())"
HDS8409
rpcAddToPersonalDxList - function rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean; Interfaced Input example ien^code(s) = 12345^306.70^431.22
rpcDeleteFromPersonalDxList - function rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer; Interfaced -
rpcGetBAMasterSwStatus - function rpcGetBAMasterSwStatus:boolean; Interfaced -
rpcGetPersonalDxList - function rpcGetPersonalDxList(UserDUZ:int64):TStringList; Interfaced -
rpcGetTFHintData - function rpcGetTFHintData:TStringList; Interfaced -
rpcGetUnsignedOrdersBillingData - function rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList; Interfaced -
rpcIsPatientInsured - function rpcIsPatientInsured(pPatientDFN: string):boolean; Interfaced -
rpcNonBillableOrders - function rpcNonBillableOrders(pOrderList: TStringList): TStringList; Interfaced
Call made to determine if order type is billable
  if order type NOT billable, flagged with "NA".
rpcOrderRequiresDx - function rpcOrderRequiresDx(pList: TStringList):boolean; Interfaced -
rpcRetrieveSelectedOrderInfo - function rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList; Interfaced -
rpcTreatmentFactorsActive - function rpcTreatmentFactorsActive(pOrderID: string):boolean; Interfaced -
SetConsultFlags - function SetConsultFlags(pPLFactors: string;pFlagsAsIs: string):string; Interfaced
Return updated flags.
return updated flags.
StripTFactors - function StripTFactors(FactorsIN: string): string; Interfaced -
VerifyOrderIdExists - function VerifyOrderIdExists(pOrderList: TStringList): TStringList; Interfaced
Removes records without order id
loop thru CIDC records remove records with invalid orderid

Global Variables

Name Type Declaration Comments
BADxList TStringList BADxList: TStringList; -
uAddToPDl Integer uAddToPDl: integer; -
uDeleteFromPDL Integer uDeleteFromPDL: integer; -
uDxLst TStringList uDxLst: TStringList; -


Module Source

1     unit UBACore;
2     
3     {.$define debug}
4     
5     interface
6     uses
7       Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, UBAGlobals,Trpcb,
8       fFrame;
9     
10    function  rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean;
11    function  rpcGetPersonalDxList(UserDUZ:int64):TStringList;
12    function  rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer;
13    procedure rpcSaveBillingDxEntered;  // save dx enteries regardless of being mandatory....
14    function  rpcNonBillableOrders(pOrderList: TStringList): TStringList;
15    function  rpcOrderRequiresDx(pList: TStringList):boolean;
16    procedure rpcSetBillingAwareSwitch(encProvider: int64; pPatientDFN: string);
17    procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
18    procedure rpcGetSC4Orders;    // returns Eligible Treatment Factors for a given patient
19    
20    function  rpcTreatmentFactorsActive(pOrderID: string):boolean;
21    procedure rpcBuildSCIEList(pOrderList: TList);
22    function  rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList;
23    function  rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList;
24    function  rpcGetTFHintData:TStringList;
25    procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
26    function  rpcGetBAMasterSwStatus:boolean;
27    procedure rpcSaveCIDCData(pCIDCList: TStringList);
28    function  rpcIsPatientInsured(pPatientDFN: string):boolean;
29    
30    procedure SaveBillingData(pBillingData:TStringList);
31    function  OrdersHaveDx(pOrderList:TStringList):boolean;
32    procedure SetTreatmentFactors(TFactors: string);
33    function  AttachDxToOrderList(pOrderList:TStringList):TStringList;
34    procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);
35    procedure BALoadStsFlagsAsIs(StsFlagsIN: string);
36    function  BADxEntered:boolean;  //  main logic to determine if dx has been entered for order that requires dx
37    function  StripTFactors(FactorsIN: string): string;
38    function  AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList;
39    function  IsOrderBillable(pOrderID: string):boolean;
40    
41    function  OrderRequiresSCEI(pOrderID :String): boolean;
42    procedure SaveUnsignedOrders(pOrderRec:String);
43    
44    procedure CompleteUnsignedBillingInfo(pOrderList: TStringList);
45    procedure BuildSaveUnsignedList(pOrderList: TStringList);
46    procedure LoadUnsignedOrderRec(var thisRetVal: TBAUnsignedBillingRec;UnsignedBillingInfo:string);
47    function  GetUnsignedOrderFlags(pOrderID: string; pFlagList: TStringList):string;  // returns STSFlags if found
48    procedure BuildTFHintRec;
49    function  IsAllOrdersNA(pOrderList:TStringList):boolean;
50    function  PrepOrderID(pOrderID:String): String;
51    procedure ClearSelectedOrderDiagnoses(pOrderIDList: TStringList);
52    procedure LoadConsultOrderRec(var thisRetVal: TBAConsultOrderRec; pOrderID: String; pDxList: TStringList);
53    procedure CompleteConsultOrderRec(pOrderID: string; pDxList: TStringList);
54    function  GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string;
55    function  SetConsultFlags(pPLFactors: string;pFlagsAsIs: string):string; //  return updated flags.
56    procedure GetBAStatus(pProvider:int64; pPatientDFN: string);
57    function  IsICD9CodeActive(ACode: string; LexApp: string; ADate:TFMDateTime = 0): boolean;
58    function  BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string;
59    function  ConvertPIMTreatmentFactors(pTFactors:string):string;
60    procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
61    procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
62    function  VerifyOrderIdExists(pOrderList: TStringList): TStringList; // removes records without order id
63    function  IsCIDCProvider(encProvider:int64):boolean;
64    function  ProcessProblemTFactors(pText:String):String;
65    
66    var
67      uAddToPDl: integer;
68      uDeleteFromPDL: integer;
69      uDxLst: TStringList;
70      BADxList: TStringList;
71    
72    implementation
73    
74    uses fBALocalDiagnoses, fOrdersSign, fReview, rOrders, uCore, rCore, rPCE,uPCE,
75         UBAConst, UBAMessages, uSignItems;
76    
77    
78    // -----------------  MAIN CIDC DX HAS BEEN ENTERED LOGIC  ---------------------------
79    function BADxEntered:boolean;
80    var
81      i: integer;
82      //orderStatus: integer;
83      x: string;
84      passList: TStringList;
85      holdOrderList: TStringList;
86      thisOrderID: string;
87      thisRec: string;
88    begin
89     //  Result := TRUE;   // caused hint.....
90       holdOrderList := TStringList.Create;
91       holdOrderList.Clear;
92       updatedBAOrderList := TStringList.Create;
93       updatedBAOrderList.Clear;
94       passList := TStringList.Create;
95       passList.Clear;
96       // determine which orders require a dx (lrmp- only)
97       // if NO then continue
98       // if YES, check BADxList for orders with DX enteries.
99       // if ok then create data string pass to M via RPC
100   
101     for i := 0 to BAOrderList.Count-1 do
102     begin
103        thisRec := BAOrderList.Strings[i];
104        thisOrderID := piece(thisRec,';',1) + ';1';  //rebuild orderID pass to M.
105        x := BAOrderList.Strings[i];
106        //orderStatus := StrToInt(CharAt(Piece(x, ';', 2), 1));  //  Order Status 1=OK, 2=DISCONTINUE
107       if IsOrderBillable(thisOrderID) then
108        begin
109           passList.Add(piece(x,';',1));
110           holdOrderList.Add(x);//  place holder for orders that can be signed!
111        end;
112     end;
113   
114      FastAssign(holdOrderList, BAOrderList); //assign signable orders to BAOrderList for further processing
115      holdOrderList.Clear; // CQ5025
116   
117       //call with passList determine if LRMP
118        if rpcOrderRequiresDx(passList) then
119         FastAssign(updatedBAOrderList, BAOrderList);
120   
121       // check of all orders dx columns are flagged with N/A.....
122       if UBACore.IsAllOrdersNA(BAOrderList) then
123       begin
124          Result := TRUE;              //  force true, no record needs DX entry
125          Exit;                        //to do.  clean this up... when time permitts
126       end
127       else
128         begin
129         if OrdersHaveDx(UBAGlobals.BAOrderList) then
130         begin
131            Result := True; // CIDC orders have dx
132            SaveBillingData(UBAGlobals.BAOrderList) ;
133         end
134         else
135            begin
136               Result := FALSE;
137               Exit;
138            end;
139        end;
140   end;
141   
142   
143   function rpcOrderRequiresDx(pList: TStringList):boolean;
144   var x: string;
145       i,j: integer;
146       returnList, updatedList: TStringList;
147      begin
148       Result := FALSE;  // initial set dx NOT required
149       returnList := TStringList.Create;
150       updatedList := TStringList.Create;
151       returnList.Clear;
152       updatedList.Clear;
153       // remove deleted orderid's
154       if UBAGlobals.BADeltedOrders.Count > 0 then
155       begin
156          for i := 0 to UBAGlobals.BADeltedOrders.Count-1 do
157             x := UBAGlobals.BADeltedOrders.Strings[i];
158            for j := 0 to pList.Count-1 do
159            begin
160               if x = pList.Strings[j] then
161                 continue   // orderid is removed.. or skipped
162               else
163                  updatedList.Add(x);
164            end;
165       end
166       else
167          FastAssign(pList, updatedList);
168   
169       // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
170       tCallV(returnList,'ORWDBA1 ORPKGTYP',[updatedList]);
171   
172        //Remove NON LRMP orders from the mix(when checking for dx entry);
173        // BAOrderList and pList are in sync - order id....
174        for i := 0 to BAOrderList.Count-1 do
175        begin
176           x:= piece(returnList.Strings[i],'^',1);
177           if x = BILLABLE_ORDER  then
178           begin
179              updatedBAOrderList.Add(BAOrderList[i]);
180              Result := TRUE;
181           end;
182       end;
183   end;
184   
185   
186   // UBAGlobals.NonBillableOrderList must be populated prior to calling this function.
187   // call   rpcNonBillableOrders to populate List.
188   function IsOrderBillable(pOrderID: string):boolean ;
189   var
190     i: integer;
191     currOrderID: string;
192     matchOrderID : string;
193   
194   begin
195     Result := TRUE;    //  = Billable
196     currOrderID := PrepOrderID(pOrderID);
197     if Piece(pOrderID,';',2) = DISCONTINUED_ORDER THEN
198     begin
199        Result := FALSE;
200        Exit;
201     end;
202     try
203        for i := 0 to UBAGlobals.NonBillableOrderList.Count -1 do
204        begin
205           matchOrderID := PrepOrderID( (Piece(UBAGlobals.NonBillableOrderList.Strings[i],U,1)) );
206           if currOrderID = matchOrderID  then
207           begin
208              Result := FALSE;  //= Non Billable
209              Exit;
210           end;
211        end;
212     except
213        on EListError do
214           begin
215           {$ifdef debug}Show508Message('EListError in UBACore.IsOrderBillable()');{$endif}
216           raise;
217           end;
218     end;
219   end;
220   
221   
222   procedure SaveBillingData(pBillingData:TStringList);
223   var
224     RecsToSave: TStringList;
225   begin
226     RecsToSave := TStringList.Create;
227     RecsToSave.Clear;
228   
229     RecsToSave := AttachDxToOrderList(pBillingData); //call with new Biling data, return-code returned
230     rpcSaveCIDCData(RecsToSave);  // verify and save billing data
231   
232     if Assigned(UBAGlobals.BAOrderList) then UBAGlobals.BAOrderList.Clear; // hds00005025
233   end;
234   
235   function rpcTreatmentFactorsActive(pOrderID:string): boolean;
236   var x: string;
237       i: integer;
238       pList: TStringList;
239       rList: TStringList;
240      begin
241         pList := TStringList.Create;
242         rList := TStringList.Create;
243         rList.Clear;
244         rList := nil;
245         pList.Clear;
246         pList.Add(pOrderID);
247         Result := FALSE;
248        // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
249         tCallV(rList,'ORWDBA1 ORPKGTYP',[pList]);
250        //returns boolean value by OrderID - True = billable
251        for i := 0 to rList.Count-1 do
252        begin
253           x := rList[i];
254           if rList[i] = BILLABLE_ORDER then
255           begin
256              Result := True;
257           end;
258        end;
259   end;
260   
261   
262   function AttachDxToOrderList(pOrderList:TStringList):TStringList;
263   var
264     i: integer;
265     newBillingList: TStringList;
266     baseDxRec: TBADxRecord;
267     currentOrderID: string;
268     currentOrderString: string;
269     dxString,FlagsStatsIn: string;
270   
271   begin
272      newBillingList:= TStringList.Create;
273      newBillingList.Clear;
274      dxString := '';
275      baseDxRec := nil;
276      baseDxRec := TBADxRecord.Create;
277   
278     InitializeNewDxRec(baseDxRec);
279     for i := 0 to pOrderList.Count-1 do
280     begin
281        currentOrderString := pOrderList.Strings[i];
282        currentOrderID := piece(pOrderList.Strings[i],';',1)+ ';1';
283   
284        GetBADxListForOrder(baseDxRec, currentOrderID);
285        FlagsStatsIn := BAFlagsIN;
286        dxString := currentOrderString + '^' + piece(baseDxRec.FBADxCode,':',2);
287        if baseDxRec.FBASecDx1 <> '' then
288           dxString := dxString + '^' + piece(baseDxRec.FBASecDx1,':',2);
289        if baseDxRec.FBASecDx2 <> '' then
290           dxString := dxString + '^' + piece(baseDxRec.FBASecDx2,':',2);
291        if baseDxRec.FBASecDx3 <> '' then
292           dxString := dxString + '^' + piece(baseDxRec.FBASecDx3,':',2);
293   
294        NewBillingList.Add(dxString);
295        InitializeNewDxRec(baseDxRec);  //HDS00004744
296     end;
297     Result := NewBillingList;
298   end;
299   
300   function  rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean;
301   //input example ien^code(s) = 12345^306.70^431.22
302   begin
303      Result := (sCallV('ORWDBA2 ADDPDL', [UserDUZ,DxCodes])= '1');
304   end;
305   
306   function rpcGetPersonalDxList(UserDUZ:int64):TStringList;
307   var
308   tmplst: TStringList;
309   begin
310       tmplst := TStringList.Create;
311       tmplst.clear;
312       tCallV(tmplst, 'ORWDBA2 GETPDL', [UserDUZ]);
313       Result := tmplst;
314   end;
315   
316   function  rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer;
317   begin
318       uDeleteFromPDL := StrToIntDef(sCallV('ORWDBA2 DELPDL', [UserDUZ,Dest]), 0);
319       Result := uDeleteFromPDL;
320   end;
321   
322   // returns value used to bypass Billing Aware if needed.
323   //  turns off visual and functionality
324   procedure rpcSetBillingAwareSwitch(encProvider:int64; pPatientDFN: string);
325   begin
326   // Is Provider -> Is Master Sw -> Is CIDC SW -> Is Patient Insured
327      BILLING_AWARE := FALSE;
328      // verify user is a provider
329      if (encProvider <> 0) and PersonHasKey(encProvider, 'PROVIDER') then
330       //  Master switch is set "ON"
331         if  (sCallV('ORWDBA1 BASTATUS', [nil]) = '1') then
332            // User is CIDC Enabled
333           if  (sCallV('ORWDBA4 GETBAUSR', [encProvider]) = '1') then
334           begin
335              // Verify Patient is Insured
336              // OR Switch = 2 ask questions for all patients.
337              if  rpcIsPatientInsured(pPatientDFN)  then
338                 BILLING_AWARE := TRUE;
339           end;
340          {$ifdef debug}BILLING_AWARE := TRUE;{$endif}
341   end;
342   
343   //  verify CIDC Master Switch and Provider is CIDC Enabled.
344   //  Patient insurance check is bypassed.  (hds7564)
345   function  IsCIDCProvider(encProvider:int64):boolean;
346   begin
347       Result := False;
348       if rpcGetBAMasterSwStatus then
349          if (encProvider <> 0) and PersonHasKey(encProvider, 'PROVIDER') then
350             Result := True;
351   end;
352   
353   
354   function rpcGetBAMasterSwStatus:boolean;
355   begin
356      Result :=  (sCallV('ORWDBA1 BASTATUS', [nil]) = '1');    //  Master switch is set "ON"
357   end;
358   
359   
360   procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
361   begin
362       rpcSaveCIDCData(pOrderRec);
363   end;
364   
365   
366   procedure rpcSaveBillingDxEntered;  // if not mandatory and user enters dx.
367   var
368    ordersWithDx,i: integer;
369    newBillingList: TStringList;
370    baseDxRec, tempDxRec: TBADxRecord;
371    currentOrderID, thisOrderID: string;
372    currentOrderString, thisRec: string;
373   begin
374   // verify Dx has been entered for orders checked for signature..
375        ordersWithDx := 0;
376        tempDxRec := TBADxRecord.Create;
377        UBAGlobals.InitializeNewDxRec(tempDxRec);
378        for i := 0 to BAOrderList.Count-1 do
379        begin
380           thisRec := BAOrderList.Strings[i];
381           thisOrderID := piece(thisRec,';',1) + ';1';  //rebuild orderID pass to M.
382           if tempDxNodeExists(thisOrderID) then
383              inc(ordersWithDx);
384        end;
385   
386        // if orders have dx enteries - save billing data.
387        if ordersWithDx > 0 then
388        begin
389           newBillingList:= TStringList.Create;
390           newBillingList.Clear;
391           baseDxRec := nil;
392           baseDxRec := TBADxRecord.Create;
393           InitializeNewDxRec(baseDxRec);
394   
395          try
396          for i := 0 to BAOrderList.Count-1 do
397          begin
398             currentOrderString := BAOrderList.Strings[i];
399             currentOrderID := piece(BAOrderList.Strings[i],';',1)+ ';1';
400             GetBADxListForOrder(baseDxRec, currentOrderID);
401             if baseDxRec.FBADxCode <> '' then
402             begin
403                NewBillingList.Add(currentOrderString +'^'+ baseDxRec.FBADxCode +'^'+ baseDxRec.FBASecDx1+
404                                   '^'+ baseDxRec.FBASecDx2+'^'+ baseDxRec.FBASecDx3);
405             end;
406          end;
407          except
408          on EListError do
409          begin
410            {$ifdef debug}Show508Message('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
411            raise;
412        end;
413     end;
414   
415      rpcSaveCIDCData(NewBillingList);
416      if Assigned(NewBillingList) then FreeAndNil(NewBillingList);
417     end;
418   end;
419   
420   procedure rpcGetSC4Orders;
421   begin
422   //  ****** RPC Logic returning SC/TF codes for COPAY  ********
423   //     if (CIDC is ON) and (PatientInsured is True) then
424   //        return SC/TF for OutPatient Meds, Labs, Prosthetics, Imaging.
425   //     else
426   //       return SC/TF for Outpatient Meds only. 
427      RPCBrokerV.Param[0].PType := literal;
428      RPCBrokerV.Param[0].Value := Patient.DFN;
429      RPCBrokerV.RemoteProcedure := 'ORWDBA1 SCLST';
430      CallBroker;
431   end;
432   
433   procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
434   var
435       tmplst: TStringList;
436   begin
437       tmplst := TStringList.Create;
438       uDxLst := TStringList.Create;
439       tmplst.clear;
440       uDxLst.Clear;
441       tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]);
442       FastAssign(tmplst, UBACore.UDxLst);
443       tmplst.clear;
444   end;
445   
446   
447   function rpcGetTFHintData:TStringList;
448   begin
449     tCallv(BATFHints,'ORWDBA3 HINTS', [nil]);
450     Result := BATFHints;
451   end;
452   
453   //  call made to determine if order type is billable
454   //  if order type NOT billable, flagged with "NA".
455   function rpcNonBillableOrders(pOrderList: TStringList):TStringList;
456   var x: string;
457       i: integer;
458       rList: TStringList;
459     begin
460       rList := TStringList.Create;
461       rList.Clear;
462       NonBillableOrderList.Clear;
463       // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
464       tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
465       for i := 0 to rList.Count-1 do
466       begin
467          x := rList[i];
468          if rList[i] <> BILLABLE_ORDER then
469             NonBillableOrderList.Add(pOrderList[i] + U + 'NA');
470       end;
471       Result := NonBillableOrderList;
472   end;
473   
474   
475   procedure rpcBuildSCIEList(pOrderList: TList);
476   var AnOrder: TOrder;
477       OrderIDList: TStringList;
478       rList: TStringList;
479       i: integer;
480      begin
481         OrderIDList := TStringList.Create;
482         rList := TStringList.Create;
483         if Assigned(OrderListSCEI) then OrderListSCEI.Clear;
484         OrderIDList.Clear;
485         rList.Clear;
486         for i := 0 to pOrderList.Count -1 do
487         begin
488            AnOrder := TOrder(pOrderList.Items[i]);
489            OrderIDList.Add(AnOrder.ID);
490         end;
491         // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
492         tCallV(rList,'ORWDBA1 ORPKGTYP',[OrderIDList]);
493   
494        for i := 0 to rList.Count-1 do
495        begin
496           if rList.Strings[i] = BILLABLE_ORDER then
497              OrderListSCEI.Add(OrderIDList.Strings[i]);
498      end;
499   end;
500   
501   procedure rpcSaveCIDCData(pCIDCList: TStringList);
502   var
503    CIDCList :TStringList;
504   begin
505       CIDCList := TStringList.create;
506       CIDCList.Clear;
507       // insure record contain valid orderid
508       if pCIDCList.Count > 0 then
509       begin
510          CIDCList := VerifyOrderIdExists(pCIDCList);
511          if CIDCList.Count > 0 then
512             CallV('ORWDBA1 RCVORCI',[CIDCList]);
513       end;
514       if Assigned(CIDCList) then FreeAndNil(CIDCList);
515   end;
516   
517   function  rpcIsPatientInsured(pPatientDFN: string):boolean;
518   begin
519      Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) > '0');
520        
521   end;
522   
523   
524   function OrdersHaveDx(pOrderList:TStringList):boolean;
525   var
526     i: integer;
527     thisOrderID: string;
528     thisRec: string;
529     tempDxRec: TBADxRecord;
530   begin
531        Result := TRUE;
532        tempDxRec := nil;
533        tempDxRec := TBADxRecord.Create;
534        UBAGlobals.InitializeNewDxRec(tempDxRec);
535   
536     try
537        for i := 0 to pOrderList.Count-1 do
538        begin
539             thisRec := pOrderList.Strings[i];
540             thisOrderID := piece(thisRec,';',1) + ';1';  //rebuild orderID pass to M.
541             if not tempDxNodeExists(thisOrderID) then
542             begin
543                Result := FALSE;
544                Break;
545             end
546             else
547             begin
548                GetBADxListForOrder(tempDxRec, thisOrderID);
549                if tempDxRec.FBADxCode = '' then
550                   begin
551                      Result := FALSE;
552                      Break;
553                   end;
554             end;
555   
556        end;
557     except
558        on EListError do
559           begin
560           {$ifdef debug}Show508Message('EListError in UBACore.OrdersHaveDx()');{$endif}
561           raise;
562           end;
563     end;
564   
565      if Assigned(tempDxRec) then
566          FreeAndNil(tempDxRec);
567   end;
568   
569   
570   
571   
572   procedure LoadUnsignedOrderRec(var thisRetVal: TBAUnsignedBillingRec;UnsignedBillingInfo:string);
573   var
574     thisString : String;
575   begin
576     thisString := UnsignedBillingInfo;
577      with thisRetVal do
578      begin
579         FBAOrderID       := Piece(thisString,U,1) + ';1';
580         FBASTSFlags      := Piece(thisString,U,2);
581         FBADxCode        := (Piece(thisString,U,4)+ U + (Piece(thisString,U,3)));
582         FBASecDx1        := (Piece(thisString,U,6)+ U + (Piece(thisString,U,5)));
583         FBASecDx2        := (Piece(thisString,U,8)+ U + (Piece(thisString,U,7)));
584         FBASecDx3        := (Piece(thisString,U,10)+ U + (Piece(thisString,U,9)));
585         //  if codes are absent then get rid of '^'.
586         if FBADxCode = U then FBADxCode := DXREC_INIT_FIELD_VAL;
587         if FBASecDx1 = U then FBASecDx1 := DXREC_INIT_FIELD_VAL;
588         if FBASecDx2 = U then FBASecDx2 := DXREC_INIT_FIELD_VAL;
589         if FBASecDx3 = U then FBASecDx3 := DXREC_INIT_FIELD_VAL;
590      end;
591   end;
592   
593   procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);
594   var
595       TFResults: string;
596       thisRec: TBAPLFactorsIN;
597   begin
598       TFResults := '';
599       thisRec := TBAPLFactorsIN.Create;
600       thisRec.FBADxText            := Piece(ProblemRec,'(',1);
601       thisRec.FBADxText            := Piece(thisRec.FBADxText,U,2);
602       thisRec.FBADxCode            := Piece(ProblemRec,U,3);
603       thisRec.FBASC                := Piece(ProblemRec,U,5);
604       thisRec.FBASC_YN             := Piece(ProblemRec,U,6);
605       //HDS8409
606       if StrPos(PChar(ProblemRec),'(') <> nil then
607          thisRec.FBATreatFactors :=  ProcessProblemTFactors(ProblemRec)
608       else
609       begin
610          thisRec.FBATreatFactors  := Piece(ProblemRec,')',1);
611          thisRec.FBATreatFactors  := Piece(thisRec.FBATreatFactors,'(',2);
612       end;
613       //HDS8409
614     with thisRec do
615     begin
616         if StrLen(pchar(FBATreatFactors)) > 0 then   // 0 Treatment Factors exist
617         //build string containing Problem List Treatment Factors
618           TFResults := ( FBADXCode + U + FBADxText  + '  (' + FBASC + '/' + FBATreatFactors + ')  ' )
619         else
620           if StrLen(PChar(FBASC)) > 0 then
621              TFResults := ( FBADxCode + U + FBADxText  + '  (' + FBASC + ')  ' )
622           else
623              TFResults := ( FBADxCode + U  + FBADxText );
624     end;
625   
626       Dest := TFResults;
627   end;
628   
629   
630   // this code is to handle adding Problem List(only) TF's when selected
631   procedure BALoadStsFlagsAsIs(StsFlagsIN: String);
632   var
633     x: string;
634   begin
635      x:= Piece(StsFlagsIN,U,2);
636      UBAGlobals.SC  := Copy(x,1,1);
637      UBAGlobals.AO  := Copy(x,2,1);
638      UBAGlobals.IR  := Copy(x,3,1);
639      UBAGlobals.EC  := Copy(x,4,1);
640      UBAGlobals.MST := Copy(x,5,1);
641      UBAGlobals.HNC := Copy(x,6,1);
642      UBAGlobals.CV  := Copy(x,7,1);
643      UBAGlobals.SHD := Copy(x,8,1);
644   end;
645   
646   
647   // this code is to handle adding Problem List(only) TF's when selected
648   
649   procedure SetTreatmentFactors(TFactors: string);
650   var
651    strTFactors : string;
652    strFlagsOut: string;
653    FlagsIN : TStringList;
654    Idx: string;
655    i : integer;
656   begin
657       UBAGlobals.BAFlagsOUT := TStringList.Create;
658       UBAGlobals.BAFlagsOUT.Clear;
659       FlagsIN := TStringList.Create;
660       FlagsIN.Clear;
661       FlagsIN := UBAGlobals.PLFactorsIndexes;
662   
663       for i:= 0 to FlagsIN.Count-1 do
664       begin
665          BALoadStsFlagsAsIs(FlagsIN.Strings[i]);
666          IDX := Piece(FlagsIN.Strings[i],U,1);
667   
668          strTFactors := TFactors;
669   
670          if UBAGlobals.SC  <> 'N' then
671             if StrPos(PChar(strTFactors),PChar(SERVICE_CONNECTED)) <> nil then
672                UBAGlobals.SC := 'C' ;
673   
674          if UBAGlobals.SC <> 'N' then
675             if StrPos(PChar(strTFactors),PChar(NOT_SERVICE_CONNECTED)) <> nil then
676                UBAGlobals.SC := 'U';
677   
678          if UBAGlobals.AO <>'N' then
679             if StrPos(PChar(strTFactors),PChar(AGENT_ORANGE)) <> nil then
680                UBAGlobals.AO := 'C';
681   
682          if UBAGlobals.IR <>'N' then
683             if StrPos(PChar(strTFactors),PChar(IONIZING_RADIATION)) <> nil then
684                UBAGlobals.IR := 'C';
685   
686          if UBAGlobals.EC <>'N' then
687             if StrPos(PChar(strTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then
688                UBAGlobals.EC := 'C';
689   
690          if UBAGlobals.MST <>'N' then
691             if StrPos(PChar(strTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then
692                UBAGlobals.MST := 'C';
693   
694          if UBAGlobals.CV <>'N' then
695             if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then
696                UBAGlobals.CV := 'C';
697   
698          if UBAGlobals.HNC <>'N' then
699             if StrPos(PChar(strTFactors),PChar(HEAD_NECK_CANCER)) <> nil then
700                UBAGlobals.HNC := 'C';
701   
702          if UBAGlobals.SHD <> 'N' then
703             if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then
704                UBAGlobals.SHD := 'C';
705   
706          //  Build Treatment Factor List to be passed to fOrdersSign form
707          strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV + SHD);
708          UBAGlobals.BAFlagsOUT.Add(IDX + '^' + strFlagsOut );
709        end;
710     end;
711   
712   
713   function StripTFactors(FactorsIN: string):string;
714   var strDxCode,strDxName:string;
715   begin
716      Result := '';
717      strDxCode := Piece(FactorsIN,U,2);
718      strDxName := Piece(FactorsIN,'(',1);
719      Result := (strDxName + U + strDxCode);
720   end;
721   
722   function AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList;
723   var i:integer;
724       x: string;
725       tmplst: TStringList;
726   begin
727       tmplst := TStringList.Create;
728       tmplst.clear;
729       tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]);
730   
731     try
732       for i := 0 to tmplst.count-1 do
733          x := tmplst.Strings[i];
734     except
735        on EListError do
736           begin
737           {$ifdef debug}Show508Message('EListError in UBACore.AddProviderPatientDaysDx()');{$endif}
738           raise;
739           end;
740     end;
741   
742       Result := tmplst;
743   end;
744   
745   
746   function  OrderRequiresSCEI(pOrderID: string):boolean;
747   var i:integer;
748   
749   begin
750       Result := False;
751   
752     try
753       for i := 0 to UBAGlobals.OrderListSCEI.Count-1 do
754       begin
755          if pOrderID = UBAGlobals.OrderListSCEI.Strings[i] then
756          begin
757             Result := True;
758             Break;
759          end;
760       end;
761     except
762        on EListError do
763           begin
764           {$ifdef debug}Show508Message('EListError in UBACore.OrderRequiresSCEI()');{$endif}
765           raise;
766           end;
767     end;
768   end;
769   
770   procedure SaveUnsignedOrders(pOrderRec:String);
771   begin
772        // save all unsigned orders, keeping freview and fordersSign in sync
773        // this change may have an impact on response time??????
774        // change from save orders with dx to save all. 06/24/04
775        // /  if not  clear treatment factors for order is non cidc
776      UBAGlobals.UnsignedOrders.Add(pOrderRec);
777   
778   end;
779   
780   function rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList;
781   var
782     rList : TStringList;
783     newList:TStringList;
784     i: integer;
785     x: string;
786   begin
787      rList := TStringList.Create;
788      newList := TStringList.Create;
789      if Assigned(rList) then rList.Clear;
790      if Assigned(newList) then newList.Clear;
791   
792      for i := 0 to pOrderIDList.Count-1 do
793      begin
794         newList.Add(Piece(pOrderIDList.Strings[i],';',1));
795         x := newlist.strings[i];
796      end;
797      if newList.Count > 0 then
798         tCallV(rList,'ORWDBA4 GETTFCI',[newList]);
799      Result := rList;
800   
801   
802   end;
803   
804   procedure BuildSaveUnsignedList(pOrderList: TStringList);
805   var
806      thisList: TStringList;
807      rList: TStringList;
808   begin
809   
810     thisList := TStringList.Create;
811     rList := TStringList.Create;
812     if Assigned(rList) then rList.Clear;
813     if Assigned(thisList)then thisList.Clear;
814     SaveBillingData(pOrderList);  //  save unsigned info to be displayed when recalled at later time
815   end;
816   
817   function  rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList;
818   var
819    i:integer;
820    newList:TStringList;
821    rList:TStringList;
822   begin
823     newList := TStringList.Create;
824     rList := TStringList.Create;
825     if Assigned(newList) then newList.Clear;
826     if Assigned(rList) then rList.Clear;
827     Result := rList;
828   
829     if pOrderList.Count = 0 then Exit;
830     for i := 0 to pOrderList.Count-1 do
831     begin
832        newList.Add(Piece(pOrderList.Strings[i],';',1));
833     end;
834      tCallV(rList,'ORWDBA4 GETTFCI',[newList]);
835     Result := rList;
836   end;
837   
838   procedure CompleteUnsignedBillingInfo(pOrderList:TStringList);
839   var
840   i: integer;
841   RecOut : TBADxRecord;
842   copyList: TStringList;
843   begin
844      copyList := TStringList.Create;
845      if Assigned(copyList) then copyList.Clear;
846   
847      if Assigned(BAUnSignedOrders) then  BAUnSignedOrders.Clear;
848   
849      if not Assigned(UBAGlobals.UnsignedBillingRec) then
850      begin
851         UBAGlobals.UnSignedBillingRec := UBAGlobals.TBAUnsignedBillingRec.Create;
852         UBAGlobals.InitializeUnsignedOrderRec(UBAGlobals.UnsignedBillingRec);
853      end;
854   
855      UBAGlobals.InitializeUnsignedOrderRec(UnsignedBillingRec);
856   
857     try
858        for i := 0 to pOrderList.Count-1 do
859           begin
860              LoadUnsignedOrderRec(UBAGlobals.UnsignedBillingRec, pOrderList.Strings[i]);
861              if Not UBAGlobals.tempDxNodeExists(UnsignedBillingRec.FBAOrderID) then
862              begin
863                 SimpleAddTempDxList(UnSignedBillingRec.FBAOrderID);
864                 RecOut := TBADxRecord.Create;
865                 RecOut.FExistingRecordID := UnSignedBillingRec.FBAOrderID;
866                 RecOut.FBADxCode  := UnsignedBillingRec.FBADxCode;
867                 RecOut.FBASecDx1  := UnsignedBillingRec.FBASecDx1;
868                 RecOut.FBASecDx2  := UnsignedBillingRec.FBASecDx2;
869                 RecOut.FBASecDx3  := UnsignedBillingRec.FBASecDx3;
870                 RecOut.FTreatmentFactors := UnSignedBillingRec.FBASTSFlags;
871                 PutBADxListForOrder(RecOut, RecOut.FExistingRecordID);
872                 UBAGlobals.BAUnSignedOrders.Add(UnSignedBillingRec.FBAOrderID + '^' + UnSignedBillingRec.FBASTSFlags);
873              end
874              else
875              begin
876                 RecOut := TBADxRecord.Create;
877                 if tempDxNodeExists(UnSignedBillingRec.FBAOrderID) then
878                 begin
879                    GetBADxListForOrder(RecOut, UnSignedBillingRec.FBAOrderID); //load data from source
880                    copyList.Add(UnSignedBillingRec.FBAOrderID + '^' + UnSignedBillingRec.FBASTSFlags);
881                    BuildSaveUnsignedList(copyList);
882                end;
883            end;
884        end;
885        except
886        on EListError do
887           begin
888           {$ifdef debug}Show508Message('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif}
889           raise;
890           end;
891     end;
892   end;
893   
894   function  GetUnsignedOrderFlags(pOrderID: string; pFlagList: TStringList):string;
895   var
896     i: integer;
897   begin
898      Result := '';
899      try
900       for i := 0 to pFlagList.Count-1 do
901          begin
902             if pOrderID = Piece(pFlagList.Strings[i],U,1) then
903             begin
904                Result := Piece(pFlagList.Strings[i],U,2); //  STSFlags
905                Break;
906             end;
907          end;
908     except
909        on EListError do
910           begin
911           {$ifdef debug}Show508Message('EListError in UBACore.GetUnsignedOrderFlags()');{$endif}
912           raise;
913           end;
914     end;
915   
916   end;
917   
918   // BuildTFHintRec is meant to run once, first user of the session
919   //  contains the information to be displayed while mouse-over in fOrdersSign and fReview.
920   procedure BuildTFHintRec;
921   var
922   hintList :TStringList;
923   i: integer;
924   x: string;
925   begin
926      hintList := TStringList.Create;
927      if Assigned(hintList) then hintList.Clear;
928      hintList := rpcGetTFHintData;
929      if hintList.Count > 0 then  UBAGlobals.BAFactorsRec.FBAFactorActive := TRUE;
930   
931     try
932         for i := 0 to hintList.Count -1 do
933            begin
934               x := hintList.Strings[i];
935               if piece(x,U,1) = SERVICE_CONNECTED then
936               begin
937                  if piece(x,U,2) = '1' then
938                     UBAGlobals.BAFactorsRec.FBAFactorSC := Piece(x,U,3)
939                  else
940                     UBAGlobals.BAFactorsRec.FBAFactorSC := ( UBAGlobals.BAFactorsRec.FBAFactorSC + CRLF + Piece(x,U,3) );
941               end
942               else
943                  if piece(x,U,1) = AGENT_ORANGE then
944                  begin
945                     if piece(x,U,2) = '1' then
946                        UBAGlobals.BAFactorsRec.FBAFactorAO := Piece(x,U,3)
947                     else
948                        UBAGlobals.BAFactorsRec.FBAFactorAO := (UBAGlobals.BAFactorsRec.FBAFactorAO + CRLF + Piece(x,U,3) );
949                  end
950                  else
951                   if piece(x,U,1) = IONIZING_RADIATION then
952                   begin
953                     if piece(x,U,2) = '1' then
954                        UBAGlobals.BAFactorsRec.FBAFactorIR := Piece(x,U,3)
955                     else
956                        UBAGlobals.BAFactorsRec.FBAFactorIR := (UBAGlobals.BAFactorsRec.FBAFactorIR + CRLF + Piece(x,U,3) );
957                  end
958                  else
959                    if piece(x,U,1) = ENVIRONMENTAL_CONTAM then
960                    begin
961                     if piece(x,U,2) = '1' then
962                        UBAGlobals.BAFactorsRec.FBAFactorEC := Piece(x,U,3)
963                     else
964                        UBAGlobals.BAFactorsRec.FBAFactorEC := (UBAGlobals.BAFactorsRec.FBAFactorEC + CRLF + Piece(x,U,3) );
965                  end
966                  else
967                    if piece(x,U,1) = HEAD_NECK_CANCER then
968                    begin
969                     if piece(x,U,2) = '1' then
970                        UBAGlobals.BAFactorsRec.FBAFactorHNC := Piece(x,U,3)
971                     else
972                        UBAGlobals.BAFactorsRec.FBAFactorHNC := (UBAGlobals.BAFactorsRec.FBAFactorHNC + CRLF + Piece(x,U,3) );
973                  end
974                  else
975                    if piece(x,U,1) = MILITARY_SEXUAL_TRAUMA then
976                    begin
977                     if piece(x,U,2) = '1' then
978                        UBAGlobals.BAFactorsRec.FBAFactorMST := Piece(x,U,3)
979                     else
980                        UBAGlobals.BAFactorsRec.FBAFactorMST := (UBAGlobals.BAFactorsRec.FBAFactorMST + CRLF + Piece(x,U,3) );
981                  end
982                  else
983                    if piece(x,U,1) = COMBAT_VETERAN then
984                    begin
985                      if piece(x,U,2) = '1' then
986                         UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3)
987                      else
988                         UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) );
989                    end
990                    else
991                       if piece(x,U,1) = SHIPBOARD_HAZARD_DEFENSE then
992                       begin
993                          if piece(x,U,2) = '1' then
994                             UBAGlobals.BAFactorsRec.FBAFactorSHAD := Piece(x,U,3)
995                         else
996                            UBAGlobals.BAFactorsRec.FBAFactorSHAD := (UBAGlobals.BAFactorsRec.FBAFactorSHAD + CRLF + Piece(x,U,3) );
997                     end;
998               end;
999     except
1000       on EListError do
1001          begin
1002          {$ifdef debug}Show508Message('EListError in UBACore.BuileTFHintRec()');{$endif}
1003          raise;
1004          end;
1005    end;
1006  end;
1007  
1008  
1009  function  IsAllOrdersNA(pOrderList:TStringList):boolean;
1010  var
1011    i:integer;
1012    rList: TStringList;
1013  begin
1014    rList := TStringList.Create;
1015    if Assigned(rList) then rList.Clear;
1016    Result := True;// disables dx button
1017   
1018    // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
1019    tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
1020  
1021    for i := 0 to rList.Count-1 do
1022    begin
1023       if rList.Strings[i] =  BILLABLE_ORDER then
1024       begin
1025          Result := False;
1026          Break;
1027       end;
1028    end;
1029  end;
1030  
1031  function  PrepOrderID(pOrderID:String): String;
1032  var
1033    newOrderID: String;
1034  begin
1035     newOrderID := '';
1036     if pos(';',pOrderID) > 0 then
1037            newOrderID := Piece(pOrderID,';',1)
1038         else
1039            newOrderID := pOrderID ;
1040  
1041      Result := newOrderID;
1042  end;
1043  
1044  procedure ClearSelectedOrderDiagnoses(pOrderIDList: TStringList);
1045  var
1046    RecOut: TBADxRecord;
1047    i: integer;
1048  begin
1049    try
1050       for i := 0 to pOrderIDList.Count-1 do
1051       begin
1052           if UBAGlobals.tempDxNodeExists(pOrderIDList.Strings[i]) then
1053           begin
1054              RecOut := TBADxRecord.Create;
1055              GetBADxListForOrder(RecOut, pOrderIDList.Strings[i]);
1056              RecOut.FOrderID   := RecOut.FOrderID;
1057              RecOut.FBADxCode  := DXREC_INIT_FIELD_VAL;
1058              RecOut.FBASecDx1  := DXREC_INIT_FIELD_VAL;
1059              RecOut.FBASecDx2  := DXREC_INIT_FIELD_VAL;
1060              RecOut.FBASecDx3  := DXREC_INIT_FIELD_VAL;
1061              PutBADxListForOrder(RecOut, pOrderIDList.Strings[i]);
1062              frmReview.lstReview.Refresh;
1063           end;
1064       end;
1065    except
1066       on EListError do
1067          begin
1068             {$ifdef debug}Show508Message('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif}
1069             raise;
1070          end;
1071    end;
1072  end;
1073  
1074  procedure LoadConsultOrderRec(var thisRetVal: TBAConsultOrderRec; pOrderID: String; pDxList: TStringList);
1075  var
1076    thisString, thisFlags:String;
1077    dx1,dx2,dx3,dx4: string;
1078    i: integer;
1079  begin
1080     thisFlags := '';
1081     dx1 := '';
1082     dx2 := '';
1083     dx3 := '';
1084     dx4 := '';
1085     UBAGlobals.BAConsultDxList.Sort;
1086  
1087    try
1088     for i := 0 to UBAGlobals.BAConsultDxList.Count -1 do
1089        begin
1090           thisString := UBAGlobals.BAConsultDxList[i];
1091  
1092           if i = 0 then
1093              begin
1094                 if pos( '(', thisString) > 0 then
1095                    begin
1096                    thisFlags := Piece(thisString,'(',2);
1097                    thisFlags := Piece(thisFlags,')',1);
1098                    UBAGlobals.BAConsultPLFlags.Add(pOrderID + U + thisFlags);
1099                    dx1 := Piece(thisString,U,2);
1100                    dx1 := Piece(dx1,'(',1) + U + Piece(thisString,':',2);
1101                    end
1102                 else
1103                    begin
1104                    dx1 := Piece(thisString,U,2);
1105                    dx1 := Piece(dx1,':',1)+ U + Piece(thisString,':',2);
1106                    end
1107              end
1108           else
1109              if i = 1 then
1110                 begin
1111                 if pos( '(', thisString) > 0 then
1112                    begin
1113                       dx2 := Piece(thisString,U,2);
1114                       dx2 := Piece(dx2,'(',1)+ U + Piece(thisString,':',2);
1115                    end
1116                 else
1117                     begin
1118                        dx2 := Piece(thisString,U,2);
1119                        dx2 := Piece(dx2,':',1)+ U + Piece(thisString,':',2);
1120                     end
1121                 end
1122              else
1123                 if i = 2 then
1124                    begin
1125                    if pos( '(', thisString) > 0 then
1126                       begin
1127                          dx3 := Piece(thisString,U,2);
1128                          dx3 := Piece(dx3,'(',1)+ U + Piece(thisString,':',2);
1129                       end
1130                    else
1131                       begin
1132                          dx3  := Piece(thisString,U,2);
1133                          dx3  := Piece(dx3,':',1)+ U + Piece(thisString,':',2);
1134                       end
1135                    end
1136                 else
1137                    if i = 3 then
1138                       begin
1139                       if pos( '(', thisString) > 0 then
1140                          begin
1141                             dx4 := Piece(thisString,U,2);
1142                             dx4 := Piece(dx4,'(',1)+ U + Piece(thisString,':',2);
1143                          end
1144                       else
1145                          begin
1146                             dx4 := Piece(thisString,U,2);
1147                             dx4 := Piece(dx4,':',1)+ U + Piece(thisString,':',2);
1148                          end;
1149                       end;
1150        end;
1151    except
1152       on EListError do
1153          begin
1154          {$ifdef debug}Show508Message('EListError in UBACore.LoadConsultOrderRec()');{$endif}
1155          raise;
1156          end;
1157    end;
1158  
1159        with thisRetVal do
1160        begin
1161          FBAOrderID          := pOrderID;
1162          FBATreatmentFactors:= thisFlags;
1163          FBADxCode        := dx1;
1164          FBASecDx1        := dx2;
1165          FBASecDx2        := dx3;
1166          FBASecDx3        := dx4;
1167         end;
1168  end;
1169  
1170  procedure LoadTFactorsInRec(var thisRetVal: TBATreatmentFactorsInRec; pOrderID:string; pEligible: string; pTFactors:string);
1171  begin
1172       with thisRetVal do
1173       begin
1174          FBAOrderID    := pOrderID;
1175          FBAEligible   := pEligible;
1176          FBATFactors   := pTFactors;
1177       end;
1178  end;
1179  
1180  procedure CompleteConsultOrderRec(pOrderID: string; pDxList: TStringList);
1181  var
1182    RecOut : TBADxRecord;
1183    TfFlags,dxRec: string;
1184    orderList : TStringList;
1185    tmpOrderList: TStringList;
1186  begin
1187      orderList    := TStringList.Create;
1188      tmpOrderList := TStringList.Create;
1189      orderList.Clear;
1190      tmpOrderList.Clear;
1191      if not Assigned(UBAGlobals.ConsultOrderRec)then
1192         begin
1193            UBAGlobals.ConsultOrderRec := UBAGlobals.TBAConsultOrderRec.Create;
1194            InitializeConsultOrderRec(UBAGlobals.ConsultOrderRec);
1195         end
1196      else
1197         InitializeConsultOrderRec(UBAGlobals.ConsultOrderRec);
1198      // call rpc to load list with boolean values based on orders package type.
1199      UBAGlobals.NonBillableOrderList.Clear;
1200      tmpOrderList.Add(UBAGlobals.BAOrderID);
1201      rpcNonBillableOrders(tmpOrderList);
1202      if IsOrderBillable(UBAGlobals.BAOrderID) then
1203      begin
1204         if not UBAGlobals.tempDxNodeExists(UBAGlobals.BAOrderID) then
1205            begin
1206               LoadConsultOrderRec(UBAGlobals.ConsultOrderRec,UBAGlobals.BAOrderID,UBAGlobals.BAConsultDxList);
1207               if NOT UBAGlobals.tempDxNodeExists(pOrderID) then
1208                  SimpleAddTempDxList(pOrderID);
1209               RecOut := TBADxRecord.Create;
1210               RecOut.FExistingRecordID := pOrderID;
1211               RecOut.FBADxCode  := ConsultOrderRec.FBADxCode;
1212               RecOut.FBASecDx1  := ConsultOrderRec.FBASecDx1;
1213               RecOut.FBASecDx2  := ConsultOrderRec.FBASecDx2;
1214               RecOut.FBASecDx3  := ConsultOrderRec.FBASecDx3;
1215               RecOut.FTreatmentFactors := ConsultOrderRec.FBATreatmentFactors;
1216               PutBADxListForOrder(RecOut, RecOut.FExistingRecordID);
1217  //  HDS00003380
1218               if IsUserNurseProvider(User.DUZ) then
1219               begin
1220                  dxRec := BuildConsultDxRec(ConsultOrderRec);
1221                  orderList.Add(RecOut.FExistingRecordID);
1222                //  TfFlags := Piece(GetPatientTFactors(orderList),U,2);
1223                  TfFlags := GetPatientTFactors(orderList);
1224                  TfFlags := ConvertPIMTreatmentFactors(TfFlags);
1225                  orderList.Clear;
1226                //  if strLen(PChar(dxRec)) > 0 then
1227                //     orderList.Add(RecOut.FExistingRecordID +TfFlags + '^'+ BuildConsultDxRec(ConsultOrderRec) )
1228                //  else
1229                     orderList.Add(RecOut.FExistingRecordID +TfFlags);
1230                  SaveBillingData(OrderList);  //  save unsigned info to be displayed when re
1231               end;
1232            end;
1233        end;
1234  end;
1235  
1236  function  GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string;
1237  var
1238     i: integer;  //add code to match order id.....
1239  begin
1240    Result := '';
1241      for i := 0 to pFlagList.Count -1 do
1242          begin
1243             if pOrderID = Piece(pFlagList.Strings[i],U,1) then
1244             begin
1245                Result := SetConsultFlags( Piece(pFlagList.Strings[i],U,2), FlagsAsIs);
1246                break;
1247             end;
1248          end;
1249  
1250  end;
1251  
1252  function  SetConsultFlags(pPLFactors: string; pFlagsAsIs:string):string; //  return updated flags.
1253  var
1254    strFlagsAsIs: string;
1255    strTFactors: string;
1256    strFlagsOut,x: string;
1257  
1258  begin
1259      strFlagsAsIs  := pFlagsAsIs; // flags from pims
1260      strTFactors   :=  pPLFactors;  // value selected from problem list
1261      strFlagsOut   := '';   // flags updated with selected values from problem list
1262      x             := strFlagsAsIs;
1263      Result        := '';
1264  
1265      UBAGlobals.SC  := Copy(x,1,1);
1266      UBAGlobals.AO  := Copy(x,2,1);
1267      UBAGlobals.IR  := Copy(x,3,1);
1268      UBAGlobals.EC  := Copy(x,4,1);
1269      UBAGlobals.MST := Copy(x,5,1);
1270      UBAGlobals.HNC := Copy(x,6,1);
1271      UBAGlobals.CV  :=  Copy(x,7,1); // load factors to global vars;
1272      UBAGlobals.SHD := Copy(x,8,1);
1273  
1274    if UBAGlobals.SC  <> 'N' then
1275         if StrPos(PChar(strTFactors),PChar(SERVICE_CONNECTED)) <> nil then
1276            UBAGlobals.SC := 'C' ;
1277  
1278      if UBAGlobals.SC <> 'N' then
1279         if StrPos(PChar(strTFactors),PChar(NOT_SERVICE_CONNECTED)) <> nil then
1280            UBAGlobals.SC := 'U';
1281  
1282      if UBAGlobals.AO <>'N' then
1283         if StrPos(PChar(strTFactors),PChar(AGENT_ORANGE)) <> nil then
1284            UBAGlobals.AO := 'C';
1285  
1286      if UBAGlobals.IR <>'N' then
1287         if StrPos(PChar(strTFactors),PChar(IONIZING_RADIATION)) <> nil then
1288            UBAGlobals.IR := 'C';
1289  
1290      if UBAGlobals.EC <>'N' then
1291         if StrPos(PChar(strTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then
1292            UBAGlobals.EC := 'C';
1293  
1294      if UBAGlobals.MST <>'N' then
1295         if StrPos(PChar(strTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then
1296            UBAGlobals.MST := 'C';
1297  
1298      if UBAGlobals.HNC <> 'N' then
1299         if StrPos(PChar(strTFactors),PChar(HEAD_NECK_CANCER)) <> nil then
1300            UBAGlobals.HNC := 'C';
1301  
1302      if UBAGlobals.CV <>'N' then
1303         if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then
1304            UBAGlobals.CV := 'C';
1305  
1306      if UBAGlobals.SHD <> 'N' then
1307         if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then
1308            UBAGlobals.SHD := 'C';
1309  
1310       strFlagsOut := (UBAGlobals.SC + UBAGlobals.AO + UBAGlobals.IR +
1311                       UBAGlobals.EC + UBAGlobals.MST + UBAGlobals.HNC +
1312                       UBAGlobals.CV + UBAGlobals.SHD);
1313    Result := strFlagsOut;
1314  end;
1315  
1316  procedure GetBAStatus(pProvider:int64; pPatientDFN: string);
1317  begin
1318    // sets global switch, based in value returned from server.
1319    // True ->  Billing Aware Switch ON. else OFF
1320  
1321    UBACore.rpcSetBillingAwareSwitch(pProvider,pPatientDFN);
1322  
1323    if Assigned(UBAGlobals.BAPCEDiagList) then UBAGlobals.BAPCEDiagList.Clear;
1324       frmFrame.SetBADxList;
1325    if not UBAGlobals.BAFactorsRec.FBAFactorActive then
1326       UBACore.BuildTFHintRec;
1327  end;
1328  
1329  function IsICD9CodeActive(ACode: string; LexApp: string; ADate: TFMDateTime = 0): boolean;
1330  var
1331    inactiveChar : string;
1332  begin
1333      inactiveChar := '#';
1334      if StrPos(PChar(ACode),PChar(inactiveChar) ) <> nil then
1335         ACode := Piece(ACode,'#',1);  //  remove the '#' added for inactive code.
1336     Result := (sCallV('ORWPCE ACTIVE CODE',[ACode, LexApp, ADate]) = '1');
1337  end;
1338  
1339  function  BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string;
1340  var
1341  newString: string;
1342  begin
1343     if strLen(PChar(ConsultRec.FBADxCode)) > 0 then
1344        newString := Piece(ConsultRec.FBADxCode,U,2)
1345     else
1346        if strLen(PChar(ConsultRec.FBASecDx1)) > 0 then
1347           newString := newString + '^' + Piece(ConsultRec.FBASecDx1,U,2)
1348     else
1349        if strLen(PChar(ConsultRec.FBASecDx2)) > 0 then
1350           newString := newString + '^' + Piece(ConsultRec.FBASecDx2,U,2)
1351     else
1352        if strLen(PChar(ConsultRec.FBASecDx3)) > 0 then
1353           newString := newString + '^' + Piece(ConsultRec.FBASecDx3,U,2);
1354     Result := newString;
1355  end;
1356  
1357  function  ConvertPIMTreatmentFactors(pTFactors:string):string;
1358  var
1359   strSC,strAO, strIR: string;
1360   strEC, strMST, strHNC, strCV: string;
1361  
1362  begin
1363      Result := '';
1364     if StrPos(PChar(pTFactors),PChar(SERVICE_CONNECTED)) <> nil then
1365        strSC := '?'
1366     else
1367        strSC := 'N';
1368  
1369     if StrPos(PChar(pTFactors),PChar(AGENT_ORANGE)) <> nil then
1370        strAO := '?'
1371     else
1372        strAO := 'N';
1373  
1374     if StrPos(PChar(pTFactors),PChar(IONIZING_RADIATION)) <> nil then
1375        strIR := '?'
1376     else
1377        strIR := 'N';
1378  
1379     if StrPos(PChar(pTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then
1380        strEC := '?'
1381     else
1382        strEC := 'N';
1383  
1384     if StrPos(PChar(pTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then
1385        strMST := '?'
1386     else
1387        strMST := 'N';
1388  
1389     if StrPos(PChar(pTFactors),PChar(HEAD_NECK_CANCER)) <> nil then
1390        strHNC := '?'
1391     else
1392        strHNC := 'N';
1393  
1394     if StrPos(PChar(pTFactors),PChar(COMBAT_VETERAN)) <> nil then
1395        strCV := '?'
1396     else
1397        strCV := 'N';
1398  
1399     Result := (strSC + strAO + strIR + strEC + strMST + strHNC + strCV);
1400  end;
1401  
1402  
1403  // Delete dc'd orders from BACopiedOrderList to keep things in sync.
1404  procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
1405  var i:integer;
1406      holdList: TStringList;
1407      x: string;
1408  begin
1409     holdList := TStringList.Create;
1410     holdList.Clear;
1411     FastAssign(UBAGlobals.BACopiedOrderFlags, holdList);
1412     UBAGlobals.BACopiedOrderFlags.Clear;
1413     for i := 0 to holdList.Count-1 do
1414     begin
1415        x := Piece(holdList.Strings[i],';',1);
1416        if pOrderID = Piece(holdList.Strings[i],';',1) then
1417           continue
1418        else
1419           UBAGlobals.BACopiedOrderFlags.Add(holdList.Strings[i]);
1420     end;
1421  end;
1422  
1423  procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
1424  var
1425   x: string;
1426   var i,j: integer;
1427   holdList : TStringList;
1428  begin
1429     // remove order enteries from the dx list that are being discontinued.
1430     for i := 0 to pDcOrders.Count -1 do
1431     begin
1432         UBAGlobals.RemoveOrderFromDxList(pDcOrders.Strings[i]);
1433     end;
1434     if UBAGlobals.BAConsultPLFlags.Count > 0 then
1435     begin
1436        holdList := TStringList.Create;
1437        holdList.Clear;
1438        FastAssign(UBAGlobals.BAConsultPLFlags, holdList);
1439        UBAGlobals.BAConsultPLFlags.Clear;
1440        for i := 0 to holdList.Count-1 do
1441        begin
1442           x := holdList.Strings[i];
1443           for j := 0 to pDcOrders.Count-1 do
1444           begin
1445              if x = pDcOrders.Strings[j] then
1446              continue
1447              else
1448                 UBAGlobals.BAConsultPLFlags.Add(x);
1449           end;
1450        end;
1451     end;
1452  end;
1453  
1454  // loop thru CIDC records remove records with invalid orderid
1455  function  VerifyOrderIdExists(pOrderList: TStringList): TStringList;
1456  var
1457    goodList: TStringList;
1458    tOrderID: integer;
1459   i: integer;
1460  begin
1461    goodList := TStringList.Create;
1462    goodList.clear;
1463  
1464    if pOrderList.Count > 0 then
1465    begin
1466        for i := 0 to pOrderList.Count-1 do
1467        begin
1468           tOrderID := StrToIntDef(Piece(pOrderList.Strings[i],';',1), 0);
1469           if tOrderID > 0 then
1470              goodList.add(pOrderList.Strings[i]);
1471        end;
1472    end;
1473    result := goodList;
1474  end;
1475  
1476  // parse string return Treatment Factors when text inlcudes multiple "(())"
1477  //HDS8409
1478  function  ProcessProblemTFactors(pText:String):String;
1479  var AText1,x: string;
1480      i,j: integer;
1481  begin
1482   if StrPos(PChar(pText),'(') = nil then exit;
1483   AText1 := Piece(pText,U,2);
1484   i := 1;
1485   j := 0;
1486   while j = 0 do
1487   begin
1488      x := Piece(AText1,'(',i);
1489      if Length(x) > 0 then
1490         inc(i)
1491      else
1492      begin
1493         x := Piece(AText1,'(',i-1);
1494         x := Piece(x,')',1);
1495         j := 1;
1496         Result := x;
1497      end;
1498    end;
1499  end;
1500  
1501  end.

Module Calls (2 levels)


UBACore
 ├uConst
 ├UBAGlobals
 │ ├uConst
 │ ├rOrders
 │ ├fBALocalDiagnoses
 │ ├fOrdersSign
 │ ├fReview
 │ ├uCore
 │ ├rCore
 │ ├UBAConst
 │ └UBACore...
 ├fFrame
 │ ├fPage
 │ ├uConst
 │ ├VERGENCECONTEXTORLib_TLB
 │ ├fBase508Form
 │ ├XuDsigS
 │ ├rCore...
 │ ├fPtSelMsg
 │ ├fPtSel
 │ ├fCover
 │ ├fProbs
 │ ├fMeds
 │ ├fOrders
 │ ├rOrders...
 │ ├fNotes
 │ ├fConsults
 │ ├fDCSumm
 │ ├rMisc
 │ ├fLabs
 │ ├fReports
 │ ├rReports
 │ ├fPtDemo
 │ ├fEncnt
 │ ├fPtCWAD
 │ ├uCore...
 │ ├fAbout
 │ ├fReview...
 │ ├fxBroker
 │ ├fxLists
 │ ├fxServer
 │ ├fRptBox
 │ ├rODAllergy
 │ ├uInit
 │ ├fLabInfo
 │ ├uReminders
 │ ├fReminderTree
 │ ├fDeviceSelect
 │ ├fDrawers
 │ ├fReminderDialog
 │ ├fOptions
 │ ├fGraphs
 │ ├fGraphData
 │ ├rTemplates
 │ ├fSurgery
 │ ├rSurgery
 │ ├uEventHooks
 │ ├uSignItems
 │ ├rECS
 │ ├fIconLegend
 │ ├uOrders
 │ ├uSpell
 │ ├uOrPtf
 │ ├fPatientFlagMulti
 │ ├fAlertForward
 │ ├UBAGlobals...
 │ ├UBACore...
 │ ├fOrdersSign...
 │ ├uVitals
 │ ├fMHTest
 │ ├uFormMonitor
 │ ├fOtherSchedule
 │ ├uVA508CPRSCompatibility
 │ ├fIVRoutes
 │ ├fPrintLocation
 │ ├fTemplateEditor
 │ └fCombatVet
 ├fReview...
 ├rOrders...
 ├uCore...
 ├rCore...
 └UBAConst

Module Called-By (2 levels)


                     UBACore
                   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┘ │ 
                fODBase...┤ 
             UBAGlobals...┤ 
                 fFrame...┤ 
                fOrders...┤ 
      fBALocalDiagnoses...┤ 
                      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┘ │ 
                    fPtSel┤ 
               fFrame...┤ │ 
             fPtSelOptns┤ │ 
                 fDupPts┘ │ 
            fOrdersSign...┤ 
                fReview...┤ 
                  fOptions┤ 
               fFrame...┘ │ 
    fBAOptionsDiagnoses...┤ 
             uSignItems...┤ 
             fODConsult...┤ 
         fOrdersRelease...┘