Ignore:
Timestamp:
Jul 6, 2008, 8:20:14 PM (16 years ago)
Author:
Kevin Toppenberg
Message:

Uploading from OR_30_258

Location:
cprs/branches/foia-cprs/CPRS-Chart/BA
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/foia-cprs/CPRS-Chart/BA/UBACore.pas

    r459 r460  
    1111function  rpcGetPersonalDxList(UserDUZ:int64):TStringList;
    1212function  rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer;
    13 procedure rpcSaveBillingData(pBillingData:TStringList);
     13procedure rpcSaveBillingDxEntered;  // save dx enteries regardless of being mandatory....
    1414function  rpcNonBillableOrders(pOrderList: TStringList): TStringList;
    1515function  rpcOrderRequiresDx(pList: TStringList):boolean;
    16 procedure rpcSetBillingAwareSwitch(encProvider: int64; encLocation: integer);
     16procedure rpcSetBillingAwareSwitch(encProvider: int64; pPatientDFN: string);
    1717procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
    1818procedure rpcGetSC4Orders;    // returns Eligible Treatment Factors for a given patient
    19 procedure rpcSaveBillingDxEntered;  // save dx enteries regardless of being mandatory....
     19
    2020function  rpcTreatmentFactorsActive(pOrderID: string):boolean;
    2121procedure rpcBuildSCIEList(pOrderList: TList);
    2222function  rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList;
    23 function  rpcRetrieveBillingData(thisOrderID: string; var thisBAData: string) : boolean;
    2423function  rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList;
    2524function  rpcGetTFHintData:TStringList;
    2625procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
    2726function  rpcGetBAMasterSwStatus:boolean;
    28 
     27procedure rpcSaveCIDCData(pCIDCList: TStringList);
     28function  rpcIsPatientInsured(pPatientDFN: string):boolean;
     29
     30procedure SaveBillingData(pBillingData:TStringList);
    2931function  OrdersHaveDx(pOrderList:TStringList):boolean;
    3032procedure SetTreatmentFactors(TFactors: string);
    … …  
    3234procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);
    3335procedure BALoadStsFlagsAsIs(StsFlagsIN: string);
    34 function  BADxEntered:boolean;                                //  This will only be executed if bypass switch is set...
     36function  BADxEntered:boolean;  //  main logic to determine if dx has been entered for order that requires dx
    3537function  StripTFactors(FactorsIN: string): string;
    3638function  AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList;
    … …  
    5254function  GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string;
    5355function  SetConsultFlags(pPLFactors: string;pFlagsAsIs: string):string; //  return updated flags.
    54 procedure GetBAStatus(pProvider:int64; pLocation:integer);
     56procedure GetBAStatus(pProvider:int64; pPatientDFN: string);
    5557function  IsICD9CodeActive(ACode: string; LexApp: string; ADate:TFMDateTime = 0): boolean;
    5658function  BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string;
    5759function  ConvertPIMTreatmentFactors(pTFactors:string):string;
    5860procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
    59 //function  SetOrderIDConsultDxRequired(pOrderID:String):String; // replace orderid with "R" if consult dx required.
    6061procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
    61 
    62 
    63 
     62function  VerifyOrderIdExists(pOrderList: TStringList): TStringList; // removes records without order id
     63function  IsCIDCProvider(encProvider:int64):boolean;
     64function  ProcessProblemTFactors(pText:String):String;
    6465
    6566var
    … …  
    7576
    7677
    77 function rpcRetrieveBillingData(thisOrderID: string; var thisBAData: string) : boolean;
    78 var
    79   rpcResult: TStringList;
    80   BAOrderExists : boolean;
    81 begin
    82   Result := false;
    83   BAOrderExists := false;
    84   rpcResult := TStringList.Create;
    85 
    86   tCallV(rpcResult, 'ORWDBA1 RCVORCI', [thisOrderID]);
    87   BAOrderExists := StrToBool(rpcResult[0]);
    88 
    89   if (not BAOrderExists) then
    90      //GRAB RETURNED BA DATA HERE
    91      Result := true;
    92 end;
    93 
    94 procedure rpcSaveBillingData(pBillingData:TStringList);
     78// -----------------  MAIN CIDC DX HAS BEEN ENTERED LOGIC  ---------------------------
     79function BADxEntered:boolean;
     80var
     81  i: integer;
     82  //orderStatus: integer;
     83  x: string;
     84  passList: TStringList;
     85  holdOrderList: TStringList;
     86  thisOrderID: string;
     87  thisRec: string;
     88begin
     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   BAOrderList.Assign(holdOrderList); //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      BAOrderList.Assign(updatedBAOrderList);
     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;
     140end;
     141
     142
     143function rpcOrderRequiresDx(pList: TStringList):boolean;
     144var 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       updatedList.Assign(pList);
     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;
     183end;
     184
     185
     186// UBAGlobals.NonBillableOrderList must be populated prior to calling this function.
     187// call   rpcNonBillableOrders to populate List.
     188function IsOrderBillable(pOrderID: string):boolean ;
     189var
     190  i: integer;
     191  currOrderID: string;
     192  matchOrderID : string;
     193
     194begin
     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}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif}
     216        raise;
     217        end;
     218  end;
     219end;
     220
     221
     222procedure SaveBillingData(pBillingData:TStringList);
    95223var
    96224  RecsToSave: TStringList;
    97   i: integer;
    98   x: string;
    99225begin
    100226  RecsToSave := TStringList.Create;
    101227  RecsToSave.Clear;
     228
    102229  RecsToSave := AttachDxToOrderList(pBillingData); //call with new Biling data, return-code returned
    103  // for i := 0 to RecstoSave.Count-1 do
    104  // begin
    105 //      ShowMessage('Data Sent to ORW ' + RecsToSave.Strings[i]);
    106  // end;
    107   CallV('ORWDBA1 RCVORCI',[RecsToSave]);
    108  // if Assigned(UBAGlobals.BAConsultOrdersRequireDx) then UBAGlobals.BAConsultOrdersRequireDx.Clear;
     230  rpcSaveCIDCData(RecsToSave);  // verify and save billing data
     231
    109232  if Assigned(UBAGlobals.BAOrderList) then UBAGlobals.BAOrderList.Clear; // hds00005025
    110233end;
    … …  
    123246      pList.Add(pOrderID);
    124247      Result := FALSE;
    125       // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
     248     // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
    126249      tCallV(rList,'ORWDBA1 ORPKGTYP',[pList]);
    127250     //returns boolean value by OrderID - True = billable
    … …  
    158281     currentOrderString := pOrderList.Strings[i];
    159282     currentOrderID := piece(pOrderList.Strings[i],';',1)+ ';1';
     283
    160284     GetBADxListForOrder(baseDxRec, currentOrderID);
    161285     FlagsStatsIn := BAFlagsIN;
    … …  
    174298end;
    175299
    176 
    177 
    178300function  rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean;
    179 //input example ien^code = 12345^306.70
    180 begin
    181   Result := (sCallV('ORWDBA2 ADDPDL', [UserDUZ,DxCodes])= '1');
     301//input example ien^code(s) = 12345^306.70^431.22
     302begin
     303   Result := (sCallV('ORWDBA2 ADDPDL', [UserDUZ,DxCodes])= '1');
    182304end;
    183305
    … …  
    198320end;
    199321
    200 function rpcOrderRequiresDx(pList: TStringList):boolean;
    201 var x: string;
    202     i,j: integer;
    203     returnList, updatedList: TStringList;
    204    begin
    205 //   for i := 0 to plist.count-1 do
    206 //      x := plist.strings[i];
    207     Result := FALSE;
    208     returnList := TStringList.Create;
    209     updatedList := TStringList.Create;
    210     returnList.Clear;
    211     updatedList.Clear;
    212     // remove deleted orderid's
    213     if UBAGlobals.BADeltedOrders.Count > 0 then
    214     begin
    215        for i := 0 to UBAGlobals.BADeltedOrders.Count-1 do
    216           x := UBAGlobals.BADeltedOrders.Strings[i];
    217          for j := 0 to pList.Count-1 do
    218          begin
    219             if x = pList.Strings[j] then
    220             continue   // orderid is removed.. or skipped
    221             else
    222                updatedList.Add(x);
    223          end;
    224     end
    225     else
    226        updatedList.Assign(pList);
    227     // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
    228     tCallV(returnList,'ORWDBA1 ORPKGTYP',[updatedList]);
    229      //Remove NON LRMP orders from the mix(for checking for dx entry);
    230      // BAOrderList and pList are in sync - order id....
    231      for i := 0 to BAOrderList.Count-1 do
    232      begin
    233         x:= piece(returnList.Strings[i],'^',1);
    234         if x = BILLABLE_ORDER  then   // change to test BA
    235         begin
    236            updatedBAOrderList.Add(BAOrderList[i]);
    237            Result := TRUE;
    238         end;
    239     end;
    240 end;
    241322// returns value used to bypass Billing Aware if needed.
    242323//  turns off visual and functionality
    243 procedure rpcSetBillingAwareSwitch(encProvider:int64; encLocation: integer);
    244 begin
    245    BILLING_AWARE := TRUE;
    246    if (encProvider = 0) and not PersonHasKey(encProvider, 'PROVIDER') then
    247       BILLING_AWARE := FALSE
    248    else
    249    begin
    250       if  (sCallV('ORWDBA1 BASTATUS', [nil]) = '1') then    //  Master switch is set "ON"
    251        BILLING_AWARE :=  (sCallV('ORWDBA4 GETBAUSR', [encProvider]) = '1')
    252       else
    253          BILLING_AWARE := FALSE;
    254       end;
    255 end ;
     324procedure rpcSetBillingAwareSwitch(encProvider:int64; pPatientDFN: string);
     325begin
     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           if  rpcIsPatientInsured(pPatientDFN)  then
     337              BILLING_AWARE := TRUE;
     338        end;
     339       {$ifdef debug}BILLING_AWARE := TRUE;{$endif}
     340end;
     341
     342//  verify CIDC Master Switch and Provider is CIDC Enabled.
     343//  Patient insurance check is bypassed.  (hds7564)
     344function  IsCIDCProvider(encProvider:int64):boolean;
     345begin
     346    Result := False;
     347    if rpcGetBAMasterSwStatus then
     348       if (encProvider <> 0) and PersonHasKey(encProvider, 'PROVIDER') then
     349          Result := True;
     350end;
     351
    256352
    257353function rpcGetBAMasterSwStatus:boolean;
    258354begin
    259    Result := False;
    260355   Result :=  (sCallV('ORWDBA1 BASTATUS', [nil]) = '1');    //  Master switch is set "ON"
    261 
    262 
    263 end;
     356end;
     357
    264358
    265359procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList);
    266360begin
    267     CallV('ORWDBA1 RCVORCI',[pOrderRec]);
    268 end;
     361    rpcSaveCIDCData(pOrderRec);
     362end;
     363
    269364
    270365procedure rpcSaveBillingDxEntered;  // if not mandatory and user enters dx.
    … …  
    295390        baseDxRec := nil;
    296391        baseDxRec := TBADxRecord.Create;
    297        InitializeNewDxRec(baseDxRec);
    298 
    299   try
     392        InitializeNewDxRec(baseDxRec);
     393
     394       try
    300395       for i := 0 to BAOrderList.Count-1 do
    301396       begin
    … …  
    305400          if baseDxRec.FBADxCode <> '' then
    306401          begin
    307                 NewBillingList.Add(currentOrderString +'^'+ baseDxRec.FBADxCode +'^'+ baseDxRec.FBASecDx1+
     402             NewBillingList.Add(currentOrderString +'^'+ baseDxRec.FBADxCode +'^'+ baseDxRec.FBASecDx1+
    308403                                '^'+ baseDxRec.FBASecDx2+'^'+ baseDxRec.FBASecDx3);
    309404          end;
    310405       end;
    311   except
    312      on EListError do
    313      begin
    314         {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
    315         raise;
     406       except
     407       on EListError do
     408       begin
     409         {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
     410         raise;
    316411     end;
    317412  end;
    318413
    319    if NewBillingList.Count > 0 then
    320       CallV('ORWDBA1 RCVORCI',[NewBillingList]); //1.3.10
    321 
     414   rpcSaveCIDCData(NewBillingList);
    322415   if Assigned(NewBillingList) then FreeAndNil(NewBillingList);
    323  //  if Assigned(UBAGlobals.BAConsultOrdersRequireDx) then UBAGlobals.BAConsultOrdersRequireDx.Clear;
    324 
    325416  end;
    326417end;
    … …  
    335426
    336427procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string);
    337 var i:integer;
    338     x: string;
     428var
    339429    tmplst: TStringList;
    340430begin
    … …  
    351441function rpcGetTFHintData:TStringList;
    352442begin
    353   Result := nil;
    354443  tCallv(BATFHints,'ORWDBA3 HINTS', [nil]);
    355444  Result := BATFHints;
    … …  
    366455    rList.Clear;
    367456    NonBillableOrderList.Clear;
    368     Result := NonBillableOrderList;
    369457    // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
    370458    tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
    … …  
    396484      end;
    397485      // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
    398      tCallV(rList,'ORWDBA1 ORPKGTYP',[OrderIDList]);
     486      tCallV(rList,'ORWDBA1 ORPKGTYP',[OrderIDList]);
    399487
    400488     for i := 0 to rList.Count-1 do
    … …  
    403491           OrderListSCEI.Add(OrderIDList.Strings[i]);
    404492   end;
     493end;
     494
     495procedure rpcSaveCIDCData(pCIDCList: TStringList);
     496var
     497 CIDCList :TStringList;
     498begin
     499    CIDCList := TStringList.create;
     500    CIDCList.Clear;
     501    // insure record contain valid orderid
     502    if pCIDCList.Count > 0 then
     503    begin
     504       CIDCList := VerifyOrderIdExists(pCIDCList);
     505       if CIDCList.Count > 0 then
     506          CallV('ORWDBA1 RCVORCI',[CIDCList]);
     507    end;
     508    if Assigned(CIDCList) then FreeAndNil(CIDCList);
     509end;
     510
     511function  rpcIsPatientInsured(pPatientDFN: string):boolean;
     512begin
     513   Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) = '1');
     514     
    405515end;
    406516
    … …  
    433543             if tempDxRec.FBADxCode = '' then
    434544                begin
    435                 Result := FALSE;
    436                 Break;
     545                   Result := FALSE;
     546                   Break;
    437547                end;
    438548          end;
    … …  
    452562
    453563
    454 function BADxEntered:boolean;
    455 var
    456   i, orderStatus: integer;
    457   x: string;
    458   passList: TStringList;
    459   holdOrderList: TStringList;
    460   thisOrderID: string;
    461   thisRec: string;
    462 begin
    463    Result := FALSE;
    464    holdOrderList := TStringList.Create;
    465    holdOrderList.Clear;
    466    updatedBAOrderList := TStringList.Create;
    467    updatedBAOrderList.Clear;
    468    passList := TStringList.Create;
    469    passList.Clear;
    470    // determine which orders require a dx (lrmp- only)
    471    // if NO then continue
    472    // if YES, check BADxList for orders with DX enteries.
    473    // if ok then create data string pass to M via RPC
    474 
    475    orderStatus := 0;
    476    Result := true;
    477 
    478   try
    479    for i := 0 to BAOrderList.Count-1 do
    480    begin
    481          thisRec := BAOrderList.Strings[i];
    482          thisOrderID := piece(thisRec,';',1) + ';1';  //rebuild orderID pass to M.
    483 
    484          x := BAOrderList.Strings[i];
    485          orderStatus := StrToInt(CharAt(Piece(x, ';', 2), 1));  //  Order Status 1=OK, 2=DISCONTINUE
    486          if orderStatus = integer(BAOK2SIGN) then
    487          begin
    488             passList.Add(piece(x,';',1));
    489             holdOrderList.Add(x);//  place holder for orders that can be signed!
    490          end;
    491    end;
    492   except
    493      on EListError do
    494         begin
    495         {$ifdef debug}ShowMessage('EListError in UBACore.BADxEntered()');{$endif}
    496         raise;
    497         end;
    498   end;
    499 
    500    BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing
    501    holdOrderList.Clear; // CQ5025
    502      //call with passList determine if LRMP
    503 
    504    if rpcOrderRequiresDx(passList) then
    505       BAOrderList.Assign(updatedBAOrderList);
    506 
    507    if updatedBAOrderList.Count <= 0 then   //  order list reflecting orders flagged as -
    508       begin                           // dx required.
    509       Result := TRUE;              //  force true, no record need DX entry
    510       rpcSaveBillingDxEntered;        // save billing data for orders that may have dx enteries
    511       Exit;                        //to do.  clean this up... when time permitts
    512       end
    513    else
    514       begin
    515       if OrdersHaveDx(UBAGlobals.BAOrderList) then
    516          rpcSaveBillingData(UBAGlobals.BAOrderList)
    517       else
    518          begin
    519             Result := FALSE;
    520             Exit;
    521          end;
    522      end;
    523 end;
    524564
    525565
    … …  
    557597    thisRec.FBASC                := Piece(ProblemRec,U,5);
    558598    thisRec.FBASC_YN             := Piece(ProblemRec,U,6);
    559     thisRec.FBATreatFactors  := Piece(ProblemRec,')',1);
    560     thisRec.FBATreatFactors  := Piece(thisRec.FBATreatFactors,'(',2);
    561 
     599    //HDS8409
     600    if StrPos(PChar(ProblemRec),'(') <> nil then
     601       thisRec.FBATreatFactors :=  ProcessProblemTFactors(ProblemRec)
     602    else
     603    begin
     604       thisRec.FBATreatFactors  := Piece(ProblemRec,')',1);
     605       thisRec.FBATreatFactors  := Piece(thisRec.FBATreatFactors,'(',2);
     606    end;
     607    //HDS8409
    562608  with thisRec do
    563609  begin
    … …  
    571617           TFResults := ( FBADxCode + U  + FBADxText );
    572618  end;
    573      
     619
    574620    Dest := TFResults;
    575621end;
    … …  
    657703var strDxCode,strDxName:string;
    658704begin
    659     Result := '';
    660     strDxCode := Piece(FactorsIN,U,2);
    661     strDxName := Piece(FactorsIN,'(',1);
    662     Result := (strDxName + U + strDxCode);
     705   Result := '';
     706   strDxCode := Piece(FactorsIN,U,2);
     707   strDxName := Piece(FactorsIN,'(',1);
     708   Result := (strDxName + U + strDxCode);
    663709end;
    664710
    … …  
    684730
    685731    Result := tmplst;
    686 end;
    687 
    688 // UBAGlobals.NonBillableOrderList must be populated prior to calling this function.
    689 // call   rpcNonBillableOrders to populate List.
    690 function IsOrderBillable(pOrderID: string):boolean ;
    691 var
    692   i: integer;
    693   currOrderID: string;
    694   matchOrderID : string;
    695 
    696 begin
    697   Result := TRUE;    //  = Billable
    698   currOrderID := PrepOrderID(pOrderID);
    699   if Piece(pOrderID,';',2) = DISCONTINUED_ORDER THEN
    700   begin
    701      Result := FALSE;
    702      Exit;
    703   end;
    704   try
    705      for i := 0 to UBAGlobals.NonBillableOrderList.Count -1 do
    706      begin
    707         matchOrderID := PrepOrderID( (Piece(UBAGlobals.NonBillableOrderList.Strings[i],U,1)) );
    708         if currOrderID = matchOrderID  then
    709            Result := FALSE  //= Non Billable
    710      end;
    711   except
    712      on EListError do
    713         begin
    714         {$ifdef debug}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif}
    715         raise;
    716         end;
    717   end;
    718732end;
    719733
    … …  
    748762     // this change may have an impact on response time??????
    749763     // change from save orders with dx to save all. 06/24/04
    750   // /  if not  clear treatment factors for order is non cidc
     764     // /  if not  clear treatment factors for order is non cidc
    751765   uBAGlobals.UnsignedOrders.Add(pOrderRec);
    752766
    … …  
    764778   if Assigned(rList) then rList.Clear;
    765779   if Assigned(newList) then newList.Clear;
    766    
    767      for i := 0 to pOrderIDList.Count-1 do
    768      begin
    769         newList.Add(Piece(pOrderIDList.Strings[i],';',1));
    770         x := newlist.strings[i];
    771      end;
     780
     781   for i := 0 to pOrderIDList.Count-1 do
     782   begin
     783      newList.Add(Piece(pOrderIDList.Strings[i],';',1));
     784      x := newlist.strings[i];
     785   end;
    772786   if newList.Count > 0 then
    773787      tCallV(rList,'ORWDBA4 GETTFCI',[newList]);
    … …  
    781795   thisList: TStringList;
    782796   rList: TStringList;
    783    i:integer;
    784    x: string;
    785797begin
    786798
    … …  
    789801  if Assigned(rList) then rList.Clear;
    790802  if Assigned(thisList)then thisList.Clear;
    791   for i := 0 to pOrderList.Count -1 do
    792      x := pOrderList.Strings[i];
    793      rpcSaveBillingData(pOrderList);  //  save unsigned info to be displayed when recalled at later time
     803  SaveBillingData(pOrderList);  //  save unsigned info to be displayed when recalled at later time
    794804end;
    795805
    … …  
    980990function  IsAllOrdersNA(pOrderList:TStringList):boolean;
    981991var
    982   i,j:integer;
     992  i:integer;
    983993  rList: TStringList;
    984994begin
    … …  
    986996  if Assigned(rList) then rList.Clear;
    987997  Result := True;// disables dx button
    988   for j := 0 to pOrderList.Count-1 do
    989   begin
    990      // code added to allow consult orders that are not cidc but require dx, dx can be edited.
    991     if tempDxNodeExists(pOrderList.Strings[j]) then
    992     begin
    993        Result := False;
    994        Exit;
    995     end
    996     else
    997         if Piece(pOrderList.Strings[j],';',2) = DISCONTINUED_ORDER then
    998         begin
    999            Result := True;
    1000            Exit;
    1001         end;
    1002 
    1003   end;
     998 
    1004999  // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
    10051000  tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]);
    … …  
    10971092               if pos( '(', thisString) > 0 then
    10981093                  begin
    1099                   dx2 := Piece(thisString,U,2);
    1100                   dx2 := Piece(dx2,'(',1)+ U + Piece(thisString,':',2);
     1094                     dx2 := Piece(thisString,U,2);
     1095                     dx2 := Piece(dx2,'(',1)+ U + Piece(thisString,':',2);
    11011096                  end
    11021097               else
    11031098                   begin
    1104                    dx2 := Piece(thisString,U,2);
    1105                    dx2 := Piece(dx2,':',1)+ U + Piece(thisString,':',2);
     1099                      dx2 := Piece(thisString,U,2);
     1100                      dx2 := Piece(dx2,':',1)+ U + Piece(thisString,':',2);
    11061101                   end
    11071102               end
    … …  
    11111106                  if pos( '(', thisString) > 0 then
    11121107                     begin
    1113                      dx3 := Piece(thisString,U,2);
    1114                      dx3 := Piece(dx3,'(',1)+ U + Piece(thisString,':',2);
     1108                        dx3 := Piece(thisString,U,2);
     1109                        dx3 := Piece(dx3,'(',1)+ U + Piece(thisString,':',2);
    11151110                     end
    11161111                  else
    11171112                     begin
    1118                      dx3  := Piece(thisString,U,2);
    1119                      dx3  := Piece(dx3,':',1)+ U + Piece(thisString,':',2);
     1113                        dx3  := Piece(thisString,U,2);
     1114                        dx3  := Piece(dx3,':',1)+ U + Piece(thisString,':',2);
    11201115                     end
    11211116                  end
    … …  
    11251120                     if pos( '(', thisString) > 0 then
    11261121                        begin
    1127                         dx4 := Piece(thisString,U,2);
    1128                         dx4 := Piece(dx4,'(',1)+ U + Piece(thisString,':',2);
     1122                           dx4 := Piece(thisString,U,2);
     1123                           dx4 := Piece(dx4,'(',1)+ U + Piece(thisString,':',2);
    11291124                        end
    11301125                     else
    11311126                        begin
    1132                         dx4 := Piece(thisString,U,2);
    1133                         dx4 := Piece(dx4,':',1)+ U + Piece(thisString,':',2);
     1127                           dx4 := Piece(thisString,U,2);
     1128                           dx4 := Piece(dx4,':',1)+ U + Piece(thisString,':',2);
    11341129                        end;
    11351130                     end;
    … …  
    12061201                dxRec := BuildConsultDxRec(ConsultOrderRec);
    12071202                orderList.Add(RecOut.FExistingRecordID);
    1208                 TfFlags := Piece(GetPatientTFactors(orderList),U,2);
     1203              //  TfFlags := Piece(GetPatientTFactors(orderList),U,2);
     1204                TfFlags := GetPatientTFactors(orderList);
     1205                TfFlags := ConvertPIMTreatmentFactors(TfFlags);
    12091206                orderList.Clear;
    1210                 if strLen(PChar(dxRec)) > 0 then
    1211                    orderList.Add(RecOut.FExistingRecordID +TfFlags + '^'+ BuildConsultDxRec(ConsultOrderRec) )
    1212                 else
     1207              //  if strLen(PChar(dxRec)) > 0 then
     1208              //     orderList.Add(RecOut.FExistingRecordID +TfFlags + '^'+ BuildConsultDxRec(ConsultOrderRec) )
     1209              //  else
    12131210                   orderList.Add(RecOut.FExistingRecordID +TfFlags);
    1214                 rpcSaveBillingData(OrderList);  //  save unsigned info to be displayed when re
     1211                SaveBillingData(OrderList);  //  save unsigned info to be displayed when re
    12151212             end;
    12161213          end;
    … …  
    12411238
    12421239begin
    1243    strFlagsAsIs  := pFlagsAsIs; // flags from pims
    1244    strTFactors   :=  pPLFactors;  // value selected from problem list
    1245    strFlagsOut   := '';   // flags updated with selected values from problem list
    1246    x := strFlagsAsIs;
    1247    Result := '';
     1240    strFlagsAsIs  := pFlagsAsIs; // flags from pims
     1241    strTFactors   :=  pPLFactors;  // value selected from problem list
     1242    strFlagsOut   := '';   // flags updated with selected values from problem list
     1243    x := strFlagsAsIs;
     1244    Result := '';
    12481245
    12491246    UBAGlobals.SC  := Copy(x,1,1);
    … …  
    12791276          UBAGlobals.MST := 'C';
    12801277
     1278    if UBAGlobals.HNC <> 'N' then
     1279       if StrPos(PChar(strTFactors),PChar(HEAD_NECK_CANCER)) <> nil then
     1280          UBAGlobals.HNC := 'C';
     1281
    12811282    if UBAGlobals.CV <>'N' then
    12821283       if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then
    … …  
    12891290end;
    12901291
    1291 procedure GetBAStatus(pProvider:int64; pLocation:integer);
     1292procedure GetBAStatus(pProvider:int64; pPatientDFN: string);
    12921293begin
    12931294  // sets global switch, based in value returned from server.
    12941295  // True ->  Billing Aware Switch ON. else OFF
    12951296
    1296   UBACore.rpcSetBillingAwareSwitch(pProvider,pLocation);
     1297  UBACore.rpcSetBillingAwareSwitch(pProvider,pPatientDFN);
    12971298
    12981299  if Assigned(UBAGlobals.BAPCEDiagList) then UBAGlobals.BAPCEDiagList.Clear;
    … …  
    13741375   Result := (strSC + strAO + strIR + strEC + strMST + strHNC + strCV);
    13751376end;
     1377
     1378
    13761379// Delete dc'd orders from BACopiedOrderList to keep things in sync.
    13771380procedure DeleteDCOrdersFromCopiedList(pOrderID:string);
    … …  
    13961399procedure UpdateBAConsultOrderList(pDcOrders: TStringList);
    13971400var
    1398  AnOrder,x: string;
     1401 x: string;
    13991402 var i,j: integer;
    14001403 holdList : TStringList;
    … …  
    14251428end;
    14261429
    1427 {function  SetOrderIDConsultDxRequired(pOrderID:string):string;
    1428 var
    1429   i: integer;
    1430   orderIdIN, OrderIdOut,x: string;
    1431 begin
    1432    result := '';
    1433    for i := 0 to UBAGlobals.BAConsultOrdersRequireDx.Count-1 do
    1434    begin
    1435       orderIdIN := pOrderID;
    1436       x := UBAGlobals.BAConsultOrdersRequireDx.Strings[i];
    1437       if orderIdIN = UBAGlobals.BAConsultOrdersRequireDx.Strings[i] then
    1438              orderIdOUT := 'CONSULT_DX' // consult requires dx entry. enable display of cidc and non-cidc
    1439           else
    1440              orderIdOUT := orderIdIN;
    1441    end;
    1442    result := OrderIdOut;
    1443 end;
    1444       }
     1430// loop thru CIDC records remove records with invalid orderid
     1431function  VerifyOrderIdExists(pOrderList: TStringList): TStringList;
     1432var
     1433  goodList: TStringList;
     1434  tOrderID: integer;
     1435 i: integer;
     1436begin
     1437  goodList := TStringList.Create;
     1438  goodList.clear;
     1439
     1440  if pOrderList.Count > 0 then
     1441  begin
     1442      for i := 0 to pOrderList.Count-1 do
     1443      begin
     1444         tOrderID := StrToIntDef(Piece(pOrderList.Strings[i],';',1), 0);
     1445         if tOrderID > 0 then
     1446            goodList.add(pOrderList.Strings[i]);
     1447      end;
     1448  end;
     1449  result := goodList;
     1450end;
     1451
     1452// parse string return Treatment Factors when text inlcudes multiple "(())"
     1453//HDS8409
     1454function  ProcessProblemTFactors(pText:String):String;
     1455var AText1,x: string;
     1456    i,j: integer;
     1457begin
     1458 if StrPos(PChar(pText),'(') = nil then exit;
     1459 AText1 := Piece(pText,U,2);
     1460 i := 1;
     1461 j := 0;
     1462 while j = 0 do
     1463 begin
     1464    x := Piece(AText1,'(',i);
     1465    if Length(x) > 0 then
     1466       inc(i)
     1467    else
     1468    begin
     1469       x := Piece(AText1,'(',i-1);
     1470       x := Piece(x,')',1);
     1471       j := 1;
     1472       Result := x;
     1473    end;
     1474  end;
     1475end;
    14451476
    14461477end.

  • cprs/branches/foia-cprs/CPRS-Chart/BA/UBAGlobals.pas

    r459 r460  
    316316   sourceOrderID: TStringList;
    317317   targetOrderIDLst: TStringList;
    318    i:integer;
    319    tempOrderStr:string;
    320318begin
    321319     //Retrieve TF's/CI's from SOURCE Order
    … …  
    371369   if UBAGlobals.tempDxNodeExists(thisOrderID) then
    372370     begin
    373      thisRec := TBADxRecord.Create;
    374371     if Assigned(tempDxList) then
    375372
    … …  
    523520begin
    524521  Result := 0;
    525   thisRec := TBADxRecord.Create;
    526522
    527523   if Assigned(tempDxList) then
    … …  
    580576  selectedOrders: smallint;
    581577begin
    582   Result := 0;
    583578  selectedOrders := 0;
    584579
    … …  
    762757   if UBAGlobals.tempDxNodeExists(thisOrderID) then
    763758     begin
    764      thisRec := TBADxRecord.Create;
    765759
    766760     if Assigned(tempDxList) then
    … …  
    878872  Result := false;
    879873
    880   thisRec := TBADxRecord.Create;
    881874     try
    882875        for i := 0 to tempDxList.Count - 1 do
    … …  
    909902  i: integer;
    910903begin
    911   thisRec := TBADxRecord.Create;
    912904
    913905  try
    … …  
    10131005// StringList used to store DX Codes selected from Encounter Form
    10141006var
    1015   BAVisitStr,BADxIEN: string;
    1016   BAFileCat    : char;
    1017   BAFileDateTimeStr: string;
     1007  BADxIEN: string;
    10181008  BAProviderStr, BAProviderName : string;
    1019   PList: TStringList;
    10201009  AList: TStringList;
    10211010begin
    … …  
    11061095begin
    11071096  Result := false;
    1108   thisRec := TBADxRecord.Create;
    11091097  if Assigned(tempDxList) then
    11101098     try

  • cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.dfm

    r459 r460  
    2121  PixelsPerInch = 96
    2222  TextHeight = 13
    23   object lblPatientName: TStaticText
    24     Left = 50
    25     Top = 3
    26     Width = 65
    27     Height = 17
    28     Caption = 'PatientName'
    29     TabOrder = 3
    30     TabStop = True
    31   end
    3223  object pnlTop: TPanel
    3324    Left = 0
    3425    Top = 0
    3526    Width = 612
    36     Height = 112
     27    Height = 96
    3728    Align = alTop
    3829    Caption = 'pnlTop'
    … …  
    4031    DesignSize = (
    4132      612
    42       112)
     33      96)
    4334    object lbOrders: TListBox
    44       Left = 8
    45       Top = 24
     35      Left = 7
     36      Top = 25
    4637      Width = 599
    4738      Height = 69
    … …  
    4940      IntegralHeight = True
    5041      ItemHeight = 13
    51       TabOrder = 1
     42      TabOrder = 2
    5243      OnMouseMove = lbOrdersMouseMove
    5344    end
    5445    object ORStaticText1: TORStaticText
    55       Left = 8
     46      Left = 216
    5647      Top = 8
    5748      Width = 169
    … …  
    5950      AutoSize = False
    6051      Caption = 'Selected Orders'
     52      TabOrder = 1
     53      TabStop = True
     54      OnEnter = ORStaticText1Enter
     55      OnExit = ORStaticText1Exit
     56    end
     57    object lblPatientName: TStaticText
     58      Left = 11
     59      Top = 9
     60      Width = 76
     61      Height = 17
     62      Caption = 'PatientName'
     63      Font.Charset = DEFAULT_CHARSET
     64      Font.Color = clWindowText
     65      Font.Height = -11
     66      Font.Name = 'MS Sans Serif'
     67      Font.Style = [fsBold]
     68      ParentFont = False
    6169      TabOrder = 0
    6270      TabStop = True
    63       OnEnter = ORStaticText1Enter
    64       OnExit = ORStaticText1Exit
    6571    end
    6672  end
    6773  object pnlMain: TPanel
    6874    Left = 0
    69     Top = 112
     75    Top = 96
    7076    Width = 612
    71     Height = 243
     77    Height = 259
    7278    Align = alClient
    7379    TabOrder = 1

  • cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.pas

    r459 r460  
    1818     end;
    1919  TfrmBALocalDiagnoses = class(TfrmAutoSz)
    20     lblPatientName: TStaticText;
    2120    pnlTop: TPanel;
    2221    lbOrders: TListBox;
    … …  
    3837    ORStaticText3: TORStaticText;
    3938    ORStaticText4: TORStaticText;
     39    lblPatientName: TStaticText;
    4040    procedure buOKClick(Sender: TObject);
    4141    procedure buCancelClick(Sender: TObject);
    … …  
    798798procedure TfrmBALocalDiagnoses.AddToProblemList;
    799799var
    800    i,j: integer;
    801    tempCode, passCode,x: string;
     800   i: integer;
     801   tempCode, passCode: string;
    802802   NewList: TStringList;
    803803   PatientInfo:string;

  • cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.dfm

    r459 r460  
    3030      TabOrder = 0
    3131      object Splitter1: TSplitter
    32         Left = 468
     32        Left = 458
    3333        Top = 26
    3434        Width = -3
    … …  
    3737      end
    3838      object Splitter2: TSplitter
    39         Left = 193
     39        Left = 169
    4040        Top = 26
    4141        Width = 7
    … …  
    4444      end
    4545      object Splitter3: TSplitter
    46         Left = 467
     46        Left = 457
    4747        Top = 26
    4848        Width = 1
    … …  
    5050        Cursor = crHSplit
    5151      end
    52       object Splitter4: TSplitter
    53         Left = 385
    54         Top = 26
    55         Width = 2
    56         Height = 463
    57         Cursor = crHSplit
    58       end
    5952      object Splitter5: TSplitter
    60         Left = 465
     53        Left = 455
    6154        Top = 26
    6255        Width = 2
    … …  
    112105        Left = 1
    113106        Top = 26
    114         Width = 192
     107        Width = 168
    115108        Height = 463
    116109        Align = alLeft
    … …  
    126119          Left = 0
    127120          Top = 17
    128           Width = 192
     121          Width = 161
    129122          Height = 446
    130           Align = alClient
    131123          Font.Charset = DEFAULT_CHARSET
    132124          Font.Color = clWindowText
    … …  
    148140          Left = 0
    149141          Top = 0
    150           Width = 192
     142          Width = 168
    151143          Height = 17
    152144          DragReorder = False
    … …  
    161153      end
    162154      object Panel4: TPanel
    163         Left = 200
    164         Top = 26
    165         Width = 185
     155        Left = 176
     156        Top = 26
     157        Width = 201
    166158        Height = 463
    167159        Align = alLeft
    … …  
    177169          Left = 0
    178170          Top = 17
    179           Width = 185
     171          Width = 201
    180172          Height = 446
    181           Align = alLeft
    182           Anchors = [akTop, akRight, akBottom]
     173          Align = alClient
    183174          ItemHeight = 13
    184175          MultiSelect = True
    185176          ParentShowHint = False
    186177          ShowHint = True
     178          Sorted = True
    187179          TabOrder = 0
    188180          OnClick = lbDiagnosisChange
    … …  
    196188          Left = 0
    197189          Top = 0
    198           Width = 185
     190          Width = 201
    199191          Height = 17
    200192          DragReorder = False
    … …  
    209201      end
    210202      object Panel5: TPanel
    211         Left = 465
    212         Top = 26
    213         Width = 247
     203        Left = 455
     204        Top = 26
     205        Width = 257
    214206        Height = 463
    215207        Align = alClient
    … …  
    220212          Left = 0
    221213          Top = 17
    222           Width = 247
     214          Width = 257
    223215          Height = 446
    224216          Align = alClient
    … …  
    229221          ParentShowHint = False
    230222          ShowHint = True
     223          Sorted = True
    231224          TabOrder = 0
    232225          OnClick = lbPersonalDxClick
    … …  
    238231          Left = 0
    239232          Top = 0
    240           Width = 247
     233          Width = 257
    241234          Height = 17
    242235          DragReorder = False
    … …  
    277270      end
    278271      object Panel7: TPanel
    279         Left = 387
     272        Left = 377
    280273        Top = 26
    281274        Width = 78

  • cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.pas

    r459 r460  
    2929    btnAdd: TBitBtn;
    3030    btnDelete: TBitBtn;
    31     Splitter4: TSplitter;
    3231    Splitter5: TSplitter;
    3332    Button1: TButton;
    … …  
    6564    procedure ListDiagnosesCodes(Section: String);
    6665    procedure InactiveICDNotification;
     66    procedure SyncDxDeleteList;
     67    procedure SyncDxNewList;
    6768 
    6869  public
    … …  
    123124    LoadEncounterDx;
    124125    ListDiagnosesSections(lbSections.Items);
    125     lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ);
     126  //  lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ);
     127    LoadPersonalDxList;
    126128    btnOK.Enabled := False;
    127129    hdrCntlDx.Sections[0].Width := lbPersonalDX.Width;
    128130    hdrCntlDxSections.Sections[0].Width := lbSections.Width;
    129131    hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width;
    130     lbPersonalDx.Sorted := false;
    131     lbPersonalDx.Sorted := True;
     132  //  lbPersonalDx.Sorted := false;
     133 //  lbPersonalDx.Sorted := True;
    132134    lbPersonalDX.Repaint;
    133135end;
    … …  
    374376procedure TfrmBAOptionsDiagnoses.btnDeleteClick(Sender: TObject);
    375377var
    376   delDxCode: string;
    377   i, c: integer;
    378 begin
    379   inherited;
    380   // save dx seleted for deletion, update file when ok is pressed
    381   for i := 0 to lbPersonalDX.Count-1 do
    382   begin
    383      if(lbPersonalDX.Selected[i]) then
    384      begin
    385         delDxCode := Piece(lbPersonalDX.Items[i],U,1);
    386         delDxLst.Add(delDxCode);
    387      end;
    388  end;
    389 
     378   i, c: integer;
     379begin
     380  inherited;
     381  SyncDxDeleteList;
     382  SyncDxNewList;
    390383 // delete selected dx from listbox.
    391384 with lbPersonalDX do
    … …  
    599592end;
    600593
     594procedure TfrmBAOptionsDiagnoses.SyncDxDeleteList;
     595var
     596 i: integer;
     597 delDxCode: string;
     598begin
     599// save dx selected for deletion, update file when ok is pressed
     600  for i := 0 to lbPersonalDX.Count-1 do
     601  begin
     602     if(lbPersonalDX.Selected[i]) then
     603     begin
     604        delDxCode := Piece(lbPersonalDX.Items[i],U,1);
     605        delDxLst.Add(delDxCode);
     606     end;
     607 end;
     608end;
     609
     610procedure TfrmBAOptionsDiagnoses.SyncDxNewList;
     611var
     612i,j :integer;
     613begin
     614 // remove diagnoses selected for deletion from newdxList;
     615   for i := 0 to lbPersonalDX.Count-1 do
     616   begin
     617      if lbPersonalDX.Selected[i] then
     618      begin
     619        for j := 0 to newDxLst.Count-1 do
     620        begin
     621           if (Piece(lbPersonalDX.Items[i],U,1)) = (newDxLst.Strings[j]) then
     622           begin
     623              newDxLst.Delete(j);
     624              Break;
     625           end;
     626        end;
     627     end;
     628  end;
     629end;
     630
     631
    601632initialization
    602633  uAddToPDL := 0;
Note: See TracChangeset for help on using the changeset viewer.