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. Index: cprs/branches/foia-cprs/CPRS-Chart/BA/UBAGlobals.pas =================================================================== --- cprs/branches/foia-cprs/CPRS-Chart/BA/UBAGlobals.pas (revision 459) +++ cprs/branches/foia-cprs/CPRS-Chart/BA/UBAGlobals.pas (revision 460) @@ -316,6 +316,4 @@ sourceOrderID: TStringList; targetOrderIDLst: TStringList; - i:integer; - tempOrderStr:string; begin //Retrieve TF's/CI's from SOURCE Order @@ -371,5 +369,4 @@ if UBAGlobals.tempDxNodeExists(thisOrderID) then begin - thisRec := TBADxRecord.Create; if Assigned(tempDxList) then @@ -523,5 +520,4 @@ begin Result := 0; - thisRec := TBADxRecord.Create; if Assigned(tempDxList) then @@ -580,5 +576,4 @@ selectedOrders: smallint; begin - Result := 0; selectedOrders := 0; @@ -762,5 +757,4 @@ if UBAGlobals.tempDxNodeExists(thisOrderID) then begin - thisRec := TBADxRecord.Create; if Assigned(tempDxList) then @@ -878,5 +872,4 @@ Result := false; - thisRec := TBADxRecord.Create; try for i := 0 to tempDxList.Count - 1 do @@ -909,5 +902,4 @@ i: integer; begin - thisRec := TBADxRecord.Create; try @@ -1013,9 +1005,6 @@ // StringList used to store DX Codes selected from Encounter Form var - BAVisitStr,BADxIEN: string; - BAFileCat : char; - BAFileDateTimeStr: string; + BADxIEN: string; BAProviderStr, BAProviderName : string; - PList: TStringList; AList: TStringList; begin @@ -1106,5 +1095,4 @@ begin Result := false; - thisRec := TBADxRecord.Create; if Assigned(tempDxList) then try Index: cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.dfm =================================================================== --- cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.dfm (revision 459) +++ cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.dfm (revision 460) @@ -21,18 +21,9 @@ PixelsPerInch = 96 TextHeight = 13 - object lblPatientName: TStaticText - Left = 50 - Top = 3 - Width = 65 - Height = 17 - Caption = 'PatientName' - TabOrder = 3 - TabStop = True - end object pnlTop: TPanel Left = 0 Top = 0 Width = 612 - Height = 112 + Height = 96 Align = alTop Caption = 'pnlTop' @@ -40,8 +31,8 @@ DesignSize = ( 612 - 112) + 96) object lbOrders: TListBox - Left = 8 - Top = 24 + Left = 7 + Top = 25 Width = 599 Height = 69 @@ -49,9 +40,9 @@ IntegralHeight = True ItemHeight = 13 - TabOrder = 1 + TabOrder = 2 OnMouseMove = lbOrdersMouseMove end object ORStaticText1: TORStaticText - Left = 8 + Left = 216 Top = 8 Width = 169 @@ -59,15 +50,30 @@ AutoSize = False Caption = 'Selected Orders' + TabOrder = 1 + TabStop = True + OnEnter = ORStaticText1Enter + OnExit = ORStaticText1Exit + end + object lblPatientName: TStaticText + Left = 11 + Top = 9 + Width = 76 + Height = 17 + Caption = 'PatientName' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False TabOrder = 0 TabStop = True - OnEnter = ORStaticText1Enter - OnExit = ORStaticText1Exit end end object pnlMain: TPanel Left = 0 - Top = 112 + Top = 96 Width = 612 - Height = 243 + Height = 259 Align = alClient TabOrder = 1 Index: cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.pas =================================================================== --- cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.pas (revision 459) +++ cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.pas (revision 460) @@ -18,5 +18,4 @@ end; TfrmBALocalDiagnoses = class(TfrmAutoSz) - lblPatientName: TStaticText; pnlTop: TPanel; lbOrders: TListBox; @@ -38,4 +37,5 @@ ORStaticText3: TORStaticText; ORStaticText4: TORStaticText; + lblPatientName: TStaticText; procedure buOKClick(Sender: TObject); procedure buCancelClick(Sender: TObject); @@ -798,6 +798,6 @@ procedure TfrmBALocalDiagnoses.AddToProblemList; var - i,j: integer; - tempCode, passCode,x: string; + i: integer; + tempCode, passCode: string; NewList: TStringList; PatientInfo:string; Index: cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.dfm =================================================================== --- cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.dfm (revision 459) +++ cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.dfm (revision 460) @@ -30,5 +30,5 @@ TabOrder = 0 object Splitter1: TSplitter - Left = 468 + Left = 458 Top = 26 Width = -3 @@ -37,5 +37,5 @@ end object Splitter2: TSplitter - Left = 193 + Left = 169 Top = 26 Width = 7 @@ -44,5 +44,5 @@ end object Splitter3: TSplitter - Left = 467 + Left = 457 Top = 26 Width = 1 @@ -50,13 +50,6 @@ Cursor = crHSplit end - object Splitter4: TSplitter - Left = 385 - Top = 26 - Width = 2 - Height = 463 - Cursor = crHSplit - end object Splitter5: TSplitter - Left = 465 + Left = 455 Top = 26 Width = 2 @@ -112,5 +105,5 @@ Left = 1 Top = 26 - Width = 192 + Width = 168 Height = 463 Align = alLeft @@ -126,7 +119,6 @@ Left = 0 Top = 17 - Width = 192 + Width = 161 Height = 446 - Align = alClient Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -148,5 +140,5 @@ Left = 0 Top = 0 - Width = 192 + Width = 168 Height = 17 DragReorder = False @@ -161,7 +153,7 @@ end object Panel4: TPanel - Left = 200 - Top = 26 - Width = 185 + Left = 176 + Top = 26 + Width = 201 Height = 463 Align = alLeft @@ -177,12 +169,12 @@ Left = 0 Top = 17 - Width = 185 + Width = 201 Height = 446 - Align = alLeft - Anchors = [akTop, akRight, akBottom] + Align = alClient ItemHeight = 13 MultiSelect = True ParentShowHint = False ShowHint = True + Sorted = True TabOrder = 0 OnClick = lbDiagnosisChange @@ -196,5 +188,5 @@ Left = 0 Top = 0 - Width = 185 + Width = 201 Height = 17 DragReorder = False @@ -209,7 +201,7 @@ end object Panel5: TPanel - Left = 465 - Top = 26 - Width = 247 + Left = 455 + Top = 26 + Width = 257 Height = 463 Align = alClient @@ -220,5 +212,5 @@ Left = 0 Top = 17 - Width = 247 + Width = 257 Height = 446 Align = alClient @@ -229,4 +221,5 @@ ParentShowHint = False ShowHint = True + Sorted = True TabOrder = 0 OnClick = lbPersonalDxClick @@ -238,5 +231,5 @@ Left = 0 Top = 0 - Width = 247 + Width = 257 Height = 17 DragReorder = False @@ -277,5 +270,5 @@ end object Panel7: TPanel - Left = 387 + Left = 377 Top = 26 Width = 78 Index: cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.pas =================================================================== --- cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.pas (revision 459) +++ cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.pas (revision 460) @@ -29,5 +29,4 @@ btnAdd: TBitBtn; btnDelete: TBitBtn; - Splitter4: TSplitter; Splitter5: TSplitter; Button1: TButton; @@ -65,4 +64,6 @@ procedure ListDiagnosesCodes(Section: String); procedure InactiveICDNotification; + procedure SyncDxDeleteList; + procedure SyncDxNewList; public @@ -123,11 +124,12 @@ LoadEncounterDx; ListDiagnosesSections(lbSections.Items); - lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ); + // lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ); + LoadPersonalDxList; btnOK.Enabled := False; hdrCntlDx.Sections[0].Width := lbPersonalDX.Width; hdrCntlDxSections.Sections[0].Width := lbSections.Width; hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width; - lbPersonalDx.Sorted := false; - lbPersonalDx.Sorted := True; + // lbPersonalDx.Sorted := false; + // lbPersonalDx.Sorted := True; lbPersonalDX.Repaint; end; @@ -374,18 +376,9 @@ procedure TfrmBAOptionsDiagnoses.btnDeleteClick(Sender: TObject); var - delDxCode: string; - i, c: integer; -begin - inherited; - // save dx seleted for deletion, update file when ok is pressed - for i := 0 to lbPersonalDX.Count-1 do - begin - if(lbPersonalDX.Selected[i]) then - begin - delDxCode := Piece(lbPersonalDX.Items[i],U,1); - delDxLst.Add(delDxCode); - end; - end; - + i, c: integer; +begin + inherited; + SyncDxDeleteList; + SyncDxNewList; // delete selected dx from listbox. with lbPersonalDX do @@ -599,4 +592,42 @@ end; +procedure TfrmBAOptionsDiagnoses.SyncDxDeleteList; +var + i: integer; + delDxCode: string; +begin +// save dx selected for deletion, update file when ok is pressed + for i := 0 to lbPersonalDX.Count-1 do + begin + if(lbPersonalDX.Selected[i]) then + begin + delDxCode := Piece(lbPersonalDX.Items[i],U,1); + delDxLst.Add(delDxCode); + end; + end; +end; + +procedure TfrmBAOptionsDiagnoses.SyncDxNewList; +var +i,j :integer; +begin + // remove diagnoses selected for deletion from newdxList; + for i := 0 to lbPersonalDX.Count-1 do + begin + if lbPersonalDX.Selected[i] then + begin + for j := 0 to newDxLst.Count-1 do + begin + if (Piece(lbPersonalDX.Items[i],U,1)) = (newDxLst.Strings[j]) then + begin + newDxLst.Delete(j); + Break; + end; + end; + end; + end; +end; + + initialization uAddToPDL := 0;