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 ---[H[J[2J[HFBXIP104 1083 printed Dec 13, 2024@02:01: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
