FBXIP104.m

FBXIP104 ;WCIOFO/TCK-PATCH INSTALL ROUTINE ;10/29/2007

 ;;3.5;FEE BASIS;**104**;JAN 30, 1995;Build 22

 Q

 ;

PRE ;Delete Adjustment Reason Code file before overwriting with updated file.

 N IEN,U

 S IEN=0,U="^"

 F  S IEN=$O(^FB(161.91,IEN)) Q:'IEN  D

 .S DIK="^FB(161.91,",DA=IEN D ^DIK K DA

 K DIK,DA

 Q

 ;

PS ; post-install entry point

 ; create KIDS checkpoints with call backs

 N FBX

 F FBX="CF" D

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

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

 Q

 ;

CF ; Change the RVU values for procedure 14301 and 14302.

 D BMES^XPDUTL("  Changing FEE BASIS CPT RVU values for procedures 44180 and 44186.")

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

 F CPT=44180,44186 D

 . S DA(1)=$O(^FB(162.97,"B",CPT,0))

 . Q:DA(1)'>0

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

 . Q:DA'>0

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

 . I CPT=44180 D

 . . S DR=".03////15.19;.04////6.09;.05////6.09;.06////1.86"

 . I CPT=44186 D

 . . S DR=".03////10.3;.04////4.7;.05////4.7;.06////1.27"

 . D ^DIE K DIE,DA(1),CPT

 Q

 ;

 ;FBXIP104

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBXIP104   1083     printed  Apr 09, 2024@21:07:02                                                                                                                                                                                                    Page 2

FBXIP104  ;WCIOFO/TCK-PATCH INSTALL ROUTINE ;10/29/2007

 +1       ;;3.5;FEE BASIS;**104**;JAN 30, 1995;Build 22

 +2        QUIT 

 +3       ;

PRE       ;Delete Adjustment Reason Code file before overwriting with updated file.

 +1        NEW IEN,U

 +2        SET IEN=0

           SET U="^"

 +3        FOR 

               SET IEN=$ORDER(^FB(161.91,IEN))

               if 'IEN

                   QUIT 

               Begin DoDot:1

 +4                SET DIK="^FB(161.91,"

                   SET DA=IEN

                   DO ^DIK

                   KILL DA

               End DoDot:1

 +5        KILL DIK,DA

 +6        QUIT 

 +7       ;

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_"^FBXIP104")

 +5                IF 'Y

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

               End DoDot:1

 +6        QUIT 

 +7       ;

CF        ; Change the RVU values for procedure 14301 and 14302.

 +1        DO BMES^XPDUTL("  Changing FEE BASIS CPT RVU values for procedures 44180 and 44186.")

 +2        NEW CPT,DD,DO,DA,DIE,DR,X,Y

 +3        FOR CPT=44180,44186

               Begin DoDot:1

 +4                SET DA(1)=$ORDER(^FB(162.97,"B",CPT,0))

 +5                if DA(1)'>0

                       QUIT 

 +6                SET DA=$ORDER(^FB(162.97,DA(1),"CY","B",2007,0))

 +7                if DA'>0

                       QUIT 

 +8                SET DIE="^FB(162.97,"_DA(1)_",""CY"","

 +9                IF CPT=44180

                       Begin DoDot:2

 +10                       SET DR=".03////15.19;.04////6.09;.05////6.09;.06////1.86"

                       End DoDot:2

 +11               IF CPT=44186

                       Begin DoDot:2

 +12                       SET DR=".03////10.3;.04////4.7;.05////4.7;.06////1.27"

                       End DoDot:2

 +13               DO ^DIE

                   KILL DIE,DA(1),CPT

               End DoDot:1

 +14       QUIT 

 +15      ;

 +16      ;FBXIP104