- 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 Jan 18, 2025@03:02:45 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