IBAUTL1.m

IBAUTL1 ;ALB/AAS - IB UTILITY ROUTINE FOR MEDICARE RATES ; 30-AUG-91

 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

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

 ;

RATE ;  - Calculates the Medicare rate for a CPT code.

 ;  - Input  X = visit date ^ division ^ ifn of cpt code

 ;  - Output Y = charge

 ;

 S IBX=X N X S X=IBX

 S IBRG=$O(^IBE(350.4,"AIVDT",+$P(X,"^",3),-($P(X,"^")+1))) I IBRG S IBRG=$O(^(+IBRG,0)) ;determine current ib action type for code

 I $S('IBRG:1,'$D(^IBE(350.4,+IBRG,0)):1,'$P(^(0),"^",3):1,1:0) S Y=-1 G RATEQ

 S IBRG=+$P(^IBE(350.4,IBRG,0),"^",3)

 S DA=$O(^IBE(350.2,"AIVDT",IBRG,-($P(X,"^")+1))) I DA S DA=$O(^(+DA,0)) ; determine current ib action charge for rate group

 I $S('DA:1,'$D(^IBE(350.2,DA,10)):1,1:0) S Y=-1 G RATEQ

 X ^IBE(350.2,DA,10)

RATEQ K IBRG,IBX

 Q

 ;

VAR ;  -Called by entries in 350.2 to get variables

 ;  -input x=visit date^division ifn

 ;        da=internal number from 350.2

 ;  -output y=wage%^non-wage%^locality multiplier

 ;

 S IBLOC=$O(^IBE(350.5,"AIVDT",+$P(X,"^",2),-($P(X,"^")+1))) I IBLOC S IBLOC=$O(^(+IBLOC,0))

 I $S('IBLOC:1,'$D(^IBE(350.5,+IBLOC,0)):1,'$P(^(0),"^",7):1,1:0) S Y=-1 G VARQ

 S Y=$P(^IBE(350.5,IBLOC,0),"^",5,7)

VARQ K IBLOC,IBWAG Q

 ;

TEST S DA=14,X=DT_"^1^10141" D RATE ;X ^IBE(350.2,DA,10) W X," ",Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBAUTL1   1337     printed  Feb 18, 2025@23:34:28                                                                                                                                                                                                     Page 2

IBAUTL1   ;ALB/AAS - IB UTILITY ROUTINE FOR MEDICARE RATES ; 30-AUG-91

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

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

 +3       ;

RATE      ;  - Calculates the Medicare rate for a CPT code.

 +1       ;  - Input  X = visit date ^ division ^ ifn of cpt code

 +2       ;  - Output Y = charge

 +3       ;

 +4        SET IBX=X

           NEW X

           SET X=IBX

 +5       ;determine current ib action type for code

           SET IBRG=$ORDER(^IBE(350.4,"AIVDT",+$PIECE(X,"^",3),-($PIECE(X,"^")+1)))

           IF IBRG

               SET IBRG=$ORDER(^(+IBRG,0))

 +6        IF $SELECT('IBRG:1,'$DATA(^IBE(350.4,+IBRG,0)):1,'$PIECE(^(0),"^",3):1,1:0)

               SET Y=-1

               GOTO RATEQ

 +7        SET IBRG=+$PIECE(^IBE(350.4,IBRG,0),"^",3)

 +8       ; determine current ib action charge for rate group

           SET DA=$ORDER(^IBE(350.2,"AIVDT",IBRG,-($PIECE(X,"^")+1)))

           IF DA

               SET DA=$ORDER(^(+DA,0))

 +9        IF $SELECT('DA:1,'$DATA(^IBE(350.2,DA,10)):1,1:0)

               SET Y=-1

               GOTO RATEQ

 +10       XECUTE ^IBE(350.2,DA,10)

RATEQ      KILL IBRG,IBX

 +1        QUIT 

 +2       ;

VAR       ;  -Called by entries in 350.2 to get variables

 +1       ;  -input x=visit date^division ifn

 +2       ;        da=internal number from 350.2

 +3       ;  -output y=wage%^non-wage%^locality multiplier

 +4       ;

 +5        SET IBLOC=$ORDER(^IBE(350.5,"AIVDT",+$PIECE(X,"^",2),-($PIECE(X,"^")+1)))

           IF IBLOC

               SET IBLOC=$ORDER(^(+IBLOC,0))

 +6        IF $SELECT('IBLOC:1,'$DATA(^IBE(350.5,+IBLOC,0)):1,'$PIECE(^(0),"^",7):1,1:0)

               SET Y=-1

               GOTO VARQ

 +7        SET Y=$PIECE(^IBE(350.5,IBLOC,0),"^",5,7)

VARQ       KILL IBLOC,IBWAG

           QUIT 

 +1       ;

TEST      ;X ^IBE(350.2,DA,10) W X," ",Y

           SET DA=14

           SET X=DT_"^1^10141"

           DO RATE