| [613] | 1 | IBCRBC11 ;ALB/ARH - RATES: BILL CALCULATION BILLABLE EVENTS ;10-OCT-1998
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**106,245,155**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; continuation of IBCRBC1
|
|---|
| 6 | ;
|
|---|
| 7 | INPTDRG(IBIFN,RS,CS) ; Determine charges for INPATIENT DRG billable events
|
|---|
| 8 | ; - the billable events are DRG's, the Transfer DRG of the patient treating specialties movements,
|
|---|
| 9 | ; pulled from the PTF record each time the charges are calculated (INPTPTF^IBCRCG)
|
|---|
| 10 | ; - each day of billable care is calculated separately in case a rate becomes in/active
|
|---|
| 11 | ; - if bedsection is ICU then allow ICU Charge Set only
|
|---|
| 12 | ;
|
|---|
| 13 | N IBX,IBBLITEM,IBCHGMTH,IBEVDT,IBIDRC,IBBS,IBITM,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q
|
|---|
| 14 | ;
|
|---|
| 15 | D INPTPTF^IBCRBG(IBIFN,CS)
|
|---|
| 16 | ;
|
|---|
| 17 | S IBTYPE=6,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
|
|---|
| 18 | S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
|
|---|
| 19 | I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
|
|---|
| 20 | S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7)
|
|---|
| 21 | ;
|
|---|
| 22 | S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division
|
|---|
| 23 | ;
|
|---|
| 24 | I IBBLITEM=4,IBCHGMTH=1 D ; inpt/DRG/per diem
|
|---|
| 25 | . S IBEVDT="" F S IBEVDT=$O(^TMP($J,"IBCRC-INDT",IBEVDT)) Q:IBEVDT="" D
|
|---|
| 26 | .. ;
|
|---|
| 27 | .. S IBX=$G(^TMP($J,"IBCRC-INDT",IBEVDT)),IBITM=$P(IBX,U,4),IBBS=$P(IBX,U,2),IBDIV=$P(IBX,U,5) Q:'IBITM
|
|---|
| 28 | .. ;
|
|---|
| 29 | .. I '$$CHGICU^IBCRBC2(CS,IBBS) Q ; check icu charges are applied to icu bedsection
|
|---|
| 30 | .. ;
|
|---|
| 31 | .. I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division
|
|---|
| 32 | .. ;
|
|---|
| 33 | .. S IBSAVE="1^^"_IBDIV_"^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT_"^"_IBBS
|
|---|
| 34 | .. D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,1,"","",IBIDRC,IBSAVE)
|
|---|
| 35 | K ^TMP($J,"IBCRC-INDT")
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | UNASSOC(IBIFN,RS,CS,IBMIARR) ; Determine charges for UNASSOCIATED billable events
|
|---|
| 39 | ; - the billable event is not associated with any data element on the bill
|
|---|
| 40 | ; - the item to charge is selected by the user from the list of billing items (363.21)
|
|---|
| 41 | ; - the items the user selected to add charges to the bill for are passed in in array IBMIARR
|
|---|
| 42 | ; - if the charge set is limited by region then either the items division or if no item division then the bill's
|
|---|
| 43 | ; Default Division must be contained in the sets region
|
|---|
| 44 | ;
|
|---|
| 45 | N IBX,IBBLITEM,IBCHGMTH,IBIDRC,IBBDIV,IBI,IBITM,IBEVDT,IBTUNITS,IBDIV,IBRVCD,IBTYPE,IBCMPNT,IBSAVE
|
|---|
| 46 | I '$G(IBIFN)!'$G(CS)!'$G(IBMIARR) Q
|
|---|
| 47 | ;
|
|---|
| 48 | S IBTYPE=9,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 | S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division
|
|---|
| 54 | ;
|
|---|
| 55 | I IBBLITEM=9,IBCHGMTH=1 D ; charge per item
|
|---|
| 56 | . S IBI=0 F S IBI=$O(IBMIARR(RS,CS,IBI)) Q:'IBI D
|
|---|
| 57 | .. S IBX=IBMIARR(RS,CS,IBI),IBITM=+$P(IBX,U,1),IBEVDT=$P(IBX,U,2)
|
|---|
| 58 | .. S IBTUNITS=$P(IBX,U,3),IBDIV=$P(IBX,U,4),IBRVCD=$P(IBX,U,5)
|
|---|
| 59 | .. ;
|
|---|
| 60 | .. I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division
|
|---|
| 61 | .. ;
|
|---|
| 62 | .. S IBSAVE=IBTUNITS_"^^"_IBDIV_"^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT
|
|---|
| 63 | .. D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,1,"",IBRVCD,IBIDRC,IBSAVE)
|
|---|
| 64 | Q
|
|---|
