Routine: IBINI01L

IBINI01L	; ; 21-MAR-1994

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

	Q:'DIFQR(350.2)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y

Q	Q

	;;^UTILITY(U,$J,350.2)

	;;=^IBE(350.2,

	;;^UTILITY(U,$J,350.2,0)

	;;=IB ACTION CHARGE^350.2I^35^29

	;;^UTILITY(U,$J,350.2,1,0)

	;;=RX1^2901001^1^2

	;;^UTILITY(U,$J,350.2,2,0)

	;;=RX2^2901001^2^2

	;;^UTILITY(U,$J,350.2,3,0)

	;;=RX3^2901001^3^2

	;;^UTILITY(U,$J,350.2,4,0)

	;;=RX4^2901001^4^2

	;;^UTILITY(U,$J,350.2,5,0)

	;;=RX5^2901001^5^2

	;;^UTILITY(U,$J,350.2,6,0)

	;;=RX6^2901001^6^2

	;;^UTILITY(U,$J,350.2,7,0)

	;;=MEDICARE 1^2920101^7^285

	;;^UTILITY(U,$J,350.2,7,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,8,0)

	;;=MEDICARE 2^2920101^8^382

	;;^UTILITY(U,$J,350.2,8,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,9,0)

	;;=MEDICARE 3^2920101^9^438

	;;^UTILITY(U,$J,350.2,9,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,10,0)

	;;=MEDICARE 4^2920101^10^539

	;;^UTILITY(U,$J,350.2,10,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,11,0)

	;;=MEDICARE 5^2920101^11^615

	;;^UTILITY(U,$J,350.2,11,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,12,0)

	;;=MEDICARE 6^2920101^12^580^^200

	;;^UTILITY(U,$J,350.2,12,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,13,0)

	;;=MEDICARE 7^2920101^13^853

	;;^UTILITY(U,$J,350.2,13,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,14,0)

	;;=MEDICARE 8^2920101^14^705^^200

	;;^UTILITY(U,$J,350.2,14,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,15,0)

	;;=MEDICARE 9^2920101^63^0

	;;^UTILITY(U,$J,350.2,15,10)

	;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

	;;^UTILITY(U,$J,350.2,19,0)

	;;=INPT PER DIEM^2901001^45^10

	;;^UTILITY(U,$J,350.2,20,0)

	;;=NHCU PER DIEM^2901001^48^5

	;;^UTILITY(U,$J,350.2,24,0)

	;;=MEDICARE DEDUCTIBLE^2860701^54^492

	;;^UTILITY(U,$J,350.2,25,0)

	;;=MEDICARE DEDUCTIBLE^2870101^54^520

	;;^UTILITY(U,$J,350.2,26,0)

	;;=MEDICARE DEDUCTIBLE^2880101^54^540

	;;^UTILITY(U,$J,350.2,27,0)

	;;=MEDICARE DEDUCTIBLE^2890101^54^560

	;;^UTILITY(U,$J,350.2,28,0)

	;;=MEDICARE DEDUCTIBLE^2900101^54^592

	;;^UTILITY(U,$J,350.2,29,0)

	;;=MEDICARE DEDUCTIBLE^2910101^54^628

	;;^UTILITY(U,$J,350.2,30,0)

	;;=MEDICARE DEDUCTIBLE^2920101^54^652

	;;^UTILITY(U,$J,350.2,32,0)

	;;=MEDICARE DEDUCTIBLE^2930101^54^676

	;;^UTILITY(U,$J,350.2,33,0)

	;;=CHAMPVA SUBSISTENCE LIMIT^2911001^64^25

	;;^UTILITY(U,$J,350.2,34,0)

	;;=CHAMPVA PER DIEM^2911001^65^8.95

	;;^UTILITY(U,$J,350.2,35,0)

	;;=CHAMPVA PER DIEM^2921001^65^9.30

	;;^UTILITY(U,$J,350.2,36,0)

	;;=MEDICARE DEDUCTIBLE^2940101^54^696

IBINI01L  ; ; 21-MAR-1994

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

 +2        IF 'DIFQR(350.2)

               QUIT

           FOR I=1:2

               SET X=$TEXT(Q+I)

               IF X=""

                   QUIT

               SET Y=$EXTRACT($TEXT(Q+I+1),4,999)

               SET X=$EXTRACT(X,4,999)

               IF $ASCII(Y)=126

                   SET I=I+1

                   SET Y=$EXTRACT(Y,2,999)_$EXTRACT($TEXT(Q+I+1),5,99)

               IF $ASCII(Y)=61

                   SET Y=$EXTRACT(Y,2,999)

               XECUTE NO

              IF '$TEST

                   SET @X=Y

Q          QUIT

 +1       ;;^UTILITY(U,$J,350.2)

 +2       ;;=^IBE(350.2,

 +3       ;;^UTILITY(U,$J,350.2,0)

 +4       ;;=IB ACTION CHARGE^350.2I^35^29

 +5       ;;^UTILITY(U,$J,350.2,1,0)

 +6       ;;=RX1^2901001^1^2

 +7       ;;^UTILITY(U,$J,350.2,2,0)

 +8       ;;=RX2^2901001^2^2

 +9       ;;^UTILITY(U,$J,350.2,3,0)

 +10      ;;=RX3^2901001^3^2

 +11      ;;^UTILITY(U,$J,350.2,4,0)

 +12      ;;=RX4^2901001^4^2

 +13      ;;^UTILITY(U,$J,350.2,5,0)

 +14      ;;=RX5^2901001^5^2

 +15      ;;^UTILITY(U,$J,350.2,6,0)

 +16      ;;=RX6^2901001^6^2

 +17      ;;^UTILITY(U,$J,350.2,7,0)

 +18      ;;=MEDICARE 1^2920101^7^285

 +19      ;;^UTILITY(U,$J,350.2,7,10)

 +20      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +21      ;;^UTILITY(U,$J,350.2,8,0)

 +22      ;;=MEDICARE 2^2920101^8^382

 +23      ;;^UTILITY(U,$J,350.2,8,10)

 +24      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +25      ;;^UTILITY(U,$J,350.2,9,0)

 +26      ;;=MEDICARE 3^2920101^9^438

 +27      ;;^UTILITY(U,$J,350.2,9,10)

 +28      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +29      ;;^UTILITY(U,$J,350.2,10,0)

 +30      ;;=MEDICARE 4^2920101^10^539

 +31      ;;^UTILITY(U,$J,350.2,10,10)

 +32      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +33      ;;^UTILITY(U,$J,350.2,11,0)

 +34      ;;=MEDICARE 5^2920101^11^615

 +35      ;;^UTILITY(U,$J,350.2,11,10)

 +36      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +37      ;;^UTILITY(U,$J,350.2,12,0)

 +38      ;;=MEDICARE 6^2920101^12^580^^200

 +39      ;;^UTILITY(U,$J,350.2,12,10)

 +40      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +41      ;;^UTILITY(U,$J,350.2,13,0)

 +42      ;;=MEDICARE 7^2920101^13^853

 +43      ;;^UTILITY(U,$J,350.2,13,10)

 +44      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +45      ;;^UTILITY(U,$J,350.2,14,0)

 +46      ;;=MEDICARE 8^2920101^14^705^^200

 +47      ;;^UTILITY(U,$J,350.2,14,10)

 +48      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +49      ;;^UTILITY(U,$J,350.2,15,0)

 +50      ;;=MEDICARE 9^2920101^63^0

 +51      ;;^UTILITY(U,$J,350.2,15,10)

 +52      ;;=S IBNOD=^IBE(350.2,DA,0) D VAR^IBAUTL1 Q:Y<0  S Y=(($P(Y,"^",2)*$P(IBNOD,"^",4))+(+Y*$P(Y,"^",3)*$P(IBNOD,"^",4))+$P(IBNOD,"^",6))+.005\.01/100

 +53      ;;^UTILITY(U,$J,350.2,19,0)

 +54      ;;=INPT PER DIEM^2901001^45^10

 +55      ;;^UTILITY(U,$J,350.2,20,0)

 +56      ;;=NHCU PER DIEM^2901001^48^5

 +57      ;;^UTILITY(U,$J,350.2,24,0)

 +58      ;;=MEDICARE DEDUCTIBLE^2860701^54^492

 +59      ;;^UTILITY(U,$J,350.2,25,0)

 +60      ;;=MEDICARE DEDUCTIBLE^2870101^54^520

 +61      ;;^UTILITY(U,$J,350.2,26,0)

 +62      ;;=MEDICARE DEDUCTIBLE^2880101^54^540

 +63      ;;^UTILITY(U,$J,350.2,27,0)

 +64      ;;=MEDICARE DEDUCTIBLE^2890101^54^560

 +65      ;;^UTILITY(U,$J,350.2,28,0)

 +66      ;;=MEDICARE DEDUCTIBLE^2900101^54^592

 +67      ;;^UTILITY(U,$J,350.2,29,0)

 +68      ;;=MEDICARE DEDUCTIBLE^2910101^54^628

 +69      ;;^UTILITY(U,$J,350.2,30,0)

 +70      ;;=MEDICARE DEDUCTIBLE^2920101^54^652

 +71      ;;^UTILITY(U,$J,350.2,32,0)

 +72      ;;=MEDICARE DEDUCTIBLE^2930101^54^676

 +73      ;;^UTILITY(U,$J,350.2,33,0)

 +74      ;;=CHAMPVA SUBSISTENCE LIMIT^2911001^64^25

 +75      ;;^UTILITY(U,$J,350.2,34,0)

 +76      ;;=CHAMPVA PER DIEM^2911001^65^8.95

 +77      ;;^UTILITY(U,$J,350.2,35,0)

 +78      ;;=CHAMPVA PER DIEM^2921001^65^9.30

 +79      ;;^UTILITY(U,$J,350.2,36,0)

 +80      ;;=MEDICARE DEDUCTIBLE^2940101^54^696

IBINI01L.m