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 Dec 13, 2024@02:18:56 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
