IBCRCU1 ;ALB/ARH - RATES: CALCULATION UTILITIES ; 22-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106,245**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; there are two types of Charge Sets (363.1) that have Charge Item entries (363.2):
; 1 - ITEM: each item has an individual charge: an item on the bill has corresponding charge item entries,
; the item may have more than one Charge Item entry but they are specifically defined for that item
; ex: an inpt bs, a CPT, or a drug
; 2 - EVENT: the charge is for an event not an item: all charge items active on a date in the Set
; combine to give the charge for the item on the bill for that date
; all items in the set define the event charge - the total charges for a set on a date is the event charge
; the item does not have to match an item on the bill and is only relevant because it is then added
; to the RC multiple of the bill as one of the bills charge lines
; ex: the charge for a bills opt visit date is the combined charge of all items active in the Set
; on the visit date (this may be more than simply the Outpatient Visit Date bedsection charge if
; there is another bedsection charge defined for that date)
;
CSITMS(CS) ; returns 1 (ITEM) if the CS requires a single billable item or 2 (EVENT) if all active items for date are used
;
N IBX,IBCSBR,IBBEVNT,IBBLITEM,IBCHGMTH S IBX=0 I '$G(CS) G CSITMSQ
S IBCSBR=$$CSBR^IBCRU3(+CS) I IBCSBR="" G CSITMSQ
S IBBEVNT=$P(IBCSBR,U,1),IBBLITEM=$P(IBCSBR,U,4),IBCHGMTH=$P(IBCSBR,U,5)
;
I IBBEVNT["INPATIENT BEDSECTION STAY",IBBLITEM=1,IBCHGMTH=1 S IBX=1 G CSITMSQ
I IBBEVNT["OUTPATIENT VISIT DATE",IBBLITEM=1,IBCHGMTH=1 S IBX=2 G CSITMSQ
I IBBEVNT["PRESCRIPTION",IBBLITEM=1,IBCHGMTH=1 S IBX=2 G CSITMSQ
I IBBEVNT["PRESCRIPTION",IBBLITEM=3,IBCHGMTH=3 S IBX=1 G CSITMSQ
I IBBEVNT["PRESCRIPTION",IBCHGMTH=2 S IBX=1 G CSITMSQ
I IBBEVNT["PROSTHETICS",IBBLITEM=1,IBCHGMTH=1 S IBX=2 G CSITMSQ
I IBBEVNT["PROSTHETICS",IBCHGMTH=2 S IBX=1 G CSITMSQ
I IBBEVNT["PROCEDURE",IBBLITEM=2,IBCHGMTH=1 S IBX=1 G CSITMSQ
I IBBEVNT["PROCEDURE",IBBLITEM=2,IBCHGMTH=4 S IBX=1 G CSITMSQ
I IBBEVNT["PROCEDURE",IBBLITEM=2,IBCHGMTH=5 S IBX=1 G CSITMSQ
I IBBEVNT["PROCEDURE",IBBLITEM=2,IBCHGMTH=6 S IBX=1 G CSITMSQ
I IBBEVNT["INPATIENT DRG",IBBLITEM=4,IBCHGMTH=1 S IBX=1 G CSITMSQ
I IBBEVNT["UNASSOCIATED",IBBLITEM=9,IBCHGMTH=1 S IBX=1 G CSITMSQ
CSITMSQ Q IBX
;
CSALL(CS,EVDT,ARR) ; returns all items billable on a given effective date for charge sets where all active items are billed (EVENT)
; finds most recent effective date, returns all items active on that date ie. does not check item inactive date
; first get all active items on date then get only those items active on most recent effective date
; Ouput: ARR = chg effective date
; ARR(source item pointer) =""
;
N IBXRF,IBITM,IBEVDT,ARR1 K ARR S ARR=0,EVDT=$G(EVDT)\1 I '$G(CS)!(EVDT'?7N) G CSALLQ
I +$$CSITMS(CS)'=2 G CSALLQ
;
S IBXRF="AIVDTS"_CS
S IBITM=0 F S IBITM=$O(^IBA(363.2,IBXRF,IBITM)) Q:'IBITM D
. S IBEVDT=$O(^IBA(363.2,IBXRF,IBITM,-(EVDT+.01))) Q:'IBEVDT
. S ARR1(IBEVDT,IBITM)=""
;
S IBEVDT=$O(ARR1(""))
I +IBEVDT S IBITM=0 F S IBITM=$O(ARR1(IBEVDT,IBITM)) Q:'IBITM S ARR(IBITM)="",ARR=-IBEVDT
;
CSALLQ Q
;
CPTUNITS(CS,UNIT) ; return raw data returns CPT units based on Charge Set and item
; Input: CS - Charge Set of charge determines Charge Method
; UNIT - total miles/minutes/hours of item
; Output: UNIT or calculated for miles/minutes/hours
N IBUNITS,IBCSBR,IBCHGMTH S IBUNITS=+$G(UNIT) I 'IBUNITS G CPTUNITQ
S CS=$G(CS) S IBCSBR=$$CSBR^IBCRU3(CS),IBCHGMTH=$P(IBCSBR,U,5)
I +IBCHGMTH=4 S IBUNITS=$$MLUNIT^IBCRCC(UNIT) ; miles
I +IBCHGMTH=5 S IBUNITS=$$MNUNIT^IBCRCC(UNIT) ; minutes
I +IBCHGMTH=6 S IBUNITS=$$HRUNIT^IBCRCC(UNIT) ; hours
CPTUNITQ Q IBUNITS
;
CPTMOD(CS,CPT,MODS,DATE) ; check to see if a CPT-Modifier combination has a charge in this Charge Set, returns "" or CI IFN
; Input MODS is a list of modifiers to check separated by ','
; Output "" or list of modifiers with active charges in the set on date
N IBMOD,IBI,IBX,IBY S (IBX,IBY)="" I '$G(CS)!'$G(CPT)!'$G(MODS)!'$G(DATE) G CPTMODQ
F IBI=1:1 S IBMOD=$P(MODS,",",IBI) Q:IBMOD="" D
. I +$$FNDCI^IBCRU4(CS,CPT,DATE,,IBMOD) S IBX=IBX_IBY_IBMOD S IBY=","
;
CPTMODQ Q IBX
;
CHGMOD(IBIFN,CPT,EFFDT,CT) ; find charges for a procedure and a date for a bill
; returns: count of charges ':' list of charge items ':' list of charge modifiers
N IB0,IBU,IBBDV,IBBCT,ARRCS,IBRS,IBCS,ARRCHG,IBFND,IBCIS,IBMODS,IBX S IBFND=0,(IBCIS,IBMODS)=""
S IB0=$G(^DGCR(399,+$G(IBIFN),0)),IBU=$G(^DGCR(399,+$G(IBIFN),"U")),IBBDV=$P(IB0,U,22),IBBCT=$S($D(CT):CT,1:$P(IB0,U,27))
I IB0'="",+IBU,+IBBDV,+$G(CPT),+$G(EFFDT) D RT^IBCRU3($P(IB0,U,7),$P(IB0,U,5),EFFDT,.ARRCS,"PROCEDURE",IBBCT) D
. S IBRS=0 F S IBRS=$O(ARRCS(IBRS)) Q:'IBRS D
.. S IBCS=0 F S IBCS=$O(ARRCS(IBRS,IBCS)) Q:'IBCS I +ARRCS(IBRS,IBCS) D
... I $$CSDV^IBCRU3(IBCS,IBBDV)<0 Q ; check division
... I '$$CHGOTH^IBCRBC2(IBIFN,IBRS,EFFDT) Q ; ckeck snf/non-snf
... I +$$FNDCI^IBCRU4(IBCS,CPT,EFFDT,.ARRCHG) S IBFND=IBFND+ARRCHG D
.... S IBX=0 F S IBX=$O(ARRCHG(IBX)) Q:'IBX S IBCIS=IBCIS_IBX_U,IBMODS=IBMODS_$P(ARRCHG(IBX),U,7)_U
I +IBFND S IBFND=IBFND_":"_IBCIS_":"_IBMODS
CHGMODQ Q IBFND
;
CPTCHG(IBIFN,CT) ; return true if bill has auto add CPT charges for the Charge Type passed in (regardless of modifier)
N IBFND,IB0,IBU,IBBILLDV,IBBCT,IBCT,ARRCPT,ARRCS,IBRS,IBCS,IBCPT,IBCPTDA,IBCPT0 S IBFND=0,CT=$G(CT)
;
S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" G CPTCHGQ
S IBU=$G(^DGCR(399,+$G(IBIFN),"U")) I 'IBU G CPTCHGQ
S IBBILLDV=$P(IB0,U,22),IBBCT=$P(IB0,U,27)
;
S IBCT=$S(CT="BILL":IBBCT,CT="INST":1,CT="PROF":2,CT="OPST"&(IBBCT=1):2,CT="OPST"&(IBBCT=2):1,CT="":"",1:-1)
I IBCT<0 G CPTCHGQ
;
D CPT^IBCRBG1(IBIFN,.ARRCPT) I '$O(ARRCPT(0)) G CPTCHGQ
D RT^IBCRU3($P(IB0,U,7),$P(IB0,U,5),$P(IBU,U,1,2),.ARRCS,"PROCEDURE",IBCT)
;
S IBRS=0 F S IBRS=$O(ARRCS(IBRS)) Q:'IBRS D I +IBFND Q
. S IBCS=0 F S IBCS=$O(ARRCS(IBRS,IBCS)) Q:'IBCS I +ARRCS(IBRS,IBCS) D I +IBFND Q
.. ;
.. S IBCPT=0 F S IBCPT=$O(ARRCPT(IBCPT)) Q:'IBCPT D I +IBFND Q
... S IBCPTDA=0 F S IBCPTDA=$O(ARRCPT(IBCPT,IBCPTDA)) Q:'IBCPTDA D I +IBFND Q
.... ;
.... S IBCPT0=ARRCPT(IBCPT,IBCPTDA)
.... I $$CSDV^IBCRU3(IBCS,$P(IBCPT0,U,3),IBBILLDV)<0 Q ; check division
.... ;
.... I +$$CHKIPB^IBCU7A1(IBCPT,IBCT) S IBFND=1 Q
.... I +$$FNDCI^IBCRU4(IBCS,IBCPT,$P(IBCPT0,U,1)) S IBFND=1
;
CPTCHGQ Q IBFND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRCU1 6661 printed Oct 16, 2024@18:19:37 Page 2
IBCRCU1 ;ALB/ARH - RATES: CALCULATION UTILITIES ; 22-MAY-1996
+1 ;;2.0;INTEGRATED BILLING;**52,106,245**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; there are two types of Charge Sets (363.1) that have Charge Item entries (363.2):
+5 ; 1 - ITEM: each item has an individual charge: an item on the bill has corresponding charge item entries,
+6 ; the item may have more than one Charge Item entry but they are specifically defined for that item
+7 ; ex: an inpt bs, a CPT, or a drug
+8 ; 2 - EVENT: the charge is for an event not an item: all charge items active on a date in the Set
+9 ; combine to give the charge for the item on the bill for that date
+10 ; all items in the set define the event charge - the total charges for a set on a date is the event charge
+11 ; the item does not have to match an item on the bill and is only relevant because it is then added
+12 ; to the RC multiple of the bill as one of the bills charge lines
+13 ; ex: the charge for a bills opt visit date is the combined charge of all items active in the Set
+14 ; on the visit date (this may be more than simply the Outpatient Visit Date bedsection charge if
+15 ; there is another bedsection charge defined for that date)
+16 ;
CSITMS(CS) ; returns 1 (ITEM) if the CS requires a single billable item or 2 (EVENT) if all active items for date are used
+1 ;
+2 NEW IBX,IBCSBR,IBBEVNT,IBBLITEM,IBCHGMTH
SET IBX=0
IF '$GET(CS)
GOTO CSITMSQ
+3 SET IBCSBR=$$CSBR^IBCRU3(+CS)
IF IBCSBR=""
GOTO CSITMSQ
+4 SET IBBEVNT=$PIECE(IBCSBR,U,1)
SET IBBLITEM=$PIECE(IBCSBR,U,4)
SET IBCHGMTH=$PIECE(IBCSBR,U,5)
+5 ;
+6 IF IBBEVNT["INPATIENT BEDSECTION STAY"
IF IBBLITEM=1
IF IBCHGMTH=1
SET IBX=1
GOTO CSITMSQ
+7 IF IBBEVNT["OUTPATIENT VISIT DATE"
IF IBBLITEM=1
IF IBCHGMTH=1
SET IBX=2
GOTO CSITMSQ
+8 IF IBBEVNT["PRESCRIPTION"
IF IBBLITEM=1
IF IBCHGMTH=1
SET IBX=2
GOTO CSITMSQ
+9 IF IBBEVNT["PRESCRIPTION"
IF IBBLITEM=3
IF IBCHGMTH=3
SET IBX=1
GOTO CSITMSQ
+10 IF IBBEVNT["PRESCRIPTION"
IF IBCHGMTH=2
SET IBX=1
GOTO CSITMSQ
+11 IF IBBEVNT["PROSTHETICS"
IF IBBLITEM=1
IF IBCHGMTH=1
SET IBX=2
GOTO CSITMSQ
+12 IF IBBEVNT["PROSTHETICS"
IF IBCHGMTH=2
SET IBX=1
GOTO CSITMSQ
+13 IF IBBEVNT["PROCEDURE"
IF IBBLITEM=2
IF IBCHGMTH=1
SET IBX=1
GOTO CSITMSQ
+14 IF IBBEVNT["PROCEDURE"
IF IBBLITEM=2
IF IBCHGMTH=4
SET IBX=1
GOTO CSITMSQ
+15 IF IBBEVNT["PROCEDURE"
IF IBBLITEM=2
IF IBCHGMTH=5
SET IBX=1
GOTO CSITMSQ
+16 IF IBBEVNT["PROCEDURE"
IF IBBLITEM=2
IF IBCHGMTH=6
SET IBX=1
GOTO CSITMSQ
+17 IF IBBEVNT["INPATIENT DRG"
IF IBBLITEM=4
IF IBCHGMTH=1
SET IBX=1
GOTO CSITMSQ
+18 IF IBBEVNT["UNASSOCIATED"
IF IBBLITEM=9
IF IBCHGMTH=1
SET IBX=1
GOTO CSITMSQ
CSITMSQ QUIT IBX
+1 ;
CSALL(CS,EVDT,ARR) ; returns all items billable on a given effective date for charge sets where all active items are billed (EVENT)
+1 ; finds most recent effective date, returns all items active on that date ie. does not check item inactive date
+2 ; first get all active items on date then get only those items active on most recent effective date
+3 ; Ouput: ARR = chg effective date
+4 ; ARR(source item pointer) =""
+5 ;
+6 NEW IBXRF,IBITM,IBEVDT,ARR1
KILL ARR
SET ARR=0
SET EVDT=$GET(EVDT)\1
IF '$GET(CS)!(EVDT'?7N)
GOTO CSALLQ
+7 IF +$$CSITMS(CS)'=2
GOTO CSALLQ
+8 ;
+9 SET IBXRF="AIVDTS"_CS
+10 SET IBITM=0
FOR
SET IBITM=$ORDER(^IBA(363.2,IBXRF,IBITM))
if 'IBITM
QUIT
Begin DoDot:1
+11 SET IBEVDT=$ORDER(^IBA(363.2,IBXRF,IBITM,-(EVDT+.01)))
if 'IBEVDT
QUIT
+12 SET ARR1(IBEVDT,IBITM)=""
End DoDot:1
+13 ;
+14 SET IBEVDT=$ORDER(ARR1(""))
+15 IF +IBEVDT
SET IBITM=0
FOR
SET IBITM=$ORDER(ARR1(IBEVDT,IBITM))
if 'IBITM
QUIT
SET ARR(IBITM)=""
SET ARR=-IBEVDT
+16 ;
CSALLQ QUIT
+1 ;
CPTUNITS(CS,UNIT) ; return raw data returns CPT units based on Charge Set and item
+1 ; Input: CS - Charge Set of charge determines Charge Method
+2 ; UNIT - total miles/minutes/hours of item
+3 ; Output: UNIT or calculated for miles/minutes/hours
+4 NEW IBUNITS,IBCSBR,IBCHGMTH
SET IBUNITS=+$GET(UNIT)
IF 'IBUNITS
GOTO CPTUNITQ
+5 SET CS=$GET(CS)
SET IBCSBR=$$CSBR^IBCRU3(CS)
SET IBCHGMTH=$PIECE(IBCSBR,U,5)
+6 ; miles
IF +IBCHGMTH=4
SET IBUNITS=$$MLUNIT^IBCRCC(UNIT)
+7 ; minutes
IF +IBCHGMTH=5
SET IBUNITS=$$MNUNIT^IBCRCC(UNIT)
+8 ; hours
IF +IBCHGMTH=6
SET IBUNITS=$$HRUNIT^IBCRCC(UNIT)
CPTUNITQ QUIT IBUNITS
+1 ;
CPTMOD(CS,CPT,MODS,DATE) ; check to see if a CPT-Modifier combination has a charge in this Charge Set, returns "" or CI IFN
+1 ; Input MODS is a list of modifiers to check separated by ','
+2 ; Output "" or list of modifiers with active charges in the set on date
+3 NEW IBMOD,IBI,IBX,IBY
SET (IBX,IBY)=""
IF '$GET(CS)!'$GET(CPT)!'$GET(MODS)!'$GET(DATE)
GOTO CPTMODQ
+4 FOR IBI=1:1
SET IBMOD=$PIECE(MODS,",",IBI)
if IBMOD=""
QUIT
Begin DoDot:1
+5 IF +$$FNDCI^IBCRU4(CS,CPT,DATE,,IBMOD)
SET IBX=IBX_IBY_IBMOD
SET IBY=","
End DoDot:1
+6 ;
CPTMODQ QUIT IBX
+1 ;
CHGMOD(IBIFN,CPT,EFFDT,CT) ; find charges for a procedure and a date for a bill
+1 ; returns: count of charges ':' list of charge items ':' list of charge modifiers
+2 NEW IB0,IBU,IBBDV,IBBCT,ARRCS,IBRS,IBCS,ARRCHG,IBFND,IBCIS,IBMODS,IBX
SET IBFND=0
SET (IBCIS,IBMODS)=""
+3 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
SET IBU=$GET(^DGCR(399,+$GET(IBIFN),"U"))
SET IBBDV=$PIECE(IB0,U,22)
SET IBBCT=$SELECT($DATA(CT):CT,1:$PIECE(IB0,U,27))
+4 IF IB0'=""
IF +IBU
IF +IBBDV
IF +$GET(CPT)
IF +$GET(EFFDT)
DO RT^IBCRU3($PIECE(IB0,U,7),$PIECE(IB0,U,5),EFFDT,.ARRCS,"PROCEDURE",IBBCT)
Begin DoDot:1
+5 SET IBRS=0
FOR
SET IBRS=$ORDER(ARRCS(IBRS))
if 'IBRS
QUIT
Begin DoDot:2
+6 SET IBCS=0
FOR
SET IBCS=$ORDER(ARRCS(IBRS,IBCS))
if 'IBCS
QUIT
IF +ARRCS(IBRS,IBCS)
Begin DoDot:3
+7 ; check division
IF $$CSDV^IBCRU3(IBCS,IBBDV)<0
QUIT
+8 ; ckeck snf/non-snf
IF '$$CHGOTH^IBCRBC2(IBIFN,IBRS,EFFDT)
QUIT
+9 IF +$$FNDCI^IBCRU4(IBCS,CPT,EFFDT,.ARRCHG)
SET IBFND=IBFND+ARRCHG
Begin DoDot:4
+10 SET IBX=0
FOR
SET IBX=$ORDER(ARRCHG(IBX))
if 'IBX
QUIT
SET IBCIS=IBCIS_IBX_U
SET IBMODS=IBMODS_$PIECE(ARRCHG(IBX),U,7)_U
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 IF +IBFND
SET IBFND=IBFND_":"_IBCIS_":"_IBMODS
CHGMODQ QUIT IBFND
+1 ;
CPTCHG(IBIFN,CT) ; return true if bill has auto add CPT charges for the Charge Type passed in (regardless of modifier)
+1 NEW IBFND,IB0,IBU,IBBILLDV,IBBCT,IBCT,ARRCPT,ARRCS,IBRS,IBCS,IBCPT,IBCPTDA,IBCPT0
SET IBFND=0
SET CT=$GET(CT)
+2 ;
+3 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
IF IB0=""
GOTO CPTCHGQ
+4 SET IBU=$GET(^DGCR(399,+$GET(IBIFN),"U"))
IF 'IBU
GOTO CPTCHGQ
+5 SET IBBILLDV=$PIECE(IB0,U,22)
SET IBBCT=$PIECE(IB0,U,27)
+6 ;
+7 SET IBCT=$SELECT(CT="BILL":IBBCT,CT="INST":1,CT="PROF":2,CT="OPST"&(IBBCT=1):2,CT="OPST"&(IBBCT=2):1,CT="":"",1:-1)
+8 IF IBCT<0
GOTO CPTCHGQ
+9 ;
+10 DO CPT^IBCRBG1(IBIFN,.ARRCPT)
IF '$ORDER(ARRCPT(0))
GOTO CPTCHGQ
+11 DO RT^IBCRU3($PIECE(IB0,U,7),$PIECE(IB0,U,5),$PIECE(IBU,U,1,2),.ARRCS,"PROCEDURE",IBCT)
+12 ;
+13 SET IBRS=0
FOR
SET IBRS=$ORDER(ARRCS(IBRS))
if 'IBRS
QUIT
Begin DoDot:1
+14 SET IBCS=0
FOR
SET IBCS=$ORDER(ARRCS(IBRS,IBCS))
if 'IBCS
QUIT
IF +ARRCS(IBRS,IBCS)
Begin DoDot:2
+15 ;
+16 SET IBCPT=0
FOR
SET IBCPT=$ORDER(ARRCPT(IBCPT))
if 'IBCPT
QUIT
Begin DoDot:3
+17 SET IBCPTDA=0
FOR
SET IBCPTDA=$ORDER(ARRCPT(IBCPT,IBCPTDA))
if 'IBCPTDA
QUIT
Begin DoDot:4
+18 ;
+19 SET IBCPT0=ARRCPT(IBCPT,IBCPTDA)
+20 ; check division
IF $$CSDV^IBCRU3(IBCS,$PIECE(IBCPT0,U,3),IBBILLDV)<0
QUIT
+21 ;
+22 IF +$$CHKIPB^IBCU7A1(IBCPT,IBCT)
SET IBFND=1
QUIT
+23 IF +$$FNDCI^IBCRU4(IBCS,IBCPT,$PIECE(IBCPT0,U,1))
SET IBFND=1
End DoDot:4
IF +IBFND
QUIT
End DoDot:3
IF +IBFND
QUIT
End DoDot:2
IF +IBFND
QUIT
End DoDot:1
IF +IBFND
QUIT
+24 ;
CPTCHGQ QUIT IBFND
