| 1 | IBCRBC1 ;ALB/ARH - RATES: BILL CALCULATION BILLABLE EVENTS ; 22 MAY 96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,80,106,138,51,148,245,270**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; For each type of Billable Event, search for items on the bill and calculate the charges
|
|---|
| 6 | ; 1) search the bill for items of the billable event type
|
|---|
| 7 | ; 2) determine how the charges should be calculated, based on Billable Item and Charge Method of the Set's Rate
|
|---|
| 8 | ; 3) calculate charges
|
|---|
| 9 | ; For per diem Billing Rates, no item pointers are passed since all items have a standard charge
|
|---|
| 10 | ; The Insurance Company Different Revenue Codes to Use (36,.07) is passed so standard rev codes can be replaced
|
|---|
| 11 | ; The Charge Type (363.1,.04) is passed so it can be added to the charge on the bill if it is defined for a Set
|
|---|
| 12 | ; Output: ^TMP($J,"IBCRCC")= ..., (created in IBCRBC2 based on charge items found here)
|
|---|
| 13 | ;
|
|---|
| 14 | INPTBS(IBIFN,RS,CS) ; Determine charges for INPATIENT BEDSECTION STAY billable events
|
|---|
| 15 | ; - the billable events are billable bedsections based on the patient movement treating specialties,
|
|---|
| 16 | ; these are pulled from the PTF record each time the charges are calculated (INPTPTF^IBCRCG)
|
|---|
| 17 | ; - each day of billable care is calculated separately in case a rate becomes inactive
|
|---|
| 18 | ;
|
|---|
| 19 | N IBX,IBBLITEM,IBCHGMTH,IBEVDT,IBIDRC,IBBDIV,IBITM,IBDIV,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q
|
|---|
| 20 | ;
|
|---|
| 21 | D INPTPTF^IBCRBG(IBIFN,CS)
|
|---|
| 22 | ;
|
|---|
| 23 | S IBTYPE=1,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
|
|---|
| 24 | S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
|
|---|
| 25 | I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
|
|---|
| 26 | S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7)
|
|---|
| 27 | ;
|
|---|
| 28 | S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division
|
|---|
| 29 | ;
|
|---|
| 30 | I IBBLITEM=1,IBCHGMTH=1 D ; inpt/bedsection/per diem
|
|---|
| 31 | . S IBEVDT="" F S IBEVDT=$O(^TMP($J,"IBCRC-INDT",IBEVDT)) Q:'IBEVDT D
|
|---|
| 32 | .. S IBX=$G(^TMP($J,"IBCRC-INDT",IBEVDT)),IBITM=+$P(IBX,U,2),IBDIV=$P(IBX,U,5)
|
|---|
| 33 | .. ;
|
|---|
| 34 | .. I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division
|
|---|
| 35 | .. ;
|
|---|
| 36 | .. S IBSAVE="1^^"_IBDIV_"^"_IBTYPE_"^^"_IBCMPNT
|
|---|
| 37 | .. D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,1,"","",IBIDRC,IBSAVE)
|
|---|
| 38 | K ^TMP($J,"IBCRC-INDT")
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | OPTVST(IBIFN,RS,CS) ; Determine charges for OUTPATIENT VISIT DATE billable events
|
|---|
| 42 | ; - the billable event is the outpatient visit date(s) on the bill (399,43)
|
|---|
| 43 | ;
|
|---|
| 44 | N IBX,IBBLITEM,IBCHGMTH,IBIDRC,IBOPVARR,IBI,IBEVDT,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q
|
|---|
| 45 | ;
|
|---|
| 46 | D OPTVD^IBCRBG1(IBIFN,.IBOPVARR) Q:'IBOPVARR
|
|---|
| 47 | ;
|
|---|
| 48 | S IBTYPE=2,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
|
|---|
| 49 | S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
|
|---|
| 50 | I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
|
|---|
| 51 | S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7)
|
|---|
| 52 | ;
|
|---|
| 53 | I IBBLITEM=1,IBCHGMTH=1 D ; opt vst/bedsection/per diem
|
|---|
| 54 | . S IBI="" F S IBI=$O(IBOPVARR(IBI)) Q:IBI="" D
|
|---|
| 55 | .. S IBEVDT=IBOPVARR(IBI)
|
|---|
| 56 | .. S IBSAVE="1^^^"_IBTYPE_"^^"_IBCMPNT
|
|---|
| 57 | .. D ALLBEDS^IBCRBC2(RS,CS,IBEVDT,"",IBIDRC,IBSAVE)
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | RX(IBIFN,RS,CS) ; Determine charges for PRESCRIPTION billable events
|
|---|
| 61 | ; - the billable event is an rx that has been added to the bill (362.4)
|
|---|
| 62 | ; - the insurance company Prescription Refill Rev Code (36,.15) is passed to the calculator to be used as
|
|---|
| 63 | ; the rev code for all Rx charges, all types, this overrides the rev codes for the set or item
|
|---|
| 64 | ; - on HCFA 1500, the site parameter Default Rx Refill CPT (350.9,1.3) is added as the CPT to all Rx RC entries
|
|---|
| 65 | ;
|
|---|
| 66 | N IBX,IBBLITEM,IBCHGMTH,IBRXCPT,IBIDRC,IBIRC,IBRXARR,IBRX,IBEVDT,IBUNIT,IBITM,IBNDC,IBTYPE,IBCMPNT,IBSAVE
|
|---|
| 67 | I '$G(IBIFN)!'$G(CS) Q
|
|---|
| 68 | ;
|
|---|
| 69 | D SET^IBCSC5A(IBIFN,.IBRXARR) Q:'$P(IBRXARR,U,2)
|
|---|
| 70 | ;
|
|---|
| 71 | S IBTYPE=3,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
|
|---|
| 72 | S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
|
|---|
| 73 | I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
|
|---|
| 74 | S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIRC=$P(IBIDRC,U,15),IBIDRC=$P(IBIDRC,U,7)
|
|---|
| 75 | ;
|
|---|
| 76 | S IBRXCPT="" I $$FT^IBCU3(IBIFN)=2 S IBRXCPT=$P($G(^IBE(350.9,1,1)),U,30)
|
|---|
| 77 | ;
|
|---|
| 78 | I IBBLITEM=1,IBCHGMTH=1 D ; rx refill/bedsection/per diem
|
|---|
| 79 | . S IBRX="" F S IBRX=$O(IBRXARR(IBRX)) Q:IBRX="" D
|
|---|
| 80 | .. S IBEVDT=0 F S IBEVDT=$O(IBRXARR(IBRX,IBEVDT)) Q:'IBEVDT D
|
|---|
| 81 | ... ;
|
|---|
| 82 | ... S IBSAVE="1^"_IBRXCPT_"^^"_IBTYPE_"^"_+IBRXARR(IBRX,IBEVDT)_"^"_IBCMPNT
|
|---|
| 83 | ... D ALLBEDS^IBCRBC2(RS,CS,IBEVDT,IBIRC,IBIDRC,IBSAVE)
|
|---|
| 84 | ;
|
|---|
| 85 | I IBBLITEM=3,IBCHGMTH=3 D ; ndc/quantity
|
|---|
| 86 | . S IBRX="" F S IBRX=$O(IBRXARR(IBRX)) Q:IBRX="" D
|
|---|
| 87 | .. S IBEVDT=0 F S IBEVDT=$O(IBRXARR(IBRX,IBEVDT)) Q:'IBEVDT D
|
|---|
| 88 | ... S IBX=IBRXARR(IBRX,IBEVDT),IBITM=+IBX,IBUNIT=$P(IBX,U,4),IBNDC=$P(IBX,U,5) Q:IBNDC=""
|
|---|
| 89 | ... S IBNDC=$O(^IBA(363.21,"B",IBNDC,0)) Q:'IBNDC
|
|---|
| 90 | ... S IBSAVE="1^"_IBRXCPT_"^^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT
|
|---|
| 91 | ... D BITMCHG^IBCRBC2(RS,CS,IBNDC,IBEVDT,IBUNIT,"",IBIRC,IBIDRC,IBSAVE)
|
|---|
| 92 | ;
|
|---|
| 93 | I IBCHGMTH=2 D ; va cost
|
|---|
| 94 | . S IBRX="" F S IBRX=$O(IBRXARR(IBRX)) Q:IBRX="" D
|
|---|
| 95 | .. S IBEVDT=0 F S IBEVDT=$O(IBRXARR(IBRX,IBEVDT)) Q:'IBEVDT D
|
|---|
| 96 | ... S IBX=IBRXARR(IBRX,IBEVDT),IBITM=+IBX,IBUNIT=$P(IBX,U,4) Q:'IBITM
|
|---|
| 97 | ... S IBSAVE="1^"_IBRXCPT_"^^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT
|
|---|
| 98 | ... D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,IBUNIT,"",IBIRC,IBIDRC,IBSAVE)
|
|---|
| 99 | ;
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | CPT(IBIFN,RS,CS) ; Determine charges for PROCEDURE billable events
|
|---|
| 103 | ; - the billable event is a CPT procedure from the bill (399,304)
|
|---|
| 104 | ; - the item to be billed is a CPT, this may include Modifier
|
|---|
| 105 | ; - for each CPT found on the bill that has a modifier, will first check to see if that CPT-modifier
|
|---|
| 106 | ; combination is billable (ie. is defined as a charge item for the Billing Rate, does not have to be active)
|
|---|
| 107 | ; if it does not then assumes the charge should be the CPT charge
|
|---|
| 108 | ; - if the charge set is limited by region then either the CPT's division or if no CPT division then the bill's
|
|---|
| 109 | ; Default Division must be contained in the sets region
|
|---|
| 110 | ; - the billable CPT is added as the CPT of the charge entry, Division is also added if defined for the CPT
|
|---|
| 111 | ; - the procedures provider may affect the charges due to a provider discount
|
|---|
| 112 | ; - if an inpatient bill then the bedsection on date of procedure will be used as the default bedsection
|
|---|
| 113 | ; - different sets of charges apply to SNF and Inpatient care although the bill is defined as inpatient
|
|---|
| 114 | ; - the Default Rx CPT should not be billed the CPT charge, instead the Rx is charged
|
|---|
| 115 | ;
|
|---|
| 116 | N IBX,IBBLITEM,IBCHGMTH,IBBR,IBBDIV,IBIDRC,IBCPTARR,IBCPT,IBCPTFN,IBEVDT,IBMOD,IBDIV,IBTYPE,IBCMPNT
|
|---|
| 117 | N IBPPRV,IBBS,IBCLIN,IBOE,IBSAVE,IBUNIT,IBCPTRX I '$G(IBIFN)!'$G(CS) Q
|
|---|
| 118 | ;
|
|---|
| 119 | D CPT^IBCRBG1(IBIFN,.IBCPTARR) Q:'IBCPTARR
|
|---|
| 120 | ;
|
|---|
| 121 | S IBTYPE=4,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
|
|---|
| 122 | S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
|
|---|
| 123 | I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
|
|---|
| 124 | S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7)
|
|---|
| 125 | S IBBR=$P(IBX,U,3) S IBCPTRX="" I $O(^IBA(362.4,"C",IBIFN,0)) S IBCPTRX=+$P($G(^IBE(350.9,1,1)),U,30)
|
|---|
| 126 | ;
|
|---|
| 127 | S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division
|
|---|
| 128 | D INPTPTF^IBCRBG(IBIFN,CS) ; get inpatient bedsections
|
|---|
| 129 | ;
|
|---|
| 130 | I IBBLITEM=2 D ; cpt/count/minutes/miles/hours
|
|---|
| 131 | . S IBCPT=0 F S IBCPT=$O(IBCPTARR(IBCPT)) Q:'IBCPT D
|
|---|
| 132 | .. S IBCPTFN=0 F S IBCPTFN=$O(IBCPTARR(IBCPT,IBCPTFN)) Q:'IBCPTFN D
|
|---|
| 133 | ... S IBX=IBCPTARR(IBCPT,IBCPTFN),IBEVDT=$P(IBX,U,1),IBMOD=$P(IBX,U,2)
|
|---|
| 134 | ... S IBDIV=$P(IBX,U,3),IBPPRV=$P(IBX,U,4),IBCLIN=$P(IBX,U,5),IBOE=$P(IBX,U,6)
|
|---|
| 135 | ... ;
|
|---|
| 136 | ... I '$$CHGOTH^IBCRBC2(IBIFN,RS,IBEVDT) Q
|
|---|
| 137 | ... I +IBCPTRX,'IBOE,IBCPT=IBCPTRX Q ; site parameter rx procedure
|
|---|
| 138 | ... ;
|
|---|
| 139 | ... S IBUNIT=$$CPTUNITS^IBCRBC2(CS,IBCHGMTH,IBX) Q:'IBUNIT
|
|---|
| 140 | ... ;
|
|---|
| 141 | ... S IBBS=$P($G(^TMP($J,"IBCRC-INDT",IBEVDT)),U,2) ; get inpatient bedsection
|
|---|
| 142 | ... I 'IBBS S IBX=$O(^TMP($J,"IBCRC-INDT",IBEVDT),-1) I +IBX S IBBS=$P($G(^TMP($J,"IBCRC-INDT",IBX)),U,2)
|
|---|
| 143 | ... ;
|
|---|
| 144 | ... I '$P($$CPT^ICPTCOD(+IBCPT,+IBEVDT),U,7) Q ; check is a valid active CPT
|
|---|
| 145 | ... I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division
|
|---|
| 146 | ... I +IBMOD S IBMOD=$P($$CPTMOD^IBCRCU1(CS,IBCPT,IBMOD,IBEVDT),",",1) ; check CPT-MODs for billable combination
|
|---|
| 147 | ... ;
|
|---|
| 148 | ... S IBSAVE="1^"_IBCPT_U_IBDIV_U_IBTYPE_U_IBCPTFN_U_IBCMPNT_U_IBBS_U_IBPPRV_U_IBCLIN_U_IBOE
|
|---|
| 149 | ... D BITMCHG^IBCRBC2(RS,CS,IBCPT,IBEVDT,IBUNIT,IBMOD,"",IBIDRC,IBSAVE)
|
|---|
| 150 | K ^TMP($J,"IBCRC-INDT")
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | PI(IBIFN,RS,CS) ; Determine charges for PROSTHETICS billable events
|
|---|
| 154 | ; - the billable event is a prosthetic item that has been added to the bill (362.5)
|
|---|
| 155 | ;
|
|---|
| 156 | N IBX,IBBLITEM,IBCHGMTH,IBPIARR,IBIDRC,IBEVDT,IBPI,IBITM,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q
|
|---|
| 157 | ;
|
|---|
| 158 | D SET^IBCSC5B(IBIFN,.IBPIARR) Q:'$P(IBPIARR,U,2)
|
|---|
| 159 | ;
|
|---|
| 160 | S IBTYPE=5,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
|
|---|
| 161 | S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
|
|---|
| 162 | I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
|
|---|
| 163 | S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7)
|
|---|
| 164 | ;
|
|---|
| 165 | I IBBLITEM=1,IBCHGMTH=1 D ; pros/bedsection/per diem
|
|---|
| 166 | . S IBEVDT="" F S IBEVDT=$O(IBPIARR(IBEVDT)) Q:'IBEVDT D
|
|---|
| 167 | .. S IBPI=0 F S IBPI=$O(IBPIARR(IBEVDT,IBPI)) Q:'IBPI D
|
|---|
| 168 | ... S IBSAVE="1^^^"_IBTYPE_"^^"_IBCMPNT
|
|---|
| 169 | ... D ALLBEDS^IBCRBC2(RS,CS,IBEVDT,"",IBIDRC,IBSAVE)
|
|---|
| 170 | ;
|
|---|
| 171 | I IBCHGMTH=2 D ; va cost
|
|---|
| 172 | . S IBEVDT="" F S IBEVDT=$O(IBPIARR(IBEVDT)) Q:'IBEVDT D
|
|---|
| 173 | .. S IBPI=0 F S IBPI=$O(IBPIARR(IBEVDT,IBPI)) Q:'IBPI D
|
|---|
| 174 | ... S IBITM=IBPIARR(IBEVDT,IBPI) Q:'IBITM
|
|---|
| 175 | ... S IBSAVE="1^^^"_IBTYPE_"^"_+IBITM_"^"_IBCMPNT
|
|---|
| 176 | ... D BITMCHG^IBCRBC2(RS,CS,+IBITM,IBEVDT,1,"","",IBIDRC,IBSAVE)
|
|---|
| 177 | ;
|
|---|
| 178 | Q
|
|---|
