FB35178P.m

FB35178P ;ALB/BJR-PATCH INSTALL ROUTINE ;12/19/2017 1:59pm

 ;;3.5;FEE BASIS;**178**;JAN 30, 1995;Build 2

 ;Per VA Directive 6402, this routine should not be modified.

 Q

 ;

EN ; Begin Post-Install

 ; Update 77065, 77066 and 77067 values for Radiology with 2017 Q4 values

 S U="^"

 D BMES^XPDUTL("Beginning Post install routine to update RVUs for 77065-77067 for CY2017.")

 N DD,DO,DA,DIE,DR,X,Y,FBX,FBXX,FBRVU,FBNONF,FBFAC,FBMAL,FBNONP

 F FBX=1:1 S FBXX=$P($T(UPDATE+FBX),";;",2) Q:FBXX="QUIT"  D

 .S DA=1,DA(1)=$P(FBXX,U,2),DIE="^FB(162.97,"_DA(1)_",""CY"","

 .S FBRVU=$P(FBXX,U,3),FBNONF=$P(FBXX,U,4),FBFAC=$P(FBXX,U,5),FBMAL=$P(FBXX,U,6),FBNONP=$P(FBXX,U,7)

 .S DR=".03///^S X=FBRVU;.04///^S X=FBNONF;.05///^S X=FBFAC;.06///^S X=FBMAL;.08///^S X=FBNONP"

 .D BMES^XPDUTL("Updating RVU "_$P(FBXX,U)) D ^DIE

 D BMES^XPDUTL("Post install routine to update RVUs for 77065-77067 for CY2017 complete.")

 Q

UPDATE ;Codes to update

 ;;77065^19907^0.81^2.89^2.89^0.06^0

 ;;77065-TC^19979^0^2.64^2.64^0.01^0

 ;;77065-26^19978^0.81^0.25^0.25^0.05^0

 ;;77066^19908^1^3.7^3.7^0.07^0

 ;;77066-TC^19981^0^3.38^3.38^0.01^0

 ;;77066-26^19980^1^0.32^0.32^0.06^0

 ;;77067^19909^0.76^3.04^3.04^0.05^0

 ;;77067-TC^19983^0^2.79^2.79^0.01^0

 ;;77067-26^19982^0.76^0.25^0.25^0.04^0

 ;;QUIT

 ;FB35178P

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FB35178P   1308     printed  Apr 23, 2025@18:09:17                                                                                                                                                                                                    Page 2

FB35178P  ;ALB/BJR-PATCH INSTALL ROUTINE ;12/19/2017 1:59pm

 +1       ;;3.5;FEE BASIS;**178**;JAN 30, 1995;Build 2

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3        QUIT 

 +4       ;

EN        ; Begin Post-Install

 +1       ; Update 77065, 77066 and 77067 values for Radiology with 2017 Q4 values

 +2        SET U="^"

 +3        DO BMES^XPDUTL("Beginning Post install routine to update RVUs for 77065-77067 for CY2017.")

 +4        NEW DD,DO,DA,DIE,DR,X,Y,FBX,FBXX,FBRVU,FBNONF,FBFAC,FBMAL,FBNONP

 +5        FOR FBX=1:1

               SET FBXX=$PIECE($TEXT(UPDATE+FBX),";;",2)

               if FBXX="QUIT"

                   QUIT 

               Begin DoDot:1

 +6                SET DA=1

                   SET DA(1)=$PIECE(FBXX,U,2)

                   SET DIE="^FB(162.97,"_DA(1)_",""CY"","

 +7                SET FBRVU=$PIECE(FBXX,U,3)

                   SET FBNONF=$PIECE(FBXX,U,4)

                   SET FBFAC=$PIECE(FBXX,U,5)

                   SET FBMAL=$PIECE(FBXX,U,6)

                   SET FBNONP=$PIECE(FBXX,U,7)

 +8                SET DR=".03///^S X=FBRVU;.04///^S X=FBNONF;.05///^S X=FBFAC;.06///^S X=FBMAL;.08///^S X=FBNONP"

 +9                DO BMES^XPDUTL("Updating RVU "_$PIECE(FBXX,U))

                   DO ^DIE

               End DoDot:1

 +10       DO BMES^XPDUTL("Post install routine to update RVUs for 77065-77067 for CY2017 complete.")

 +11       QUIT 

UPDATE    ;Codes to update

 +1       ;;77065^19907^0.81^2.89^2.89^0.06^0

 +2       ;;77065-TC^19979^0^2.64^2.64^0.01^0

 +3       ;;77065-26^19978^0.81^0.25^0.25^0.05^0

 +4       ;;77066^19908^1^3.7^3.7^0.07^0

 +5       ;;77066-TC^19981^0^3.38^3.38^0.01^0

 +6       ;;77066-26^19980^1^0.32^0.32^0.06^0

 +7       ;;77067^19909^0.76^3.04^3.04^0.05^0

 +8       ;;77067-TC^19983^0^2.79^2.79^0.01^0

 +9       ;;77067-26^19982^0.76^0.25^0.25^0.04^0

 +10      ;;QUIT

 +11      ;FB35178P