Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTUBO1

IBTUBO1.m

Go to the documentation of this file.
  1. IBTUBO1 ;ALB/AAS - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;29-SEP-94
  1. ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,247,155,277,339,399,516,547**;21-MAR-94;Build 119
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. OPT(IBOE,IBQUERY) ; - Has the outpatient encounter been billed?
  1. ; Input: IBOE=pointer to outpatient encounter in file #409.68
  1. ; (NOTE: this value may be null)
  1. ; IBQUERY (Passed by reference)=flag that is incremented when
  1. ; the Scheduling query API is invoked
  1. ; *Pre-set variables: DFN=patient IEN, IBDT=event date, IBRT=bill rate,
  1. ; IBEDT=End of reporting period date.
  1. ; IBX=ien of CLAIMS TRACKING entry file 356
  1. ;
  1. I '$G(DFN)!('$G(IBDT))!('$G(IBRT))!'$G(IBX) G OPTQ
  1. N IBCN,IBCPT,IBCPTSUM,IBCT,IBDATA,IBDAY,IBDIV,IBFL,IBNAME
  1. N IBQUIT,IBNCF,IBTCHRG,IBXX,IBYD,IBYY,IBZ,IBMRA
  1. ;
  1. ; - Check to be sure the encounter is billable.
  1. I $$INPT^IBAMTS1(DFN,IBDT\1_.2359) G OPTQ ; Became inpatient same day.
  1. I $G(IBOE),$$ENCL^IBAMTS2(IBOE)["1" G OPTQ ; "ao^ir^sc^swa^mst^hnc^cv^shad" encounter.
  1. S IBDAY=$E(IBDT,1,7),IBNAME=$P($G(^DPT(DFN,0)),U),IBQUIT="",IBNCF=0
  1. ;
  1. ; - Determine the encounter division.
  1. S IBDIV=+$P($$GETOE^SDOE(IBOE),U,11) S:'IBDIV IBDIV=+$$PRIM^VASITE()
  1. ; IB*2.0*516 - Added ability to sort by Division.
  1. I $D(^TMP($J,"IBTUB-DIV")),'$D(^TMP($J,"IBTUB-DIV",IBDIV)) G OPTQ ; Not a selected Division
  1. ;
  1. ; - If no encounter, see if add/edits or registrations are not billable.
  1. I '$G(IBOE) D NOOE G:IBQUIT OPTQ
  1. ;
  1. ; - If encounter was dated prior to Reasonable Charges (9/1/99) and
  1. ; the claim was not authorized before end of reporting period, add
  1. ; encounter Tort Rate to Unbilled Outpatient Amount
  1. I IBDAY<2990901 D PRERC,SETUB:'IBQUIT G OPTQ
  1. I '$G(IBOE) G OPTQ ; If still no encounter, quit.
  1. ;
  1. ; - If encounter was made after start of Reasonable Charges (9/1/99)
  1. ; and any of the encounter's procedure codes have no corresponding
  1. ; inst. or prof. claims that were not authorized before end of the
  1. ; reporting period, add the charges for the procedures to the
  1. ; Unbilled Outpatient Amount.
  1. ;
  1. ; - Gather all procedures associated with the encounter.
  1. D GETCPT^SDOE(IBOE,"IBYY") G:'$G(IBYY) OPTQ ; Check CPT qty.
  1. ;
  1. ; - Build array of all billable encounter procedures.
  1. S IBXX=0 F S IBXX=$O(IBYY(IBXX)) Q:'IBXX D
  1. . ;
  1. . ; - Get procedure pointer and code.
  1. . S IBZ=+IBYY(IBXX),IBCN=$P($$CPT^ICPTCOD(IBZ),"^",2)
  1. . ;
  1. . ; - Ignore LAB services for vets with Medicare Supplemental coverage.
  1. . I IBCN>79999,IBCN<90000 Q
  1. . ;
  1. . ; - Get the institutional/professional charge components.
  1. . S IBCPT(IBZ,1)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",1)
  1. . S IBCPT(IBZ,2)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",2)
  1. . ;
  1. . ; - Eliminate components without a charge.
  1. . S IBCPTSUM(IBZ)=+$G(IBCPT(IBZ,1))+$G(IBCPT(IBZ,2))
  1. . I 'IBCPT(IBZ,1) K IBCPT(IBZ,1)
  1. . I 'IBCPT(IBZ,2) K IBCPT(IBZ,2)
  1. . Q
  1. ;
  1. I '$D(IBCPT) G OPTQ ; Quit if no billable procedures remain.
  1. ;
  1. ; - Look at all of the vet's bills for the day and eliminate
  1. ; from the array those procedures that have been billed.
  1. S IBXX=0
  1. F S IBXX=$O(^DGCR(399,"AOPV",DFN,IBDAY,IBXX)) Q:'IBXX D
  1. . ;
  1. . ; - Perform general checks on the claim.
  1. . S IBDATA=$$CKBIL^IBTUBOU(IBXX) Q:IBDATA=""
  1. . I $P(IBDATA,U,2)=2 S IBMRA(IBXX)=IBDATA ; MRA request
  1. . S IBNCF=IBNCF+1
  1. . ;
  1. . ; If Compile/Store & Not authorized/MRA requested before reporting period - Quit.
  1. . I $G(IBCOMP),$S('$G(IBMRA(IBXX)):$P(IBDATA,U,3),1:$P(IBDATA,U,6))>IBEDT Q
  1. . ;
  1. . ; - The episode has been billed. Check the revenue code multiple for
  1. . ; all procedures billed on the claim.
  1. . S IBYY=0
  1. . F S IBYY=$O(^DGCR(399,IBXX,"RC",IBYY)) Q:'IBYY S IBYD=^(IBYY,0) D
  1. . . ;
  1. . . ; - Get the procedure code and charge type for the revenue code.
  1. . . S IBZ=$P(IBYD,U,6)
  1. . . S IBCT=$S($P(IBYD,U,12):$P(IBYD,U,12),1:$P(IBDATA,U,4))
  1. . . S IBTCHRG=$P(IBYD,U,4)
  1. . . I 'IBZ!('IBCT) Q ; Can't determine code/charge type for procedure.
  1. . . I $G(IBMRA(IBXX))'="" S:$D(IBCPT(IBZ)) IBCPT("MRA",IBZ,IBCT)=1 Q
  1. . . ; Delete procedure from unbilled procedures array.
  1. . . I $G(IBTCHRG)'<$G(IBCPTSUM(IBZ)) K IBCPT(IBZ) Q
  1. . . I $D(IBCPT(IBZ,IBCT)) K IBCPT(IBZ,IBCT) Q
  1. . . K IBCPT(IBZ)
  1. . . Q
  1. . Q
  1. ;
  1. ; - Again, quit if no billable procedures remain.
  1. I '$D(IBCPT) G OPTQ
  1. ;
  1. ; If the IBSBD flag is not set, then reset the Division to be
  1. ; 999999. This data will still be included, but the report
  1. ; will not be sorted by Division.
  1. ;
  1. I '$G(IBSBD) S IBDIV=999999
  1. ;
  1. ; - The encounter has unbilled procedure codes. Increment the counters
  1. ; as per the extract specification.
  1. ;
  1. ; - Count the encounter (element 37N).
  1. S IBMRA=$S($D(IBCPT("MRA")):1,1:0)
  1. I 'IBMRA D
  1. . S IBUNB(IBDIV,"ENCNTRS")=$G(IBUNB(IBDIV,"ENCNTRS"))+1
  1. . S IBUNB("ENCNTRS")=$G(IBUNB("ENCNTRS"))+1
  1. I $G(IBXTRACT) S IB(14)=IB(14)+1
  1. ;
  1. ; - Look at all the unbilled procedures.
  1. S IBZ=0 F S IBZ=$O(IBCPT(IBZ)) Q:'IBZ D
  1. . ;
  1. . S IBMRA=$S($D(IBCPT("MRA",IBZ)):1,1:0)
  1. . ; - Count the procedure (element 37M).
  1. . I $G(IBXTRACT) S IB(13)=IB(13)+1
  1. . ;
  1. . ; - Count the institutional component (element 37I) and its
  1. . ; corresponding charge amount (element 37J).
  1. . I $G(IBCPT(IBZ,1)) D
  1. . . I IBMRA D
  1. . . . S IBUNB(IBDIV,"CPTMS-I-MRA")=$G(IBUNB(IBDIV,"CPTMS-I-MRA"))+1
  1. . . . S IBUNB("CPTMS-MRA")=$G(IBUNB("CPTMS-MRA"))+1
  1. . . . S IBUNB(IBDIV,"UNBILOP-MRA")=$G(IBUNB(IBDIV,"UNBILOP-MRA"))+IBCPT(IBZ,1)
  1. . . . S IBUNB("UNBILOP-MRA")=$G(IBUNB("UNBILOP-MRA"))+IBCPT(IBZ,1)
  1. . . . Q
  1. . . E D
  1. . . . S IBUNB(IBDIV,"CPTMS-I")=$G(IBUNB(IBDIV,"CPTMS-I"))+1
  1. . . . S IBUNB("CPTMS")=$G(IBUNB("CPTMS"))+1
  1. . . . S IBUNB(IBDIV,"UNBILOP")=$G(IBUNB(IBDIV,"UNBILOP"))+IBCPT(IBZ,1)
  1. . . . S IBUNB("UNBILOP")=$G(IBUNB("UNBILOP"))+IBCPT(IBZ,1)
  1. . . . Q
  1. . . I $G(IBXTRACT) S IB(9)=IB(9)+1,IB(10)=IB(10)+IBCPT(IBZ,1)
  1. . . Q
  1. . ;
  1. . ; - Count the professional component (element 37K) and its
  1. . ; corresponding charge amount (element 37L).
  1. . I $G(IBCPT(IBZ,2)) D
  1. . . I IBMRA D
  1. . . . S IBUNB(IBDIV,"CPTMS-P-MRA")=$G(IBUNB(IBDIV,"CPTMS-P-MRA"))+1
  1. . . . S IBUNB("CPTMS-MRA")=$G(IBUNB("CPTMS-MRA"))+1
  1. . . . S IBUNB(IBDIV,"UNBILOP-MRA")=$G(IBUNB(IBDIV,"UNBILOP-MRA"))+IBCPT(IBZ,2)
  1. . . . S IBUNB("UNBILOP-MRA")=$G(IBUNB("UNBILOP-MRA"))+IBCPT(IBZ,2)
  1. . . . Q
  1. . . E D
  1. . . . S IBUNB(IBDIV,"CPTMS-P")=$G(IBUNB(IBDIV,"CPTMS-P"))+1
  1. . . . S IBUNB("CPTMS")=$G(IBUNB("CPTMS"))+1
  1. . . . S IBUNB(IBDIV,"UNBILOP")=$G(IBUNB(IBDIV,"UNBILOP"))+IBCPT(IBZ,2)
  1. . . . S IBUNB("UNBILOP")=$G(IBUNB("UNBILOP"))+IBCPT(IBZ,2)
  1. . . . Q
  1. . . I $G(IBXTRACT) S IB(11)=IB(11)+1,IB(12)=IB(12)+IBCPT(IBZ,2)
  1. . . Q
  1. . Q
  1. ;
  1. D SETUB
  1. ;
  1. OPTQ Q
  1. ;
  1. PRERC ; - Determine if a pre-9/1/99 visit has been billed.
  1. ; Output: IBQUIT will be set to 1 if the visit has been billed.
  1. ; *Pre-set variables DFN,IBDAY,IBDET,IBNAME,IBNCF,IBQUIT,IBRT,IBEDT
  1. ; and IB/IBUNB arrays required.
  1. ; NO MRA Extract code needed for pre-RC processes
  1. ;
  1. S IBDIV=0
  1. F S IBDIV=$O(^TMP($J,"IBTUB",IBDIV)) Q:'IBDIV D I IBQUIT Q
  1. . I $D(^TMP($J,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY)) S IBQUIT=1
  1. I IBQUIT G PRCQ
  1. ;
  1. ; - Check all outpatient claims on event date.
  1. N IBXX S IBXX=0
  1. F S IBXX=$O(^DGCR(399,"AOPV",DFN,IBDAY,IBXX)) Q:'IBXX D Q:IBQUIT
  1. . ;
  1. . ; - Perform general checks on the claim.
  1. . S IBDATA=$$CKBIL^IBTUBOU(IBXX) Q:IBDATA="" S IBNCF=IBNCF+1
  1. . I IBDIV="" S IBDIV=$$GET1^DIQ(399,IBXX_",",.22,"I")
  1. . ;
  1. . ; If Compile/Store & Not authorized before reporting period - Quit.
  1. . I $G(IBCOMP),$P(IBDATA,U,3)>IBEDT Q
  1. . ;
  1. . S IBQUIT=1 ; Episode has been billed-set flag.
  1. . Q
  1. ;
  1. I IBQUIT G PRCQ ; Episode was billed.
  1. I IBDIV="" S IBDIV=999999
  1. ;
  1. ; - The episode was not billed; determine the tort rate for a visit
  1. ; and increment the number and amount of unbilled pre-9/1/99 visits.
  1. S IBXX=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"OUTPATIENT VISIT DATE")
  1. S IBUNB(IBDIV,"UNBILOP")=$G(IBUNB(IBDIV,"UNBILOP"))+IBXX
  1. S IBUNB("UNBILOP")=$G(IBUNB("UNBILOP"))+IBXX
  1. S IBUNB(IBDIV,"ENCNTRS")=$G(IBUNB(IBDIV,"ENCNTRS"))+1
  1. S IBUNB("ENCNTRS")=$G(IBUNB("ENCNTRS"))+1
  1. ;
  1. I $G(IBXTRACT) S IB(7)=IB(7)+1,IB(8)=IB(8)+IBXX ; For DM extract.
  1. ;
  1. PRCQ Q
  1. ;
  1. NOOE ; - If there is no encounter, look for add/edits or registrations.
  1. ; Output: IBQUIT will be set to 1 if the visit is non-billable.
  1. ; *Pre-set variable IBQUIT required.
  1. N IBDATA,IBSC,IBSDV,IBXX,IBZERR
  1. ;
  1. ; - Check if for a visit at the visit date/time.
  1. S IBXX=$$EXOE^SDOE(DFN,IBDT,IBDT,"","IBZERR")
  1. I IBXX D CKENC^IBTUBOU(IBXX,"",.IBQUIT) G NOOEQ
  1. ;
  1. ; - Find next add/edit stop code encounter after IBDT.
  1. D SCAN^IBTUBOU(DFN,IBDT,.IBQUERY)
  1. ;
  1. NOOEQ Q
  1. ;
  1. SETUB ; Set array elements for the detail report.
  1. ; Array element format:
  1. ; NON-MRA:
  1. ; ^TMP($J,"IBTUB",DIVISION,"OPT",NAME@@DFN,DATE,IBX)=bill status^claim type
  1. ; ^TMP($J,"IBTUB",DIVISION,"OPT",NAME@@DFN,DATE,IBX,CPT no)=inst rate^prof rate
  1. ; MRA:
  1. ; ^TMP($J,"IBTUB",DIVISION,"OPT_MRA",NAME@@DFN,DATE,IBX,CPT no)=1 if MRA req
  1. ;
  1. N IBCTF,IBCPTNM
  1. I $S($G(IBINMRA):1,1:'$O(IBCPT("MRA",""))) S ^TMP($J,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY,IBX)=IBNCF
  1. I $G(IBINMRA),$O(IBCPT("MRA","")) S ^TMP($J,"IBTUB",IBDIV,"OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX)=1
  1. G:'IBDET SETUBQ
  1. I $D(IBCPT) S IBXX=0 F S IBXX=$O(IBCPT(IBXX)) Q:'IBXX D
  1. . S IBCPTNM=$$CODEC^ICPTCOD(IBXX) I IBCPTNM=-1 S IBCPTNM="UNK"
  1. . S IBCTF=$S($G(IBCPT(IBXX,1)):"I",1:"")
  1. . S IBCTF=$S($G(IBCPT(IBXX,2)):$S(IBCTF="I":"I,P",1:"P"),1:IBCTF)
  1. . I $S($G(IBINMRA):1,1:'$O(IBCPT("MRA",""))) S ^TMP($J,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=+$G(IBCPT(IBXX,1))_U_+$G(IBCPT(IBXX,2))_U_IBCTF
  1. . I $G(IBINMRA) S:$G(IBCPT("MRA",IBXX)) ^TMP($J,"IBTUB",IBDIV,"OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=1
  1. . Q
  1. ;
  1. SETUBQ Q