FBXIP181 ;MNT/BJR - PATCH INSTALL ROUTINE ;1/8/2019 10:54am
;;3.5;FEE BASIS;**181**;JAN 30, 1995;Build 3
;Per VA Directive 6402, this routine should not be modified.
Q
;
POST ; post-install entry point
; create KIDS checkpoints with call backs
; ICR #10141 supports BMES^XPDUTL and $$NEWCP^XPDUTL calls
N FBX
F FBX="EN" D
. S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP181")
. 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 2019 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 2019 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",2019,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=2019
. . 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:22.2730,1:36.0391)
. D ^DIE
Q
;FBXIP181
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP181 1370 printed Dec 13, 2024@02:01:28 Page 2
FBXIP181 ;MNT/BJR - PATCH INSTALL ROUTINE ;1/8/2019 10:54am
+1 ;;3.5;FEE BASIS;**181**;JAN 30, 1995;Build 3
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POST ; post-install entry point
+1 ; create KIDS checkpoints with call backs
+2 ; ICR #10141 supports BMES^XPDUTL and $$NEWCP^XPDUTL calls
+3 NEW FBX
+4 FOR FBX="EN"
Begin DoDot:1
+5 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP181")
+6 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
End DoDot:1
+7 QUIT
+8 ;
EN ; Begin Post-Install
+1 ;Add Conv factors
DO CF
+2 QUIT
CF ; add conversion factors for calendar year 2019 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 2019 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",2019,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=2019
+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:22.2730,1:36.0391)
+18 DO ^DIE
End DoDot:1
+19 QUIT
+20 ;FBXIP181
