source: FOIAVistA/tag/r/FEE_BASIS-FB/FBXIP104.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.0 KB
Line 
1FBXIP104 ;WCIOFO/TCK-PATCH INSTALL ROUTINE ;10/29/2007
2 ;;3.5;FEE BASIS;**104**;JAN 30, 1995;Build 22
3 Q
4 ;
5PRE ;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 ;
13PS ; 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 ;
21CF ; 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
Note: See TracBrowser for help on using the repository browser.