Routine: FBXIP118

FBXIP118 ;ALB/BP-PATCH INSTALL ROUTINE ; 1/7/10 9:03pm

 ;;3.5;FEE BASIS;**118**;JAN 30, 1995;Build 14

PRE ;PRE-INSTALL ENTRY POINT

 N DIK,DA,FBMLNM,FBMLIEN

 S FBMLNM=""

 F  S FBMLNM=$O(^FB(162.98,"B",FBMLNM)) Q:'FBMLNM  D

 . I FBMLNM["2010-" D

 .. S FBMLIEN=0

 .. S FBMLIEN=$O(^FB(162.98,"B",FBMLNM,FBMLIEN))

 .. S DIK="^FB(162.98,",DA=FBMLIEN

 .. D ^DIK

POST ; post-install entry point

 ; create KIDS checkpoints with call backs

 N FBX

 F FBX="EN" D

 . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP118")

 . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")

EN ; Begin Post-Install

 D CF ;Add Conv factors

CF ; add conversion factors for calendar year 2010 RBRVS fee schedule

 ; File 162.99 is being updated in the post install because the Fee

 ; Basis software examines this file to determine the latest available

 ; fee schedule. By doing this at the end of the patch installation,

 ; users can continue to use the payment options during the install.

 D BMES^XPDUTL("  Filing conversion factor for RBRVS 2010 AND 2011 fee schedule.")

 N DD,DO,DA,DIE,DR,X,Y

 S DA(1)=0 F  S DA(1)=$O(^FB(162.99,DA(1))) Q:'DA(1)  D

 . S DA=$O(^FB(162.99,DA(1),"CY","B",2010,0))

 . I DA'>0 D  Q:DA'>0

 . . S DIC="^FB(162.99,"_DA(1)_",""CY"",",DIC(0)="L",DIC("P")="162.991A",DLAYGO=162.991

 . . S X=2010

 . . K DD,DO D FILE^DICN

 . . K DIC,DLAYGO

 . . S DA=+Y

. ;

 . S DIE="^FB(162.99,"_DA(1)_",""CY"","

 . S DR=".02///"_$S(DA(1)=1:21.114,1:36.8729)

 . D ^DIE

 S DA(1)=0 F  S DA(1)=$O(^FB(162.99,DA(1))) Q:'DA(1)  D

 . S DA=$O(^FB(162.99,DA(1),"CY","B",2011,0))

 . I DA'>0 D  Q:DA'>0

 . . S DIC="^FB(162.99,"_DA(1)_",""CY"",",DIC(0)="L",DIC("P")="162.991A",DLAYGO=162.991

 . . S X=2011

 . . K DD,DO D FILE^DICN

 . . K DIC,DLAYGO

 . . S DA=+Y

. ;

 . S DIE="^FB(162.99,"_DA(1)_",""CY"","

 . S DR=".02///"_$S(DA(1)=1:15.8085,1:33.9764)

 . D ^DIE

 ;FBXIP118

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP118   1912     printed  Apr 23, 2025@18:15:40                                                                                                                                                                                                    Page 2

FBXIP118  ;ALB/BP-PATCH INSTALL ROUTINE ; 1/7/10 9:03pm

 +1       ;;3.5;FEE BASIS;**118**;JAN 30, 1995;Build 14

 +2        QUIT

 +3       ;

PRE       ;PRE-INSTALL ENTRY POINT

 +1        NEW DIK,DA,FBMLNM,FBMLIEN

 +2        SET FBMLNM=""

 +3        FOR

               SET FBMLNM=$ORDER(^FB(162.98,"B",FBMLNM))

               if 'FBMLNM

                   QUIT

               Begin DoDot:1

 +4                IF FBMLNM["2010-"

                       Begin DoDot:2

 +5                        SET FBMLIEN=0

 +6                        SET FBMLIEN=$ORDER(^FB(162.98,"B",FBMLNM,FBMLIEN))

 +7                        SET DIK="^FB(162.98,"

                           SET DA=FBMLIEN

 +8                        DO ^DIK

                       End DoDot:2

               End DoDot:1

 +9        QUIT

POST      ; post-install entry point

 +1       ; create KIDS checkpoints with call backs

 +2        NEW FBX

 +3        FOR FBX="EN"

               Begin DoDot:1

 +4                SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP118")

 +5                IF 'Y

                       DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")

               End DoDot:1

 +6        QUIT

 +7       ;

EN        ; Begin Post-Install

 +1       ;Add Conv factors

           DO CF

 +2        QUIT

CF        ; add conversion factors for calendar year 2010 RBRVS fee schedule

 +1       ; File 162.99 is being updated in the post install because the Fee

 +2       ; Basis software examines this file to determine the latest available

 +3       ; fee schedule. By doing this at the end of the patch installation,

 +4       ; users can continue to use the payment options during the install.

 +5        DO BMES^XPDUTL("  Filing conversion factor for RBRVS 2010 AND 2011 fee schedule.")

 +6        NEW DD,DO,DA,DIE,DR,X,Y

 +7        SET DA(1)=0

FOR

               SET DA(1)=$ORDER(^FB(162.99,DA(1)))

               if 'DA(1)

                   QUIT

               Begin DoDot:1

 +8                SET DA=$ORDER(^FB(162.99,DA(1),"CY","B",2010,0))

 +9                IF DA'>0

                       Begin DoDot:2

 +10                       SET DIC="^FB(162.99,"_DA(1)_",""CY"","

                           SET DIC(0)="L"

                           SET DIC("P")="162.991A"

                           SET DLAYGO=162.991

 +11                       SET X=2010

 +12                       KILL DD,DO

                           DO FILE^DICN

 +13                       KILL DIC,DLAYGO

 +14                       SET DA=+Y

                       End DoDot:2

                       if DA'>0

                           QUIT

 +15      ;

 +16               SET DIE="^FB(162.99,"_DA(1)_",""CY"","

 +17               SET DR=".02///"_$SELECT(DA(1)=1:21.114,1:36.8729)

 +18               DO ^DIE

               End DoDot:1

 +19       SET DA(1)=0

FOR

               SET DA(1)=$ORDER(^FB(162.99,DA(1)))

               if 'DA(1)

                   QUIT

               Begin DoDot:1

 +20               SET DA=$ORDER(^FB(162.99,DA(1),"CY","B",2011,0))

 +21               IF DA'>0

                       Begin DoDot:2

 +22                       SET DIC="^FB(162.99,"_DA(1)_",""CY"","

                           SET DIC(0)="L"

                           SET DIC("P")="162.991A"

                           SET DLAYGO=162.991

 +23                       SET X=2011

 +24                       KILL DD,DO

                           DO FILE^DICN

 +25                       KILL DIC,DLAYGO

 +26                       SET DA=+Y

                       End DoDot:2

                       if DA'>0

                           QUIT

 +27      ;

 +28               SET DIE="^FB(162.99,"_DA(1)_",""CY"","

 +29               SET DR=".02///"_$SELECT(DA(1)=1:15.8085,1:33.9764)

 +30               DO ^DIE

               End DoDot:1

 +31       QUIT

 +32      ;FBXIP118

FBXIP118.m