IBCRU8.m

IBCRU8 ;ALB/ARH - RATES: UTILITIES (RC) ; 10-OCT-03

 ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

VERSDT(VERS) ; return effective date of RC version passed in

 N IBX S IBX=0 I +$G(VERS) S IBX=$$VERSDT^IBCRHBRV(VERS)

 Q IBX

 ;

RCDV(DIV) ; return RC Billing Region Data a division 'Region IFN^ID^TYPE'

 N IBX,IBRG,IBRG0 S IBX=0

 I +$G(DIV) S IBRG=0 F  S IBRG=$O(^IBE(363.31,IBRG)) Q:'IBRG  D

 . I '$O(^IBE(363.31,IBRG,11,"B",+DIV,0)) Q

 . S IBRG0=$G(^IBE(363.31,IBRG,0)) I $E(IBRG0,1,3)'="RC " Q

 . S IBX=IBRG_U_$P(IBRG0,U,2,3)

 Q IBX

 ;

RSOTHER(RS) ; return Billable Service if the Rate Schedule is applicable to Other Type of Care

 ; with RC v2.0 Skilled Nursing and Sub-Acute has an entire set of charges separate from inpatient charges

 ; charges are identified as Other (SNF/SA) by the Rate Schedule Billable Service for RC v2.0+ only

 ; Output: 0 - Charges are not applicable to Other Care

 ;         Billable Service ifn - Charges are applicable to the Billable Service only

 ; only the Billable Service SKILLED NURSING is defined as an 'Other' type of care and for RC 2.0+ only

 N IBRS0,IBRCX,IBFND,IBX S (IBRCX,IBFND)=0 S IBRS0=$G(^IBE(363,+$G(RS),0)) I IBRS0="" G RSOTHERQ

 I $P(IBRS0,U,5)<$$VERSDT(2) G RSOTHERQ

 S IBX=0 F  S IBX=$O(^IBE(363,RS,11,"B",IBX)) Q:'IBX  I $E($G(^IBE(363.1,IBX,0)),1,3)="RC-" S IBRCX=1 Q

 I 'IBRCX G RSOTHERQ

 S IBX=$$MCCRUTL^IBCRU1("SKILLED NURSING",13) I +$P(IBRS0,U,4)=IBX S IBFND=IBX

RSOTHERQ Q IBFND

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCRU8   1540     printed  Apr 09, 2024@21:04:43                                                                                                                                                                                                      Page 2

IBCRU8    ;ALB/ARH - RATES: UTILITIES (RC) ; 10-OCT-03

 +1       ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

VERSDT(VERS) ; return effective date of RC version passed in

 +1        NEW IBX

           SET IBX=0

           IF +$GET(VERS)

               SET IBX=$$VERSDT^IBCRHBRV(VERS)

 +2        QUIT IBX

 +3       ;

RCDV(DIV) ; return RC Billing Region Data a division 'Region IFN^ID^TYPE'

 +1        NEW IBX,IBRG,IBRG0

           SET IBX=0

 +2        IF +$GET(DIV)

               SET IBRG=0

               FOR 

                   SET IBRG=$ORDER(^IBE(363.31,IBRG))

                   if 'IBRG

                       QUIT 

                   Begin DoDot:1

 +3                    IF '$ORDER(^IBE(363.31,IBRG,11,"B",+DIV,0))

                           QUIT 

 +4                    SET IBRG0=$GET(^IBE(363.31,IBRG,0))

                       IF $EXTRACT(IBRG0,1,3)'="RC "

                           QUIT 

 +5                    SET IBX=IBRG_U_$PIECE(IBRG0,U,2,3)

                   End DoDot:1

 +6        QUIT IBX

 +7       ;

RSOTHER(RS) ; return Billable Service if the Rate Schedule is applicable to Other Type of Care

 +1       ; with RC v2.0 Skilled Nursing and Sub-Acute has an entire set of charges separate from inpatient charges

 +2       ; charges are identified as Other (SNF/SA) by the Rate Schedule Billable Service for RC v2.0+ only

 +3       ; Output: 0 - Charges are not applicable to Other Care

 +4       ;         Billable Service ifn - Charges are applicable to the Billable Service only

 +5       ; only the Billable Service SKILLED NURSING is defined as an 'Other' type of care and for RC 2.0+ only

 +6        NEW IBRS0,IBRCX,IBFND,IBX

           SET (IBRCX,IBFND)=0

           SET IBRS0=$GET(^IBE(363,+$GET(RS),0))

           IF IBRS0=""

               GOTO RSOTHERQ

 +7        IF $PIECE(IBRS0,U,5)<$$VERSDT(2)

               GOTO RSOTHERQ

 +8        SET IBX=0

           FOR 

               SET IBX=$ORDER(^IBE(363,RS,11,"B",IBX))

               if 'IBX

                   QUIT 

               IF $EXTRACT($GET(^IBE(363.1,IBX,0)),1,3)="RC-"

                   SET IBRCX=1

                   QUIT 

 +9        IF 'IBRCX

               GOTO RSOTHERQ

 +10       SET IBX=$$MCCRUTL^IBCRU1("SKILLED NURSING",13)

           IF +$PIECE(IBRS0,U,4)=IBX

               SET IBFND=IBX

RSOTHERQ   QUIT IBFND