FBXIP20 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;4/5/2000
;;3.5;FEE BASIS;**20**;JAN 30, 1995
Q
;
PS ; post-install entry point
; create KIDS checkpoints with call backs
N FBX
F FBX="CF" D
. S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP20")
. I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
Q
;
CF ; add conversion factors for calendar year 2000 RBRVS fee schedule
; File 163.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 2000 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",2000,0))
. I DA'>0 D Q:DA'>0
. . S DIC="^FB(162.99,"_DA(1)_",""CY"",",DIC(0)="L",DIC("P")="162.991A"
. . S X=2000
. . 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:17.77,1:36.6137)
. D ^DIE
Q
;
;FBXIP20
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP20 1158 printed Dec 13, 2024@02:01:33 Page 2
FBXIP20 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;4/5/2000
+1 ;;3.5;FEE BASIS;**20**;JAN 30, 1995
+2 QUIT
+3 ;
PS ; post-install entry point
+1 ; create KIDS checkpoints with call backs
+2 NEW FBX
+3 FOR FBX="CF"
Begin DoDot:1
+4 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP20")
+5 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
End DoDot:1
+6 QUIT
+7 ;
CF ; add conversion factors for calendar year 2000 RBRVS fee schedule
+1 ; File 163.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 2000 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",2000,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"
+11 SET X=2000
+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:17.77,1:36.6137)
+18 DO ^DIE
End DoDot:1
+19 QUIT
+20 ;
+21 ;FBXIP20
