IBCRBC2 ;ALB/ARH - RATES: BILL CALCULATION OF ITEM CHARGE ; 22-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106,138,148,245,370,447**;21-MAR-94;Build 80
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Input: RS - rate schedule necessary to calculated modified charges
; CS - required, charge set which defines the charges to calculate
; ITEM - required, ptr to source item to be billed, type defined by billable item of the rate
; EVDT - date of event, to be used when searching for a charge effective date, default=DT
; UNITS - required, used only for Quantity: # of units of Charge Item Charge for each Item
; MOD - CPT Modifier if any
; INSRC - special revenue code to use (from ins comp), if any (overrides set and item rv cd)
; IDFRC - different revenue codes to use, these replace the standard set in CM (DRC:SRC,DRC:SRC)
; SAVE - serveral data items not needed here but passed on to next step (store) in TMP array:
; TUNITS - required to add charge to bill, total # of the Item on the bill
; CPT - default CPT to be added to the bill for the charge
; DIV - division charges apply to
; TYPE - type of item being billed - defines the source of the item on the bill
; ITMPTR - soft pointer to the item on the bill: may be a multiple or file IFN
; CMPNT - what component of the total charge: institutional or professional
; BEDS - billable bedsection to use if not a bedsection item, if null uses set default
; PROV - procedure provider
; CLINIC - procedures associated clinic
; IBOE - Outpatient Encounter, pointer to #408.69
; MODS - list of all modifiers define for the procedure, separated by ','
;
; Total charge is calculated: X = UNITS * UNIT CHARGE of the item (per unit charge (un-adjusted))
; Y = X modified by Rate Schedule Adjustment (per unit charge (adjusted))
; the Units are used to calculate the per item charge: 30 pills for an rx, 1 bs per bs
; and the Tunits are the number of that Item on the bill: 1 rx of 30 pills, 11 days of bs stay
;
; Output: TMP($J,"IBCRCC", containing all chargable items and all related info needed to file them on the bill
; each charge will have it's own entry, nothing combined (12 = per unit charge (adjusted), p13 = Tunits)
; TMP is not killed on entry so each items charges are compiled and added to existing charges
;
BITMCHG(RS,CS,ITEM,EVDT,UNITS,MOD,INSRC,IDFRC,SAVE) ; get bill charges for a specific item, rate schedule and charge set and date set into temp array
;
N IBCS0,IBDRVCD,IBBS,IBCHGARR,IBI,IBCNT,IBLN,IBCI,IBRVCD,IBPPRV,IBCHRG,IBTCHRG,IBRCHRG,IBPCHRG,IBACHRG
N IBMCHRG,IBMODS,IBBASE,IBCOM I '$G(ITEM)!'$G(CS)!'$G(UNITS) Q
;
S RS=$G(RS),EVDT=$S(+$G(EVDT):+EVDT\1,1:DT),MOD=$G(MOD),INSRC=$G(INSRC),IDFRC=$G(IDFRC),SAVE=$G(SAVE)
S IBCS0=$G(^IBE(363.1,+CS,0)),IBDRVCD=$P(IBCS0,U,5),IBPPRV=$P(SAVE,U,8),IBMODS=$P(SAVE,U,11)
S IBBS=+ITEM I $P($G(^IBE(363.3,+$P(IBCS0,U,2),0)),U,4)'=1 S IBBS=$P(SAVE,U,7) I 'IBBS S IBBS=$P(IBCS0,U,6)
I 'IBBS Q
;
D ITMCHG^IBCRCC(CS,ITEM,EVDT,MOD,.IBCHGARR)
;
S IBCNT=+$G(^TMP($J,"IBCRCC"))
S IBI=0 F S IBI=$O(IBCHGARR(IBI)) Q:'IBI D
. ; START IB*2.0*447 BI ZERO DOLLAR CHANGES
. ;S IBLN=IBCHGARR(IBI),IBCI=+IBLN,IBCHRG=$P(IBLN,U,3),(IBPCHRG,IBRCHRG)="" Q:'IBCHRG S IBBASE=$P(IBLN,U,4)
. S IBLN=IBCHGARR(IBI),IBCI=+IBLN,IBCHRG=$P(IBLN,U,3),(IBPCHRG,IBRCHRG)="" S IBBASE=$P(IBLN,U,4)
. ; END IB*2.0*447 BI ZERO DOLLAR CHANGES
. S IBRVCD=INSRC I 'IBRVCD S IBRVCD=$P(IBLN,U,2)
. I 'IBRVCD S IBRVCD=$P($$RVLNK^IBCRU6(+ITEM,"",+CS),U,2) I 'IBRVCD S IBRVCD=IBDRVCD Q:'IBRVCD
. I +IDFRC,+$P(IDFRC,IBRVCD_":",2) S IBRVCD=+$P(IDFRC,IBRVCD_":",2) Q:IBRVCD'?3N
. ;
. S IBCHRG=IBCHRG*UNITS
. S IBCHRG=IBCHRG+IBBASE
. S IBPCHRG=IBCHRG I +IBPPRV S IBPCHRG=$$PRVCHG^IBCRCC(CS,IBCHRG,IBPPRV,EVDT,ITEM)
. S IBMCHRG=+IBPCHRG I +IBMODS S IBMCHRG=$$MODCHG^IBCRCC(CS,IBPCHRG,IBMODS)
. S (IBCHRG,IBTCHRG)=+IBMCHRG
. S IBACHRG=IBTCHRG I +RS,+IBTCHRG S IBRCHRG=$$RATECHG^IBCRCC(RS,IBTCHRG,EVDT),IBACHRG=+IBRCHRG
. ;
. S IBCNT=IBCNT+1,^TMP($J,"IBCRCC")=IBCNT
. S ^TMP($J,"IBCRCC",IBCNT)=IBCI_U_CS_U_RS_U_ITEM_U_MOD_U_IBRVCD_U_IBBS_U_EVDT_U_IBCHRG_U_UNITS_U_IBTCHRG_U_IBACHRG_U_$G(SAVE)
. ;
. I (UNITS>1)!(+IBBASE) S IBCOM=$$COMMUB(CS,UNITS,IBBASE) I IBCOM'="" D COMMENT(IBCNT,IBCOM)
. I $P(IBPCHRG,U,2)'="" S IBCOM=$P(IBPCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM)
. I $P(IBMCHRG,U,2)'="" S IBCOM=$P(IBMCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM)
. I $P(IBRCHRG,U,2)'="" S IBCOM=$P(IBRCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM)
Q
;
I +$D(^TMP($J,"IBCRCC",+$G(LINE))) N IBX D
. S IBX=$O(^TMP($J,"IBCRCC",+LINE,"CC",9999),-1) S IBX=IBX+1
. S ^TMP($J,"IBCRCC",+LINE,"CC",IBX)=$G(COMM)
Q
;
COMMUB(CS,UNITS,BASE) ; return comment for special units and base
N IBX,IBY,IBCM S IBX="",IBY="Charge calculated"
S IBCM=$P($G(^IBE(363.1,+CS,0)),U,2),IBCM=$P($G(^IBE(363.3,+IBCM,0)),U,5)
S IBCM=$S(IBCM=4:"Miles",IBCM=5:"SubUnits",IBCM=6:"Hours",1:"")
I +$G(UNITS) S IBX=IBY_" for "_UNITS_" "_IBCM,IBY=""
I +$G(BASE) S IBX=IBY_IBX_" with a Base Charge="_$J(BASE,0,2)
Q IBX
;
ALLBEDS(RS,CS,EVDT,RC,DFRC,SAVE) ; get charges for all bedsections active on date of visit
; each effective date supercedes all previous effective date, regardless of the item
; used for per diem rates where the charges are associated with a bedsection, but the item being billed is not
; a bedsection, so the count of the item on the bill is found and applied as the units to all bedsections active
; on the event date (the 3 opt visit dates on a bill are the units for the Outpatient Visit bedsection charge)
;
N IBITM,IBITEMS I '$G(CS)!'$G(EVDT) Q
;
D CSALL^IBCRCU1(CS,EVDT,.IBITEMS)
;
I +IBITEMS S IBITM="" F S IBITM=$O(IBITEMS(IBITM)) Q:'IBITM D
. D BITMCHG($G(RS),CS,IBITM,EVDT,1,"",$G(RC),$G(DFRC),$G(SAVE))
Q
;
;
CPTUNITS(CS,CHGMTH,ITLINE) ; return CPT units based on Charge Method and CPT data
; Input: CS is the related Charge Set
; CHGMTH is the Rate Schedule Charge Method (363.3, .05)
; ITLINE is item data from CPT^IBCRBG1
; Output: calculated units for CPT, 1 or calculated for miles/minutes/hours
N IBUNIT S IBUNIT=1,CHGMTH=$G(CHGMTH),ITLINE=$G(ITLINE),CS=$G(CS)
I CHGMTH=4 S IBUNIT=+$P(ITLINE,U,8) ; miles
I CHGMTH=5 S IBUNIT=+$P(ITLINE,U,7) ; minutes
I CHGMTH=6 S IBUNIT=+$P(ITLINE,U,9) ; hours
S IBUNIT=$$CPTUNITS^IBCRCU1(CS,IBUNIT)
Q IBUNIT
;
CHGOTH(IBIFN,RS,EVDT) ; check if the Rate Schedule charges are applicable to the event date for the bill
; this is relevent to RC v2.0 and type of care of Other
; both Rate Schedule is SNF and event date is SNF care or neither can be otherwise no charge
; SNF charges can't be used for non-SNF care and non-SNF charges can't be used for SNF care
; Output: returns true if charges and bill date are of same type, SNF or non-SNF
N IBOK,IBRSTY,IBDTTY S (IBRSTY,IBDTTY)=0,IBOK=1
I $G(EVDT)<$$VERSDT^IBCRU8(2) G CHGOTHQ
I '$G(IBIFN)!'$G(RS) G CHGOTHQ
;
S IBRSTY=$$RSOTHER^IBCRU8(RS) ; are charges for other type of care
S IBDTTY=$$BOTHER^IBCU3(IBIFN,EVDT) ; is date other type of care
;
I +IBRSTY,'IBDTTY S IBOK=0
I 'IBRSTY,+IBDTTY S IBOK=0
;
CHGOTHQ Q IBOK
;
CHGICU(CS,BS) ; check if charge and bedsection match relative to ICU RC 2.0+, compares Charge Set Name and Bedsection
; both the charge set and the bedsection have to be ICU or neither of them can be ICU otherwise no charge
; ICU charges can't be used with non-ICU bedsections and non-ICU charges can't be used with ICU bedsection
; Output: returns true if charges and bedsection are of same type, ICU or non-ICU
N IBCSICU,IBCSN,IBICU,IBOK S (IBOK,IBCSICU)=0,BS=+$G(BS)
S IBICU=$$MCCRUTL^IBCRU1("ICU",5)
S IBCSN=$G(^IBE(363.1,+$G(CS),0)) I $E(IBCSN,1,2)'="RC" S IBOK=1
I $P(IBCSN,U,1)["ICU" S IBCSICU=1 ; charge set is icu
;
I BS=IBICU,+IBCSICU S IBOK=1 ; both bedsection and charge set are icu
I BS'=IBICU,'IBCSICU S IBOK=1 ; niether bedsection nor charge set are icu
Q IBOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRBC2 8477 printed Oct 16, 2024@18:19:26 Page 2
IBCRBC2 ;ALB/ARH - RATES: BILL CALCULATION OF ITEM CHARGE ; 22-MAY-1996
+1 ;;2.0;INTEGRATED BILLING;**52,106,138,148,245,370,447**;21-MAR-94;Build 80
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Input: RS - rate schedule necessary to calculated modified charges
+5 ; CS - required, charge set which defines the charges to calculate
+6 ; ITEM - required, ptr to source item to be billed, type defined by billable item of the rate
+7 ; EVDT - date of event, to be used when searching for a charge effective date, default=DT
+8 ; UNITS - required, used only for Quantity: # of units of Charge Item Charge for each Item
+9 ; MOD - CPT Modifier if any
+10 ; INSRC - special revenue code to use (from ins comp), if any (overrides set and item rv cd)
+11 ; IDFRC - different revenue codes to use, these replace the standard set in CM (DRC:SRC,DRC:SRC)
+12 ; SAVE - serveral data items not needed here but passed on to next step (store) in TMP array:
+13 ; TUNITS - required to add charge to bill, total # of the Item on the bill
+14 ; CPT - default CPT to be added to the bill for the charge
+15 ; DIV - division charges apply to
+16 ; TYPE - type of item being billed - defines the source of the item on the bill
+17 ; ITMPTR - soft pointer to the item on the bill: may be a multiple or file IFN
+18 ; CMPNT - what component of the total charge: institutional or professional
+19 ; BEDS - billable bedsection to use if not a bedsection item, if null uses set default
+20 ; PROV - procedure provider
+21 ; CLINIC - procedures associated clinic
+22 ; IBOE - Outpatient Encounter, pointer to #408.69
+23 ; MODS - list of all modifiers define for the procedure, separated by ','
+24 ;
+25 ; Total charge is calculated: X = UNITS * UNIT CHARGE of the item (per unit charge (un-adjusted))
+26 ; Y = X modified by Rate Schedule Adjustment (per unit charge (adjusted))
+27 ; the Units are used to calculate the per item charge: 30 pills for an rx, 1 bs per bs
+28 ; and the Tunits are the number of that Item on the bill: 1 rx of 30 pills, 11 days of bs stay
+29 ;
+30 ; Output: TMP($J,"IBCRCC", containing all chargable items and all related info needed to file them on the bill
+31 ; each charge will have it's own entry, nothing combined (12 = per unit charge (adjusted), p13 = Tunits)
+32 ; TMP is not killed on entry so each items charges are compiled and added to existing charges
+33 ;
BITMCHG(RS,CS,ITEM,EVDT,UNITS,MOD,INSRC,IDFRC,SAVE) ; get bill charges for a specific item, rate schedule and charge set and date set into temp array
+1 ;
+2 NEW IBCS0,IBDRVCD,IBBS,IBCHGARR,IBI,IBCNT,IBLN,IBCI,IBRVCD,IBPPRV,IBCHRG,IBTCHRG,IBRCHRG,IBPCHRG,IBACHRG
+3 NEW IBMCHRG,IBMODS,IBBASE,IBCOM
IF '$GET(ITEM)!'$GET(CS)!'$GET(UNITS)
QUIT
+4 ;
+5 SET RS=$GET(RS)
SET EVDT=$SELECT(+$GET(EVDT):+EVDT\1,1:DT)
SET MOD=$GET(MOD)
SET INSRC=$GET(INSRC)
SET IDFRC=$GET(IDFRC)
SET SAVE=$GET(SAVE)
+6 SET IBCS0=$GET(^IBE(363.1,+CS,0))
SET IBDRVCD=$PIECE(IBCS0,U,5)
SET IBPPRV=$PIECE(SAVE,U,8)
SET IBMODS=$PIECE(SAVE,U,11)
+7 SET IBBS=+ITEM
IF $PIECE($GET(^IBE(363.3,+$PIECE(IBCS0,U,2),0)),U,4)'=1
SET IBBS=$PIECE(SAVE,U,7)
IF 'IBBS
SET IBBS=$PIECE(IBCS0,U,6)
+8 IF 'IBBS
QUIT
+9 ;
+10 DO ITMCHG^IBCRCC(CS,ITEM,EVDT,MOD,.IBCHGARR)
+11 ;
+12 SET IBCNT=+$GET(^TMP($JOB,"IBCRCC"))
+13 SET IBI=0
FOR
SET IBI=$ORDER(IBCHGARR(IBI))
if 'IBI
QUIT
Begin DoDot:1
+14 ; START IB*2.0*447 BI ZERO DOLLAR CHANGES
+15 ;S IBLN=IBCHGARR(IBI),IBCI=+IBLN,IBCHRG=$P(IBLN,U,3),(IBPCHRG,IBRCHRG)="" Q:'IBCHRG S IBBASE=$P(IBLN,U,4)
+16 SET IBLN=IBCHGARR(IBI)
SET IBCI=+IBLN
SET IBCHRG=$PIECE(IBLN,U,3)
SET (IBPCHRG,IBRCHRG)=""
SET IBBASE=$PIECE(IBLN,U,4)
+17 ; END IB*2.0*447 BI ZERO DOLLAR CHANGES
+18 SET IBRVCD=INSRC
IF 'IBRVCD
SET IBRVCD=$PIECE(IBLN,U,2)
+19 IF 'IBRVCD
SET IBRVCD=$PIECE($$RVLNK^IBCRU6(+ITEM,"",+CS),U,2)
IF 'IBRVCD
SET IBRVCD=IBDRVCD
if 'IBRVCD
QUIT
+20 IF +IDFRC
IF +$PIECE(IDFRC,IBRVCD_":",2)
SET IBRVCD=+$PIECE(IDFRC,IBRVCD_":",2)
if IBRVCD'?3N
QUIT
+21 ;
+22 SET IBCHRG=IBCHRG*UNITS
+23 SET IBCHRG=IBCHRG+IBBASE
+24 SET IBPCHRG=IBCHRG
IF +IBPPRV
SET IBPCHRG=$$PRVCHG^IBCRCC(CS,IBCHRG,IBPPRV,EVDT,ITEM)
+25 SET IBMCHRG=+IBPCHRG
IF +IBMODS
SET IBMCHRG=$$MODCHG^IBCRCC(CS,IBPCHRG,IBMODS)
+26 SET (IBCHRG,IBTCHRG)=+IBMCHRG
+27 SET IBACHRG=IBTCHRG
IF +RS
IF +IBTCHRG
SET IBRCHRG=$$RATECHG^IBCRCC(RS,IBTCHRG,EVDT)
SET IBACHRG=+IBRCHRG
+28 ;
+29 SET IBCNT=IBCNT+1
SET ^TMP($JOB,"IBCRCC")=IBCNT
+30 SET ^TMP($JOB,"IBCRCC",IBCNT)=IBCI_U_CS_U_RS_U_ITEM_U_MOD_U_IBRVCD_U_IBBS_U_EVDT_U_IBCHRG_U_UNITS_U_IBTCHRG_U_IBACHRG_U_$GET(SAVE)
+31 ;
+32 IF (UNITS>1)!(+IBBASE)
SET IBCOM=$$COMMUB(CS,UNITS,IBBASE)
IF IBCOM'=""
DO COMMENT(IBCNT,IBCOM)
+33 IF $PIECE(IBPCHRG,U,2)'=""
SET IBCOM=$PIECE(IBPCHRG,U,2)
IF IBCOM'=""
DO COMMENT(IBCNT,IBCOM)
+34 IF $PIECE(IBMCHRG,U,2)'=""
SET IBCOM=$PIECE(IBMCHRG,U,2)
IF IBCOM'=""
DO COMMENT(IBCNT,IBCOM)
+35 IF $PIECE(IBRCHRG,U,2)'=""
SET IBCOM=$PIECE(IBRCHRG,U,2)
IF IBCOM'=""
DO COMMENT(IBCNT,IBCOM)
End DoDot:1
+36 QUIT
+37 ;
+1 IF +$DATA(^TMP($JOB,"IBCRCC",+$GET(LINE)))
NEW IBX
Begin DoDot:1
+2 SET IBX=$ORDER(^TMP($JOB,"IBCRCC",+LINE,"CC",9999),-1)
SET IBX=IBX+1
+3 SET ^TMP($JOB,"IBCRCC",+LINE,"CC",IBX)=$GET(COMM)
End DoDot:1
+4 QUIT
+5 ;
COMMUB(CS,UNITS,BASE) ; return comment for special units and base
+1 NEW IBX,IBY,IBCM
SET IBX=""
SET IBY="Charge calculated"
+2 SET IBCM=$PIECE($GET(^IBE(363.1,+CS,0)),U,2)
SET IBCM=$PIECE($GET(^IBE(363.3,+IBCM,0)),U,5)
+3 SET IBCM=$SELECT(IBCM=4:"Miles",IBCM=5:"SubUnits",IBCM=6:"Hours",1:"")
+4 IF +$GET(UNITS)
SET IBX=IBY_" for "_UNITS_" "_IBCM
SET IBY=""
+5 IF +$GET(BASE)
SET IBX=IBY_IBX_" with a Base Charge="_$JUSTIFY(BASE,0,2)
+6 QUIT IBX
+7 ;
ALLBEDS(RS,CS,EVDT,RC,DFRC,SAVE) ; get charges for all bedsections active on date of visit
+1 ; each effective date supercedes all previous effective date, regardless of the item
+2 ; used for per diem rates where the charges are associated with a bedsection, but the item being billed is not
+3 ; a bedsection, so the count of the item on the bill is found and applied as the units to all bedsections active
+4 ; on the event date (the 3 opt visit dates on a bill are the units for the Outpatient Visit bedsection charge)
+5 ;
+6 NEW IBITM,IBITEMS
IF '$GET(CS)!'$GET(EVDT)
QUIT
+7 ;
+8 DO CSALL^IBCRCU1(CS,EVDT,.IBITEMS)
+9 ;
+10 IF +IBITEMS
SET IBITM=""
FOR
SET IBITM=$ORDER(IBITEMS(IBITM))
if 'IBITM
QUIT
Begin DoDot:1
+11 DO BITMCHG($GET(RS),CS,IBITM,EVDT,1,"",$GET(RC),$GET(DFRC),$GET(SAVE))
End DoDot:1
+12 QUIT
+13 ;
+14 ;
CPTUNITS(CS,CHGMTH,ITLINE) ; return CPT units based on Charge Method and CPT data
+1 ; Input: CS is the related Charge Set
+2 ; CHGMTH is the Rate Schedule Charge Method (363.3, .05)
+3 ; ITLINE is item data from CPT^IBCRBG1
+4 ; Output: calculated units for CPT, 1 or calculated for miles/minutes/hours
+5 NEW IBUNIT
SET IBUNIT=1
SET CHGMTH=$GET(CHGMTH)
SET ITLINE=$GET(ITLINE)
SET CS=$GET(CS)
+6 ; miles
IF CHGMTH=4
SET IBUNIT=+$PIECE(ITLINE,U,8)
+7 ; minutes
IF CHGMTH=5
SET IBUNIT=+$PIECE(ITLINE,U,7)
+8 ; hours
IF CHGMTH=6
SET IBUNIT=+$PIECE(ITLINE,U,9)
+9 SET IBUNIT=$$CPTUNITS^IBCRCU1(CS,IBUNIT)
+10 QUIT IBUNIT
+11 ;
CHGOTH(IBIFN,RS,EVDT) ; check if the Rate Schedule charges are applicable to the event date for the bill
+1 ; this is relevent to RC v2.0 and type of care of Other
+2 ; both Rate Schedule is SNF and event date is SNF care or neither can be otherwise no charge
+3 ; SNF charges can't be used for non-SNF care and non-SNF charges can't be used for SNF care
+4 ; Output: returns true if charges and bill date are of same type, SNF or non-SNF
+5 NEW IBOK,IBRSTY,IBDTTY
SET (IBRSTY,IBDTTY)=0
SET IBOK=1
+6 IF $GET(EVDT)<$$VERSDT^IBCRU8(2)
GOTO CHGOTHQ
+7 IF '$GET(IBIFN)!'$GET(RS)
GOTO CHGOTHQ
+8 ;
+9 ; are charges for other type of care
SET IBRSTY=$$RSOTHER^IBCRU8(RS)
+10 ; is date other type of care
SET IBDTTY=$$BOTHER^IBCU3(IBIFN,EVDT)
+11 ;
+12 IF +IBRSTY
IF 'IBDTTY
SET IBOK=0
+13 IF 'IBRSTY
IF +IBDTTY
SET IBOK=0
+14 ;
CHGOTHQ QUIT IBOK
+1 ;
CHGICU(CS,BS) ; check if charge and bedsection match relative to ICU RC 2.0+, compares Charge Set Name and Bedsection
+1 ; both the charge set and the bedsection have to be ICU or neither of them can be ICU otherwise no charge
+2 ; ICU charges can't be used with non-ICU bedsections and non-ICU charges can't be used with ICU bedsection
+3 ; Output: returns true if charges and bedsection are of same type, ICU or non-ICU
+4 NEW IBCSICU,IBCSN,IBICU,IBOK
SET (IBOK,IBCSICU)=0
SET BS=+$GET(BS)
+5 SET IBICU=$$MCCRUTL^IBCRU1("ICU",5)
+6 SET IBCSN=$GET(^IBE(363.1,+$GET(CS),0))
IF $EXTRACT(IBCSN,1,2)'="RC"
SET IBOK=1
+7 ; charge set is icu
IF $PIECE(IBCSN,U,1)["ICU"
SET IBCSICU=1
+8 ;
+9 ; both bedsection and charge set are icu
IF BS=IBICU
IF +IBCSICU
SET IBOK=1
+10 ; niether bedsection nor charge set are icu
IF BS'=IBICU
IF 'IBCSICU
SET IBOK=1
+11 QUIT IBOK
