Index: cprs/branches/foia-cprs/CPRS-Chart/BA/UBACore.pas
===================================================================
--- cprs/branches/foia-cprs/CPRS-Chart/BA/UBACore.pas	(revision 459)
+++ cprs/branches/foia-cprs/CPRS-Chart/BA/UBACore.pas	(revision 460)
@@ -11,20 +11,22 @@
 function  rpcGetPersonalDxList(UserDUZ:int64):TStringList;
 function  rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer;
-procedure rpcSaveBillingData(pBillingData:TStringList);
+procedure rpcSaveBillingDxEntered;  // save dx enteries regardless of being mandatory....
 function  rpcNonBillableOrders(pOrderList: TStringList): TStringList;
 function  rpcOrderRequiresDx(pList: TStringList):boolean;
-procedure rpcSetBillingAwareSwitch(encProvider: int64; encLocation: integer);
+procedure rpcSetBillingAwareSwitch(encProvider: int64; pPatientDFN: string);
 procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
 procedure rpcGetSC4Orders;    // returns Eligible Treatment Factors for a given patient
-procedure rpcSaveBillingDxEntered;  // save dx enteries regardless of being mandatory....
+
 function  rpcTreatmentFactorsActive(pOrderID: string):boolean;
 procedure rpcBuildSCIEList(pOrderList: TList);
 function  rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList;
-function  rpcRetrieveBillingData(thisOrderID: string; var thisBAData: string) : boolean;
 function  rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList;
 function  rpcGetTFHintData:TStringList;
 procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
 function  rpcGetBAMasterSwStatus:boolean;
-
+procedure rpcSaveCIDCData(pCIDCList: TStringList);
+function  rpcIsPatientInsured(pPatientDFN: string):boolean;
+
+procedure SaveBillingData(pBillingData:TStringList);
 function  OrdersHaveDx(pOrderList:TStringList):boolean;
 procedure SetTreatmentFactors(TFactors: string);
@@ -32,5 +34,5 @@
 procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);
 procedure BALoadStsFlagsAsIs(StsFlagsIN: string);
-function  BADxEntered:boolean;                                //  This will only be executed if bypass switch is set...
+function  BADxEntered:boolean;  //  main logic to determine if dx has been entered for order that requires dx
 function  StripTFactors(FactorsIN: string): string;
 function  AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList;
@@ -52,14 +54,13 @@
 function  GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string;
 function  SetConsultFlags(pPLFactors: string;pFlagsAsIs: string):string; //  return updated flags.
-procedure GetBAStatus(pProvider:int64; pLocation:integer);
+procedure GetBAStatus(pProvider:int64; pPatientDFN: string);
 function  IsICD9CodeActive(ACode: string; LexApp: string; ADate:TFMDateTime = 0): boolean;
 function  BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string;
 function  ConvertPIMTreatmentFactors(pTFactors:string):string;
 procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
-//function  SetOrderIDConsultDxRequired(pOrderID:String):String; // replace orderid with "R" if consult dx required.
 procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
-
-
-
+function  VerifyOrderIdExists(pOrderList: TStringList): TStringList; // removes records without order id
+function  IsCIDCProvider(encProvider:int64):boolean;
+function  ProcessProblemTFactors(pText:String):String;
 
 var
@@ -75,36 +76,158 @@
 
 
-function rpcRetrieveBillingData(thisOrderID: string; var thisBAData: string) : boolean;
-var
-  rpcResult: TStringList;
-  BAOrderExists : boolean;
-begin
-  Result := false;
-  BAOrderExists := false;
-  rpcResult := TStringList.Create;
-
-  tCallV(rpcResult, 'ORWDBA1 RCVORCI', [thisOrderID]);
-  BAOrderExists := StrToBool(rpcResult[0]);
-
-  if (not BAOrderExists) then
-     //GRAB RETURNED BA DATA HERE
-     Result := true;
-end;
-
-procedure rpcSaveBillingData(pBillingData:TStringList);
+// -----------------  MAIN CIDC DX HAS BEEN ENTERED LOGIC  ---------------------------
+function BADxEntered:boolean;
+var
+  i: integer;
+  //orderStatus: integer;
+  x: string;
+  passList: TStringList;
+  holdOrderList: TStringList;
+  thisOrderID: string;
+  thisRec: string;
+begin
+ //  Result := TRUE;   // caused hint.....
+   holdOrderList := TStringList.Create;
+   holdOrderList.Clear;
+   updatedBAOrderList := TStringList.Create;
+   updatedBAOrderList.Clear;
+   passList := TStringList.Create;
+   passList.Clear;
+   // determine which orders require a dx (lrmp- only)
+   // if NO then continue
+   // if YES, check BADxList for orders with DX enteries.
+   // if ok then create data string pass to M via RPC
+
+  for i := 0 to BAOrderList.Count-1 do
+  begin
+     thisRec := BAOrderList.Strings[i];
+     thisOrderID := piece(thisRec,';',1) + ';1';  //rebuild orderID pass to M.
+     x := BAOrderList.Strings[i];
+     //orderStatus := StrToInt(CharAt(Piece(x, ';', 2), 1));  //  Order Status 1=OK, 2=DISCONTINUE
+    if IsOrderBillable(thisOrderID) then
+     begin
+        passList.Add(piece(x,';',1));
+        holdOrderList.Add(x);//  place holder for orders that can be signed!
+     end;
+  end;
+
+   BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing
+   holdOrderList.Clear; // CQ5025
+
+    //call with passList determine if LRMP
+     if rpcOrderRequiresDx(passList) then
+      BAOrderList.Assign(updatedBAOrderList);
+
+    // check of all orders dx columns are flagged with N/A.....
+    if UBACore.IsAllOrdersNA(BAOrderList) then
+    begin
+       Result := TRUE;              //  force true, no record needs DX entry
+       Exit;                        //to do.  clean this up... when time permitts
+    end
+    else
+      begin
+      if OrdersHaveDx(UBAGlobals.BAOrderList) then
+      begin
+         Result := True; // CIDC orders have dx
+         SaveBillingData(UBAGlobals.BAOrderList) ;
+      end
+      else
+         begin
+            Result := FALSE;
+            Exit;
+         end;
+     end;
+end;
+
+
+function rpcOrderRequiresDx(pList: TStringList):boolean;
+var x: string;
+    i,j: integer;
+    returnList, updatedList: TStringList;
+   begin
+    Result := FALSE;  // initial set dx NOT required
+    returnList := TStringList.Create;
+    updatedList := TStringList.Create;
+    returnList.Clear;
+    updatedList.Clear;
+    // remove deleted orderid's
+    if UBAGlobals.BADeltedOrders.Count > 0 then
+    begin
+       for i := 0 to UBAGlobals.BADeltedOrders.Count-1 do
+          x := UBAGlobals.BADeltedOrders.Strings[i];
+         for j := 0 to pList.Count-1 do
+         begin
+            if x = pList.Strings[j] then
+              continue   // orderid is removed.. or skipped
+            else
+               updatedList.Add(x);
+         end;
+    end
+    else
+       updatedList.Assign(pList);
+
+    // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
+    tCallV(returnList,'ORWDBA1 ORPKGTYP',[updatedList]);
+
+     //Remove NON LRMP orders from the mix(when checking for dx entry);
+     // BAOrderList and pList are in sync - order id....
+     for i := 0 to BAOrderList.Count-1 do
+     begin
+        x:= piece(returnList.Strings[i],'^',1);
+        if x = BILLABLE_ORDER  then
+        begin
+           updatedBAOrderList.Add(BAOrderList[i]);
+           Result := TRUE;
+        end;
+    end;
+end;
+
+
+// UBAGlobals.NonBillableOrderList must be populated prior to calling this function.
+// call   rpcNonBillableOrders to populate List.
+function IsOrderBillable(pOrderID: string):boolean ;
+var
+  i: integer;
+  currOrderID: string;
+  matchOrderID : string;
+
+begin
+  Result := TRUE;    //  = Billable
+  currOrderID := PrepOrderID(pOrderID);
+  if Piece(pOrderID,';',2) = DISCONTINUED_ORDER THEN
+  begin
+     Result := FALSE;
+     Exit;
+  end;
+  try
+     for i := 0 to UBAGlobals.NonBillableOrderList.Count -1 do
+     begin
+        matchOrderID := PrepOrderID( (Piece(UBAGlobals.NonBillableOrderList.Strings[i],U,1)) );
+        if currOrderID = matchOrderID  then
+        begin
+           Result := FALSE;  //= Non Billable
+           Exit;
+        end;
+     end;
+  except
+     on EListError do
+        begin
+        {$ifdef debug}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif}
+        raise;
+        end;
+  end;
+end;
+
+
+procedure SaveBillingData(pBillingData:TStringList);
 var
   RecsToSave: TStringList;
-  i: integer;
-  x: string;
 begin
   RecsToSave := TStringList.Create;
   RecsToSave.Clear;
+
   RecsToSave := AttachDxToOrderList(pBillingData); //call with new Biling data, return-code returned
- // for i := 0 to RecstoSave.Count-1 do
- // begin
-//      ShowMessage('Data Sent to ORW ' + RecsToSave.Strings[i]);
- // end;
-  CallV('ORWDBA1 RCVORCI',[RecsToSave]);
- // if Assigned(UBAGlobals.BAConsultOrdersRequireDx) then UBAGlobals.BAConsultOrdersRequireDx.Clear;
+  rpcSaveCIDCData(RecsToSave);  // verify and save billing data
+
   if Assigned(UBAGlobals.BAOrderList) then UBAGlobals.BAOrderList.Clear; // hds00005025
 end;
@@ -123,5 +246,5 @@
       pList.Add(pOrderID);
       Result := FALSE;
-      // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
+     // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
       tCallV(rList,'ORWDBA1 ORPKGTYP',[pList]);
      //returns boolean value by OrderID - True = billable
@@ -158,4 +281,5 @@
      currentOrderString := pOrderList.Strings[i];
      currentOrderID := piece(pOrderList.Strings[i],';',1)+ ';1';
+
      GetBADxListForOrder(baseDxRec, currentOrderID);
      FlagsStatsIn := BAFlagsIN;
@@ -174,10 +298,8 @@
 end;
 
-
-
 function  rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean;
-//input example ien^code = 12345^306.70
-begin
-  Result := (sCallV('ORWDBA2 ADDPDL', [UserDUZ,DxCodes])= '1');
+//input example ien^code(s) = 12345^306.70^431.22
+begin
+   Result := (sCallV('ORWDBA2 ADDPDL', [UserDUZ,DxCodes])= '1');
 end;
 
@@ -198,73 +320,46 @@
 end;
 
-function rpcOrderRequiresDx(pList: TStringList):boolean;
-var x: string;
-    i,j: integer;
-    returnList, updatedList: TStringList;
-   begin
-//   for i := 0 to plist.count-1 do
-//      x := plist.strings[i];
-    Result := FALSE;
-    returnList := TStringList.Create;
-    updatedList := TStringList.Create;
-    returnList.Clear;
-    updatedList.Clear;
-    // remove deleted orderid's
-    if UBAGlobals.BADeltedOrders.Count > 0 then
-    begin
-       for i := 0 to UBAGlobals.BADeltedOrders.Count-1 do
-          x := UBAGlobals.BADeltedOrders.Strings[i];
-         for j := 0 to pList.Count-1 do
-         begin
-            if x = pList.Strings[j] then
-            continue   // orderid is removed.. or skipped
-            else
-               updatedList.Add(x);
-         end;
-    end
-    else
-       updatedList.Assign(pList);
-    // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
-    tCallV(returnList,'ORWDBA1 ORPKGTYP',[updatedList]);
-     //Remove NON LRMP orders from the mix(for checking for dx entry);
-     // BAOrderList and pList are in sync - order id....
-     for i := 0 to BAOrderList.Count-1 do
-     begin
-        x:= piece(returnList.Strings[i],'^',1);
-        if x = BILLABLE_ORDER  then   // change to test BA
-        begin
-           updatedBAOrderList.Add(BAOrderList[i]);
-           Result := TRUE;
-        end;
-    end;
-end;
 // returns value used to bypass Billing Aware if needed.
 //  turns off visual and functionality
-procedure rpcSetBillingAwareSwitch(encProvider:int64; encLocation: integer);
-begin
-   BILLING_AWARE := TRUE;
-   if (encProvider = 0) and not PersonHasKey(encProvider, 'PROVIDER') then
-      BILLING_AWARE := FALSE
-   else
-   begin
-      if  (sCallV('ORWDBA1 BASTATUS', [nil]) = '1') then    //  Master switch is set "ON"
-       BILLING_AWARE :=  (sCallV('ORWDBA4 GETBAUSR', [encProvider]) = '1')
-      else
-         BILLING_AWARE := FALSE;
-      end;
-end ;
+procedure rpcSetBillingAwareSwitch(encProvider:int64; pPatientDFN: string);
+begin
+// Is Provider -> Is Master Sw -> Is CIDC SW -> Is Patient Insured
+   BILLING_AWARE := FALSE;
+   // verify user is a provider
+   if (encProvider <> 0) and PersonHasKey(encProvider, 'PROVIDER') then
+    //  Master switch is set "ON"
+      if  (sCallV('ORWDBA1 BASTATUS', [nil]) = '1') then
+         // User is CIDC Enabled
+        if  (sCallV('ORWDBA4 GETBAUSR', [encProvider]) = '1') then
+        begin
+           // Verify Patient is Insured
+           if  rpcIsPatientInsured(pPatientDFN)  then
+              BILLING_AWARE := TRUE;
+        end;
+       {$ifdef debug}BILLING_AWARE := TRUE;{$endif}
+end;
+
+//  verify CIDC Master Switch and Provider is CIDC Enabled.
+//  Patient insurance check is bypassed.  (hds7564)
+function  IsCIDCProvider(encProvider:int64):boolean;
+begin
+    Result := False;
+    if rpcGetBAMasterSwStatus then
+       if (encProvider <> 0) and PersonHasKey(encProvider, 'PROVIDER') then
+          Result := True;
+end;
+
 
 function rpcGetBAMasterSwStatus:boolean;
 begin
-   Result := False;
    Result :=  (sCallV('ORWDBA1 BASTATUS', [nil]) = '1');    //  Master switch is set "ON"
-
-
-end;
+end;
+
 
 procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
 begin
-    CallV('ORWDBA1 RCVORCI',[pOrderRec]);
-end;
+    rpcSaveCIDCData(pOrderRec);
+end;
+
 
 procedure rpcSaveBillingDxEntered;  // if not mandatory and user enters dx.
@@ -295,7 +390,7 @@
         baseDxRec := nil;
         baseDxRec := TBADxRecord.Create;
-       InitializeNewDxRec(baseDxRec);
-
-  try
+        InitializeNewDxRec(baseDxRec);
+
+       try
        for i := 0 to BAOrderList.Count-1 do
        begin
@@ -305,22 +400,18 @@
           if baseDxRec.FBADxCode <> '' then
           begin
-                NewBillingList.Add(currentOrderString +'^'+ baseDxRec.FBADxCode +'^'+ baseDxRec.FBASecDx1+
+             NewBillingList.Add(currentOrderString +'^'+ baseDxRec.FBADxCode +'^'+ baseDxRec.FBASecDx1+
                                 '^'+ baseDxRec.FBASecDx2+'^'+ baseDxRec.FBASecDx3);
           end;
        end;
-  except
-     on EListError do
-     begin
-        {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
-        raise;
+       except
+       on EListError do
+       begin
+         {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
+         raise;
      end;
   end;
 
-   if NewBillingList.Count > 0 then
-      CallV('ORWDBA1 RCVORCI',[NewBillingList]); //1.3.10
-
+   rpcSaveCIDCData(NewBillingList);
    if Assigned(NewBillingList) then FreeAndNil(NewBillingList);
- //  if Assigned(UBAGlobals.BAConsultOrdersRequireDx) then UBAGlobals.BAConsultOrdersRequireDx.Clear;
-
   end;
 end;
@@ -335,6 +426,5 @@
 
 procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
-var i:integer;
-    x: string;
+var
     tmplst: TStringList;
 begin
@@ -351,5 +441,4 @@
 function rpcGetTFHintData:TStringList;
 begin
-  Result := nil;
   tCallv(BATFHints,'ORWDBA3 HINTS', [nil]);
   Result := BATFHints;
@@ -366,5 +455,4 @@
     rList.Clear;
     NonBillableOrderList.Clear;
-    Result := NonBillableOrderList;
     // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
     tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
@@ -396,5 +484,5 @@
       end;
       // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
-     tCallV(rList,'ORWDBA1 ORPKGTYP',[OrderIDList]);
+      tCallV(rList,'ORWDBA1 ORPKGTYP',[OrderIDList]);
 
      for i := 0 to rList.Count-1 do
@@ -403,4 +491,26 @@
            OrderListSCEI.Add(OrderIDList.Strings[i]);
    end;
+end;
+
+procedure rpcSaveCIDCData(pCIDCList: TStringList);
+var
+ CIDCList :TStringList;
+begin
+    CIDCList := TStringList.create;
+    CIDCList.Clear;
+    // insure record contain valid orderid
+    if pCIDCList.Count > 0 then
+    begin
+       CIDCList := VerifyOrderIdExists(pCIDCList);
+       if CIDCList.Count > 0 then
+          CallV('ORWDBA1 RCVORCI',[CIDCList]);
+    end;
+    if Assigned(CIDCList) then FreeAndNil(CIDCList);
+end;
+
+function  rpcIsPatientInsured(pPatientDFN: string):boolean;
+begin
+   Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) = '1');
+     
 end;
 
@@ -433,6 +543,6 @@
              if tempDxRec.FBADxCode = '' then
                 begin
-                Result := FALSE;
-                Break;
+                   Result := FALSE;
+                   Break;
                 end;
           end;
@@ -452,74 +562,4 @@
 
 
-function BADxEntered:boolean;
-var
-  i, orderStatus: integer;
-  x: string;
-  passList: TStringList;
-  holdOrderList: TStringList;
-  thisOrderID: string;
-  thisRec: string;
-begin
-   Result := FALSE;
-   holdOrderList := TStringList.Create;
-   holdOrderList.Clear;
-   updatedBAOrderList := TStringList.Create;
-   updatedBAOrderList.Clear;
-   passList := TStringList.Create;
-   passList.Clear;
-   // determine which orders require a dx (lrmp- only)
-   // if NO then continue
-   // if YES, check BADxList for orders with DX enteries.
-   // if ok then create data string pass to M via RPC
-
-   orderStatus := 0;
-   Result := true;
-
-  try
-   for i := 0 to BAOrderList.Count-1 do
-   begin
-         thisRec := BAOrderList.Strings[i];
-         thisOrderID := piece(thisRec,';',1) + ';1';  //rebuild orderID pass to M.
-
-         x := BAOrderList.Strings[i];
-         orderStatus := StrToInt(CharAt(Piece(x, ';', 2), 1));  //  Order Status 1=OK, 2=DISCONTINUE
-         if orderStatus = integer(BAOK2SIGN) then
-         begin
-            passList.Add(piece(x,';',1));
-            holdOrderList.Add(x);//  place holder for orders that can be signed!
-         end;
-   end;
-  except
-     on EListError do
-        begin
-        {$ifdef debug}ShowMessage('EListError in UBACore.BADxEntered()');{$endif}
-        raise;
-        end;
-  end;
-
-   BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing
-   holdOrderList.Clear; // CQ5025
-     //call with passList determine if LRMP
-
-   if rpcOrderRequiresDx(passList) then
-      BAOrderList.Assign(updatedBAOrderList);
-
-   if updatedBAOrderList.Count <= 0 then   //  order list reflecting orders flagged as -
-      begin                           // dx required.
-      Result := TRUE;              //  force true, no record need DX entry
-      rpcSaveBillingDxEntered;        // save billing data for orders that may have dx enteries
-      Exit;                        //to do.  clean this up... when time permitts
-      end
-   else
-      begin
-      if OrdersHaveDx(UBAGlobals.BAOrderList) then
-         rpcSaveBillingData(UBAGlobals.BAOrderList)
-      else
-         begin
-            Result := FALSE;
-            Exit;
-         end;
-     end;
-end;
 
 
@@ -557,7 +597,13 @@
     thisRec.FBASC                := Piece(ProblemRec,U,5);
     thisRec.FBASC_YN             := Piece(ProblemRec,U,6);
-    thisRec.FBATreatFactors  := Piece(ProblemRec,')',1);
-    thisRec.FBATreatFactors  := Piece(thisRec.FBATreatFactors,'(',2);
-
+    //HDS8409
+    if StrPos(PChar(ProblemRec),'(') <> nil then
+       thisRec.FBATreatFactors :=  ProcessProblemTFactors(ProblemRec)
+    else
+    begin
+       thisRec.FBATreatFactors  := Piece(ProblemRec,')',1);
+       thisRec.FBATreatFactors  := Piece(thisRec.FBATreatFactors,'(',2);
+    end;
+    //HDS8409
   with thisRec do
   begin
@@ -571,5 +617,5 @@
            TFResults := ( FBADxCode + U  + FBADxText );
   end;
-      
+
     Dest := TFResults;
 end;
@@ -657,8 +703,8 @@
 var strDxCode,strDxName:string;
 begin
-    Result := '';
-    strDxCode := Piece(FactorsIN,U,2);
-    strDxName := Piece(FactorsIN,'(',1);
-    Result := (strDxName + U + strDxCode);
+   Result := '';
+   strDxCode := Piece(FactorsIN,U,2);
+   strDxName := Piece(FactorsIN,'(',1);
+   Result := (strDxName + U + strDxCode);
 end;
 
@@ -684,36 +730,4 @@
 
     Result := tmplst;
-end;
-
-// UBAGlobals.NonBillableOrderList must be populated prior to calling this function.
-// call   rpcNonBillableOrders to populate List.
-function IsOrderBillable(pOrderID: string):boolean ;
-var
-  i: integer;
-  currOrderID: string;
-  matchOrderID : string;
-
-begin
-  Result := TRUE;    //  = Billable
-  currOrderID := PrepOrderID(pOrderID);
-  if Piece(pOrderID,';',2) = DISCONTINUED_ORDER THEN
-  begin
-     Result := FALSE;
-     Exit;
-  end;
-  try
-     for i := 0 to UBAGlobals.NonBillableOrderList.Count -1 do
-     begin
-        matchOrderID := PrepOrderID( (Piece(UBAGlobals.NonBillableOrderList.Strings[i],U,1)) );
-        if currOrderID = matchOrderID  then
-           Result := FALSE  //= Non Billable
-     end;
-  except
-     on EListError do
-        begin
-        {$ifdef debug}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif}
-        raise;
-        end;
-  end;
 end;
 
@@ -748,5 +762,5 @@
      // this change may have an impact on response time??????
      // change from save orders with dx to save all. 06/24/04
-  // /  if not  clear treatment factors for order is non cidc
+     // /  if not  clear treatment factors for order is non cidc
    uBAGlobals.UnsignedOrders.Add(pOrderRec);
 
@@ -764,10 +778,10 @@
    if Assigned(rList) then rList.Clear;
    if Assigned(newList) then newList.Clear;
-   
-     for i := 0 to pOrderIDList.Count-1 do
-     begin
-        newList.Add(Piece(pOrderIDList.Strings[i],';',1));
-        x := newlist.strings[i];
-     end;
+
+   for i := 0 to pOrderIDList.Count-1 do
+   begin
+      newList.Add(Piece(pOrderIDList.Strings[i],';',1));
+      x := newlist.strings[i];
+   end;
    if newList.Count > 0 then
       tCallV(rList,'ORWDBA4 GETTFCI',[newList]);
@@ -781,6 +795,4 @@
    thisList: TStringList;
    rList: TStringList;
-   i:integer;
-   x: string;
 begin
 
@@ -789,7 +801,5 @@
   if Assigned(rList) then rList.Clear;
   if Assigned(thisList)then thisList.Clear;
-  for i := 0 to pOrderList.Count -1 do
-     x := pOrderList.Strings[i];
-     rpcSaveBillingData(pOrderList);  //  save unsigned info to be displayed when recalled at later time
+  SaveBillingData(pOrderList);  //  save unsigned info to be displayed when recalled at later time
 end;
 
@@ -980,5 +990,5 @@
 function  IsAllOrdersNA(pOrderList:TStringList):boolean;
 var
-  i,j:integer;
+  i:integer;
   rList: TStringList;
 begin
@@ -986,20 +996,5 @@
   if Assigned(rList) then rList.Clear;
   Result := True;// disables dx button
-  for j := 0 to pOrderList.Count-1 do
-  begin
-     // code added to allow consult orders that are not cidc but require dx, dx can be edited.
-    if tempDxNodeExists(pOrderList.Strings[j]) then
-    begin
-       Result := False;
-       Exit;
-    end
-    else
-        if Piece(pOrderList.Strings[j],';',2) = DISCONTINUED_ORDER then
-        begin
-           Result := True;
-           Exit;
-        end;
-
-  end;
+ 
   // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
   tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
@@ -1097,11 +1092,11 @@
                if pos( '(', thisString) > 0 then
                   begin
-                  dx2 := Piece(thisString,U,2);
-                  dx2 := Piece(dx2,'(',1)+ U + Piece(thisString,':',2);
+                     dx2 := Piece(thisString,U,2);
+                     dx2 := Piece(dx2,'(',1)+ U + Piece(thisString,':',2);
                   end
                else
                    begin
-                   dx2 := Piece(thisString,U,2);
-                   dx2 := Piece(dx2,':',1)+ U + Piece(thisString,':',2);
+                      dx2 := Piece(thisString,U,2);
+                      dx2 := Piece(dx2,':',1)+ U + Piece(thisString,':',2);
                    end
                end
@@ -1111,11 +1106,11 @@
                   if pos( '(', thisString) > 0 then
                      begin
-                     dx3 := Piece(thisString,U,2);
-                     dx3 := Piece(dx3,'(',1)+ U + Piece(thisString,':',2);
+                        dx3 := Piece(thisString,U,2);
+                        dx3 := Piece(dx3,'(',1)+ U + Piece(thisString,':',2);
                      end
                   else
                      begin
-                     dx3  := Piece(thisString,U,2);
-                     dx3  := Piece(dx3,':',1)+ U + Piece(thisString,':',2);
+                        dx3  := Piece(thisString,U,2);
+                        dx3  := Piece(dx3,':',1)+ U + Piece(thisString,':',2);
                      end
                   end
@@ -1125,11 +1120,11 @@
                      if pos( '(', thisString) > 0 then
                         begin
-                        dx4 := Piece(thisString,U,2);
-                        dx4 := Piece(dx4,'(',1)+ U + Piece(thisString,':',2);
+                           dx4 := Piece(thisString,U,2);
+                           dx4 := Piece(dx4,'(',1)+ U + Piece(thisString,':',2);
                         end
                      else
                         begin
-                        dx4 := Piece(thisString,U,2);
-                        dx4 := Piece(dx4,':',1)+ U + Piece(thisString,':',2);
+                           dx4 := Piece(thisString,U,2);
+                           dx4 := Piece(dx4,':',1)+ U + Piece(thisString,':',2);
                         end;
                      end;
@@ -1206,11 +1201,13 @@
                 dxRec := BuildConsultDxRec(ConsultOrderRec);
                 orderList.Add(RecOut.FExistingRecordID);
-                TfFlags := Piece(GetPatientTFactors(orderList),U,2);
+              //  TfFlags := Piece(GetPatientTFactors(orderList),U,2);
+                TfFlags := GetPatientTFactors(orderList);
+                TfFlags := ConvertPIMTreatmentFactors(TfFlags);
                 orderList.Clear;
-                if strLen(PChar(dxRec)) > 0 then
-                   orderList.Add(RecOut.FExistingRecordID +TfFlags + '^'+ BuildConsultDxRec(ConsultOrderRec) )
-                else
+              //  if strLen(PChar(dxRec)) > 0 then
+              //     orderList.Add(RecOut.FExistingRecordID +TfFlags + '^'+ BuildConsultDxRec(ConsultOrderRec) )
+              //  else
                    orderList.Add(RecOut.FExistingRecordID +TfFlags);
-                rpcSaveBillingData(OrderList);  //  save unsigned info to be displayed when re
+                SaveBillingData(OrderList);  //  save unsigned info to be displayed when re
              end;
           end;
@@ -1241,9 +1238,9 @@
 
 begin
-   strFlagsAsIs  := pFlagsAsIs; // flags from pims
-   strTFactors   :=  pPLFactors;  // value selected from problem list
-   strFlagsOut   := '';   // flags updated with selected values from problem list
-   x := strFlagsAsIs;
-   Result := '';
+    strFlagsAsIs  := pFlagsAsIs; // flags from pims
+    strTFactors   :=  pPLFactors;  // value selected from problem list
+    strFlagsOut   := '';   // flags updated with selected values from problem list
+    x := strFlagsAsIs;
+    Result := '';
 
     UBAGlobals.SC  := Copy(x,1,1);
@@ -1279,4 +1276,8 @@
           UBAGlobals.MST := 'C';
 
+    if UBAGlobals.HNC <> 'N' then
+       if StrPos(PChar(strTFactors),PChar(HEAD_NECK_CANCER)) <> nil then
+          UBAGlobals.HNC := 'C';
+
     if UBAGlobals.CV <>'N' then
        if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then
@@ -1289,10 +1290,10 @@
 end;
 
-procedure GetBAStatus(pProvider:int64; pLocation:integer);
+procedure GetBAStatus(pProvider:int64; pPatientDFN: string);
 begin
   // sets global switch, based in value returned from server.
   // True ->  Billing Aware Switch ON. else OFF
 
-  UBACore.rpcSetBillingAwareSwitch(pProvider,pLocation);
+  UBACore.rpcSetBillingAwareSwitch(pProvider,pPatientDFN);
 
   if Assigned(UBAGlobals.BAPCEDiagList) then UBAGlobals.BAPCEDiagList.Clear;
@@ -1374,4 +1375,6 @@
    Result := (strSC + strAO + strIR + strEC + strMST + strHNC + strCV);
 end;
+
+
 // Delete dc'd orders from BACopiedOrderList to keep things in sync.
 procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
@@ -1396,5 +1399,5 @@
 procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
 var
- AnOrder,x: string;
+ x: string;
  var i,j: integer;
  holdList : TStringList;
@@ -1425,22 +1428,50 @@
 end;
 
-{function  SetOrderIDConsultDxRequired(pOrderID:string):string;
-var
-  i: integer;
-  orderIdIN, OrderIdOut,x: string;
-begin
-   result := '';
-   for i := 0 to UBAGlobals.BAConsultOrdersRequireDx.Count-1 do
-   begin
-      orderIdIN := pOrderID;
-      x := UBAGlobals.BAConsultOrdersRequireDx.Strings[i];
-      if orderIdIN = UBAGlobals.BAConsultOrdersRequireDx.Strings[i] then
-             orderIdOUT := 'CONSULT_DX' // consult requires dx entry. enable display of cidc and non-cidc
-          else
-             orderIdOUT := orderIdIN;
-   end;
-   result := OrderIdOut;
-end;
-      }
+// loop thru CIDC records remove records with invalid orderid
+function  VerifyOrderIdExists(pOrderList: TStringList): TStringList;
+var
+  goodList: TStringList;
+  tOrderID: integer;
+ i: integer;
+begin
+  goodList := TStringList.Create;
+  goodList.clear;
+
+  if pOrderList.Count > 0 then
+  begin
+      for i := 0 to pOrderList.Count-1 do
+      begin
+         tOrderID := StrToIntDef(Piece(pOrderList.Strings[i],';',1), 0);
+         if tOrderID > 0 then
+            goodList.add(pOrderList.Strings[i]);
+      end;
+  end;
+  result := goodList;
+end;
+
+// parse string return Treatment Factors when text inlcudes multiple "(())"
+//HDS8409
+function  ProcessProblemTFactors(pText:String):String;
+var AText1,x: string;
+    i,j: integer;
+begin
+ if StrPos(PChar(pText),'(') = nil then exit;
+ AText1 := Piece(pText,U,2);
+ i := 1;
+ j := 0;
+ while j = 0 do
+ begin
+    x := Piece(AText1,'(',i);
+    if Length(x) > 0 then
+       inc(i)
+    else
+    begin
+       x := Piece(AText1,'(',i-1);
+       x := Piece(x,')',1);
+       j := 1;
+       Result := x;
+    end;
+  end;
+end;
 
 end.
