FBXIP118 ;ALB/BP-PATCH INSTALL ROUTINE ; 1/7/10 9:03pm
;;3.5;FEE BASIS;**118**;JAN 30, 1995;Build 14
Q
;
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
Q
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.")
Q
;
EN ; Begin Post-Install
D CF ;Add Conv factors
Q
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
Q
;FBXIP118
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP118 1912 printed Apr 09, 2024@21:01:21 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
