- IBCRCI ;ALB/ARH - RATES: CALCULATION ITEM/EVENT COST FNCTNS ; 22-MAY-96
- ;;2.0;INTEGRATED BILLING;**52,106,245,458**;21-MAR-94;Build 4
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; standard callable functions to get item charge/cost
- ;
- ; notice that each function works for all Charge Methods and both types of Sets (Item/Event)
- ; - if the Charge Set is based on event then the event charge will be calculated (item passed will not be used)
- ; - the charges are the unit charges so UNIT should only be defined (or not 1) if the Charge Method is Quantity
- ;
- ITCHG(CS,ITEM,EVDT,MOD) ; returns total base unit charge for a specific charge set, item/event and date
- ; works for both types of Charge Set (Item and Event) and all Charge Methods
- ; does not factor in division, units or rate schedule adjustment
- ; if charges for the Set are based on event rather than item, will get active events, ITEM is not required/used
- ; Input: CS = Charge Set ifn, ITEM = billable item pointer, MOD = cpt modifier
- ; Output: total item charge on EVDT ^ effective date of charge ^ total base charge
- ;
- N IBX,IBITMARR,IBCHGARR,IBITEM,IBI,IBLN,IBCHG,IBCHGB,IBCI,IBEFDT S IBX=0,EVDT=$G(EVDT)\1
- I '$D(^IBE(363.1,+$G(CS),0))!(EVDT'?7N) G ITCHGQ
- I +$G(ITEM),'$$ITBICHK^IBCRU2(+CS,+ITEM) G ITCHGQ
- ;
- I $$CSITMS^IBCRCU1(CS)=2 D CSALL^IBCRCU1(CS,EVDT,.IBITMARR)
- I +$G(ITEM),'$G(IBITMARR) S IBITMARR=EVDT,IBITMARR(ITEM)=""
- I '$G(IBITMARR) G ITCHGQ
- ;
- S (IBCHG,IBCHGB,IBCI,IBITEM)=0 F S IBITEM=$O(IBITMARR(IBITEM)) Q:'IBITEM D
- . D ITMCHG^IBCRCC(CS,IBITEM,EVDT,$G(MOD),.IBCHGARR)
- . S IBI=0 F S IBI=$O(IBCHGARR(IBI)) Q:'IBI D
- .. S IBLN=IBCHGARR(IBI) S IBCHG=IBCHG+$P(IBLN,U,3),IBCI=+IBLN,IBCHGB=IBCHGB+$P(IBLN,U,4)
- ;
- I +IBCI S IBEFDT=$P($G(^IBA(363.2,+IBCI,0)),U,3)
- I +IBCHG S IBX=+$FN(+IBCHG,"",2)_U_$G(IBEFDT) I +IBCHGB S IBX=IBX_U_+$FN(+IBCHGB,"",2)
- ;
- ITCHGQ Q IBX
- ;
- ITCOST(RS,CS,ITEM,EVDT,MOD,DIV,UNIT) ; returns total adjusted unit cost/charge for a specific schedule/set, item/event, date
- ; this is the actual cost of one item/event, does factor in division, units and rate schedule adjustment
- ; units should be 1 or undefined unless the Charge Method of the rate is Quantity/Miles/Minutes/Hours
- ; if the Charge Set is region specific, Division passed must be within that region or no charge
- ; Input: CS = Charge Set ifn, ITEM = billable item pointer, MOD = cpt modifier, UNIT = 1 unless Quantity
- ; Output: total adjusted item charge/cost on EVDT ^ effective date of charge
- ;
- N IBCOST,IBBCOST,IBDT S IBCOST=0,EVDT=$G(EVDT)\1,UNIT=$S(+$G(UNIT):UNIT,1:1)
- I '$D(^IBE(363.1,+$G(CS),0))!(EVDT'?7N) G ITCOSTQ
- I $$CSDV^IBCRU3(CS,+$G(DIV))<0 G ITCOSTQ
- S UNIT=$$CPTUNITS^IBCRCU1(CS,UNIT)
- ;
- S IBCOST=$$ITCHG(CS,$G(ITEM),EVDT,$G(MOD)),IBDT=$P(IBCOST,U,2),IBBCOST=$P(IBCOST,U,3)
- S IBCOST=+IBCOST*UNIT
- I +IBBCOST S IBCOST=IBCOST+IBBCOST
- I +$G(RS) S IBCOST=+$$RATECHG^IBCRCC(RS,+IBCOST,EVDT)
- I +IBCOST S IBCOST=+$FN(+IBCOST,"",2)_U_IBDT
- ;
- ITCOSTQ Q IBCOST
- ;
- BICOST(RT,BT,EVDT,BE,ITEM,MOD,DIV,UNIT,CT,BLBS) ; returns the total unit cost of a particular item/event for a specific Rate Type and Bill Type, i.e. payer
- ; this includes all cost for the item and payer, which may include more than one charge set or rate schedule
- ; ITEM is not required if it is an Event CS, BE is required only as a screen for a specific event, if desired
- ;
- N IBX,IBY,IBCOST,IBDT,IBARR,IBRS,IBCS S (IBX,IBCOST)=0,IBDT=""
- I $G(BE)'=""!(+$G(ITEM)) D RT^IBCRU3($G(RT),$G(BT),$G(EVDT),.IBARR,$G(BE),$G(CT))
- ;
- S IBRS=0 F S IBRS=$O(IBARR(IBRS)) Q:'IBRS D
- . S IBCS=0 F S IBCS=$O(IBARR(IBRS,IBCS)) Q:'IBCS I +IBARR(IBRS,IBCS) D
- .. I $G(BE)="INPATIENT DRG",'$$CHGICU^IBCRBC2(IBCS,+$G(BLBS)) Q
- .. S IBY=$$ITCOST(IBRS,IBCS,$G(ITEM),$G(EVDT),$G(MOD),$G(DIV),$G(UNIT)) I +$P(IBY,U,2)>IBDT S IBDT=+$P(IBY,U,2)
- .. S IBCOST=+IBCOST+IBY
- S IBX=IBCOST_U_IBDT
- Q IBX
- ;
- BILLCOST(IBIFN,EVDT,BE,ITEM,MOD,UNIT) ; returns total cost of a particular item or event for a specific bill
- ; cost may include more than one set or schedule charge if the item/event is defined for more than one set
- ; or schedule assigned to the rate type/event type of the bill
- ;
- N IBX,IB0,IBRT,IBBT S IBX=0,IB0=$G(^DGCR(399,+$G(IBIFN),0)),IBRT=+$P(IB0,U,7),IBBT=$P(IB0,U,5)
- I IB0'="" S IBX=$$BICOST(IBRT,IBBT,$G(EVDT),$G(BE),$G(ITEM),$G(MOD),$P(IB0,U,22),$G(UNIT),$P(IB0,U,27))
- Q IBX
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRCI 4449 printed Jan 18, 2025@03:20:09 Page 2
- IBCRCI ;ALB/ARH - RATES: CALCULATION ITEM/EVENT COST FNCTNS ; 22-MAY-96
- +1 ;;2.0;INTEGRATED BILLING;**52,106,245,458**;21-MAR-94;Build 4
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; standard callable functions to get item charge/cost
- +5 ;
- +6 ; notice that each function works for all Charge Methods and both types of Sets (Item/Event)
- +7 ; - if the Charge Set is based on event then the event charge will be calculated (item passed will not be used)
- +8 ; - the charges are the unit charges so UNIT should only be defined (or not 1) if the Charge Method is Quantity
- +9 ;
- ITCHG(CS,ITEM,EVDT,MOD) ; returns total base unit charge for a specific charge set, item/event and date
- +1 ; works for both types of Charge Set (Item and Event) and all Charge Methods
- +2 ; does not factor in division, units or rate schedule adjustment
- +3 ; if charges for the Set are based on event rather than item, will get active events, ITEM is not required/used
- +4 ; Input: CS = Charge Set ifn, ITEM = billable item pointer, MOD = cpt modifier
- +5 ; Output: total item charge on EVDT ^ effective date of charge ^ total base charge
- +6 ;
- +7 NEW IBX,IBITMARR,IBCHGARR,IBITEM,IBI,IBLN,IBCHG,IBCHGB,IBCI,IBEFDT
- SET IBX=0
- SET EVDT=$GET(EVDT)\1
- +8 IF '$DATA(^IBE(363.1,+$GET(CS),0))!(EVDT'?7N)
- GOTO ITCHGQ
- +9 IF +$GET(ITEM)
- IF '$$ITBICHK^IBCRU2(+CS,+ITEM)
- GOTO ITCHGQ
- +10 ;
- +11 IF $$CSITMS^IBCRCU1(CS)=2
- DO CSALL^IBCRCU1(CS,EVDT,.IBITMARR)
- +12 IF +$GET(ITEM)
- IF '$GET(IBITMARR)
- SET IBITMARR=EVDT
- SET IBITMARR(ITEM)=""
- +13 IF '$GET(IBITMARR)
- GOTO ITCHGQ
- +14 ;
- +15 SET (IBCHG,IBCHGB,IBCI,IBITEM)=0
- FOR
- SET IBITEM=$ORDER(IBITMARR(IBITEM))
- if 'IBITEM
- QUIT
- Begin DoDot:1
- +16 DO ITMCHG^IBCRCC(CS,IBITEM,EVDT,$GET(MOD),.IBCHGARR)
- +17 SET IBI=0
- FOR
- SET IBI=$ORDER(IBCHGARR(IBI))
- if 'IBI
- QUIT
- Begin DoDot:2
- +18 SET IBLN=IBCHGARR(IBI)
- SET IBCHG=IBCHG+$PIECE(IBLN,U,3)
- SET IBCI=+IBLN
- SET IBCHGB=IBCHGB+$PIECE(IBLN,U,4)
- End DoDot:2
- End DoDot:1
- +19 ;
- +20 IF +IBCI
- SET IBEFDT=$PIECE($GET(^IBA(363.2,+IBCI,0)),U,3)
- +21 IF +IBCHG
- SET IBX=+$FNUMBER(+IBCHG,"",2)_U_$GET(IBEFDT)
- IF +IBCHGB
- SET IBX=IBX_U_+$FNUMBER(+IBCHGB,"",2)
- +22 ;
- ITCHGQ QUIT IBX
- +1 ;
- ITCOST(RS,CS,ITEM,EVDT,MOD,DIV,UNIT) ; returns total adjusted unit cost/charge for a specific schedule/set, item/event, date
- +1 ; this is the actual cost of one item/event, does factor in division, units and rate schedule adjustment
- +2 ; units should be 1 or undefined unless the Charge Method of the rate is Quantity/Miles/Minutes/Hours
- +3 ; if the Charge Set is region specific, Division passed must be within that region or no charge
- +4 ; Input: CS = Charge Set ifn, ITEM = billable item pointer, MOD = cpt modifier, UNIT = 1 unless Quantity
- +5 ; Output: total adjusted item charge/cost on EVDT ^ effective date of charge
- +6 ;
- +7 NEW IBCOST,IBBCOST,IBDT
- SET IBCOST=0
- SET EVDT=$GET(EVDT)\1
- SET UNIT=$SELECT(+$GET(UNIT):UNIT,1:1)
- +8 IF '$DATA(^IBE(363.1,+$GET(CS),0))!(EVDT'?7N)
- GOTO ITCOSTQ
- +9 IF $$CSDV^IBCRU3(CS,+$GET(DIV))<0
- GOTO ITCOSTQ
- +10 SET UNIT=$$CPTUNITS^IBCRCU1(CS,UNIT)
- +11 ;
- +12 SET IBCOST=$$ITCHG(CS,$GET(ITEM),EVDT,$GET(MOD))
- SET IBDT=$PIECE(IBCOST,U,2)
- SET IBBCOST=$PIECE(IBCOST,U,3)
- +13 SET IBCOST=+IBCOST*UNIT
- +14 IF +IBBCOST
- SET IBCOST=IBCOST+IBBCOST
- +15 IF +$GET(RS)
- SET IBCOST=+$$RATECHG^IBCRCC(RS,+IBCOST,EVDT)
- +16 IF +IBCOST
- SET IBCOST=+$FNUMBER(+IBCOST,"",2)_U_IBDT
- +17 ;
- ITCOSTQ QUIT IBCOST
- +1 ;
- BICOST(RT,BT,EVDT,BE,ITEM,MOD,DIV,UNIT,CT,BLBS) ; returns the total unit cost of a particular item/event for a specific Rate Type and Bill Type, i.e. payer
- +1 ; this includes all cost for the item and payer, which may include more than one charge set or rate schedule
- +2 ; ITEM is not required if it is an Event CS, BE is required only as a screen for a specific event, if desired
- +3 ;
- +4 NEW IBX,IBY,IBCOST,IBDT,IBARR,IBRS,IBCS
- SET (IBX,IBCOST)=0
- SET IBDT=""
- +5 IF $GET(BE)'=""!(+$GET(ITEM))
- DO RT^IBCRU3($GET(RT),$GET(BT),$GET(EVDT),.IBARR,$GET(BE),$GET(CT))
- +6 ;
- +7 SET IBRS=0
- FOR
- SET IBRS=$ORDER(IBARR(IBRS))
- if 'IBRS
- QUIT
- Begin DoDot:1
- +8 SET IBCS=0
- FOR
- SET IBCS=$ORDER(IBARR(IBRS,IBCS))
- if 'IBCS
- QUIT
- IF +IBARR(IBRS,IBCS)
- Begin DoDot:2
- +9 IF $GET(BE)="INPATIENT DRG"
- IF '$$CHGICU^IBCRBC2(IBCS,+$GET(BLBS))
- QUIT
- +10 SET IBY=$$ITCOST(IBRS,IBCS,$GET(ITEM),$GET(EVDT),$GET(MOD),$GET(DIV),$GET(UNIT))
- IF +$PIECE(IBY,U,2)>IBDT
- SET IBDT=+$PIECE(IBY,U,2)
- +11 SET IBCOST=+IBCOST+IBY
- End DoDot:2
- End DoDot:1
- +12 SET IBX=IBCOST_U_IBDT
- +13 QUIT IBX
- +14 ;
- BILLCOST(IBIFN,EVDT,BE,ITEM,MOD,UNIT) ; returns total cost of a particular item or event for a specific bill
- +1 ; cost may include more than one set or schedule charge if the item/event is defined for more than one set
- +2 ; or schedule assigned to the rate type/event type of the bill
- +3 ;
- +4 NEW IBX,IB0,IBRT,IBBT
- SET IBX=0
- SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
- SET IBRT=+$PIECE(IB0,U,7)
- SET IBBT=$PIECE(IB0,U,5)
- +5 IF IB0'=""
- SET IBX=$$BICOST(IBRT,IBBT,$GET(EVDT),$GET(BE),$GET(ITEM),$GET(MOD),$PIECE(IB0,U,22),$GET(UNIT),$PIECE(IB0,U,27))
- +6 QUIT IBX