| 1 | FBXIP104 ;WCIOFO/TCK-PATCH INSTALL ROUTINE ;10/29/2007
|
|---|
| 2 | ;;3.5;FEE BASIS;**104**;JAN 30, 1995;Build 22
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | PRE ;Delete Adjustment Reason Code file before overwriting with updated file.
|
|---|
| 6 | N IEN,U
|
|---|
| 7 | S IEN=0,U="^"
|
|---|
| 8 | F S IEN=$O(^FB(161.91,IEN)) Q:'IEN D
|
|---|
| 9 | .S DIK="^FB(161.91,",DA=IEN D ^DIK K DA
|
|---|
| 10 | K DIK,DA
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | PS ; post-install entry point
|
|---|
| 14 | ; create KIDS checkpoints with call backs
|
|---|
| 15 | N FBX
|
|---|
| 16 | F FBX="CF" D
|
|---|
| 17 | . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP104")
|
|---|
| 18 | . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | CF ; Change the RVU values for procedure 14301 and 14302.
|
|---|
| 22 | D BMES^XPDUTL(" Changing FEE BASIS CPT RVU values for procedures 44180 and 44186.")
|
|---|
| 23 | N CPT,DD,DO,DA,DIE,DR,X,Y
|
|---|
| 24 | F CPT=44180,44186 D
|
|---|
| 25 | . S DA(1)=$O(^FB(162.97,"B",CPT,0))
|
|---|
| 26 | . Q:DA(1)'>0
|
|---|
| 27 | . S DA=$O(^FB(162.97,DA(1),"CY","B",2007,0))
|
|---|
| 28 | . Q:DA'>0
|
|---|
| 29 | . S DIE="^FB(162.97,"_DA(1)_",""CY"","
|
|---|
| 30 | . I CPT=44180 D
|
|---|
| 31 | . . S DR=".03////15.19;.04////6.09;.05////6.09;.06////1.86"
|
|---|
| 32 | . I CPT=44186 D
|
|---|
| 33 | . . S DR=".03////10.3;.04////4.7;.05////4.7;.06////1.27"
|
|---|
| 34 | . D ^DIE K DIE,DA(1),CPT
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;FBXIP104
|
|---|
