source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBAAFSR.m@ 1392

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1FBAAFSR ;WCIOFO/TCK,SS,DMK,SAB-RBRVS FEE SCHEDULE ; 8/26/1999
2 ;;3.5;FEE BASIS;**4,53,71,84,92,93,99,102,105**;JAN 30, 1995;Build 1
3 ;
4 Q
5 ;
6RBRVS(CPT,MODL,DOS,ZIP,FAC,TIME) ; calculate RBRVS Fee Schedule amount
7 ; Input
8 ; CPT = CPT/HCPCS code (external value)
9 ; MODL = list of CPT/HCPCS modifiers (external values)
10 ; delimited by commas (e.g. "26,51")
11 ; DOS = date of service (fileman format e.g. 2980101)
12 ; ZIP = ZIP code of service (external 5 digit value)
13 ; FAC = facility flag =1 if site of service is facility setting
14 ; TIME = time in minutes, only passed on anesthesia CPT codes
15 ; Returns string
16 ; dollar amount^sched year OR null value if not on RBRVS schedule
17 ; Output
18 ; FBERR( array of error messages OR undefined if none
19 ;
20 N FBAMT,FBCF,FBCPT0,FBCPTY0,FBCY,FBERR,FBGPCIY0
21 ;
22 ; initialization
23 S FBAMT=""
24 K FBERR
25 ;
26 ; check for required input parameters
27 I $G(CPT)="" D ERR^FBAAFS("CPT missing")
28 I $G(DOS)'?7N D ERR^FBAAFS("Date of Service missing")
29 I $D(FBERR) Q FBAMT
30 ;
31 ;if date of service prior to VA implementation, don't use RBRVS
32 I DOS<2990901 Q FBAMT
33 ;
34 ;if modifier SG present, don't use RBRVS, patch FB*3.5*84
35 I MODL["SG" Q FBAMT
36 ;
37 ; determine schedule calendar year based on date of service
38 S FBCY=$E(DOS,1,3)+1700
39 ;
40 ;If date of service in 2003 but prior to Mar 1, 2003 treat as 2002
41 I $E(DOS,1,3)=303,DOS<3030301 S FBCY=FBCY-1
42 ;
43 ; if year after most recent RBRVS schedule then use prior year schedule
44 I FBCY>$$LASTCY() S FBCY=FBCY-1
45 ;
46 ; get procedure data from schedule for year
47 D PROC(CPT,MODL,FBCY)
48 ;
49 ; if procedure:
50 ; - covered
51 ; - payable
52 ; - not for anesthesia
53 ; then calculate amount
54 I FBCPTY0]"",'$$ANES^FBAAFS(CPT) D
55 . ;
56 . ;validate parameters
57 . I $G(ZIP)="" D ERR^FBAAFS("Missing ZIP Code")
58 . I $G(FAC)="" D ERR^FBAAFS("Missing Facility Flag")
59 . I $D(FBERR) Q
60 . ;
61 . ; get GPCIs for calendar year
62 . D ZIP(FBCY,ZIP)
63 . I FBGPCIY0="" D ERR^FBAAFS("Could not determine GPCIs") Q
64 . ;
65 . ; get conversion factor
66 . S FBCF=$$CF(FBCY,$P(FBCPT0,U,2))
67 . I FBCF="" D ERR^FBAAFS("Could not determine the conversion factor") Q
68 . ;
69 . ; calculate full schedule amount
70 . D CALC(FBCY,FAC,FBCPTY0,FBGPCIY0,FBCF)
71 . ;
72 . ; apply multiplier based on modifier
73 . I MODL]"" S FBAMT=FBAMT*$$MULT(FBCY,MODL,FBCPT0,FBCPTY0)
74 ;
75 ; return result
76 Q $S(FBAMT>0:$J(FBAMT,0,2)_U_FBCY,1:"")
77 ;
78PROC(CPT,MODL,FBCY,FBNONPBL) ; get procedure data for RBRVS schedule
79 ; Input
80 ; CPT = CPT/HCPCS code (external value)
81 ; MODL = list of CPT/HCPCS modifiers (external value)
82 ; delimited by commas
83 ; FBCY = calendar year (4 digit)
84 ; FBNONPBL ( optional):
85 ; if $G(FBNONPBL)=0 then will make search among payable records only in #162.97
86 ; ignoring those non-payable ones with field #.08 NONPAYABLE = 1
87 ; if $G(FBNONPBL)=1 then will make search among all items in #162.97
88 ;
89 ; Output
90 ; FBCPT0 = zero node from file 162.97 OR "" if not covered
91 ; FBCPTY0 = zero node from subfile 162.971 or "" if not covered
92 N CPTM,MOD,FBI
93 S (FBCPT0,FBCPTY0)=""
94 Q:$G(FBCY)']""!($G(CPT)']"")
95 ;
96 ; if modifier exists try to find entry with modifier
97 I MODL]"" D
98 . F FBI=1:1 S MOD=$P(MODL,",",FBI) Q:MOD="" D Q:FBCPTY0]""
99 . . S CPTM=CPT_"-"_MOD
100 . . D PROC1(CPTM,FBCY,$G(FBNONPBL))
101 ;
102 ; if not found with modifier, try just CPT code
103 I FBCPTY0="" D PROC1(CPT,FBCY,$G(FBNONPBL))
104 ;
105 Q
106 ;
107PROC1(CPTM,FBCY,FBNONPBL) ; get procedure data for CPT-Modifier
108 ; input
109 ; CPTM - CPT Code - Modifier (e.g. 57335-TC or 57335)
110 ; FBCY - 4 digit calendar year
111 ; FBNONPBL ( optional):
112 ; if $G(FBNONPBL)=0 then will make search among payable records only in #162.97
113 ; ignoring those non-payable ones with field #.08 NONPAYABLE = 1
114 ; if $G(FBNONPBL)=1 then will make search among all items in #162.97
115 ; output
116 ; FBCPT0 = zero node from file 162.97 OR "" if not covered
117 ; FBCPTY0 = zero node from subfile 162.971 or "" if not covered
118 N FBDA,FBDA1
119 S (FBCPT0,FBCPTY0)=""
120 S FBDA=$O(^FB(162.97,"B",CPTM,0))
121 S FBDA1=$S(FBDA:$O(^FB(162.97,FBDA,"CY","B",FBCY,0)),1:"")
122 I $G(FBDA),$G(FBDA1) D
123 . N FBI,FBSUM,FBY
124 . S FBY=$G(^FB(162.97,FBDA,"CY",FBDA1,0))
125 . ;if non-payable records should not be considered
126 . ;then quit if this is NONPAYBLE
127 . I +$G(FBNONPBL)=0 Q:$P(FBY,U,8)=1
128 . ; check if procedure covered by schedule
129 . I +$G(FBNONPBL)=0,$$ANES^FBAAFS($P(CPTM,"-")),$P(FBY,U,6)']"" Q ; missing anes base
130 . I +$G(FBNONPBL)=0,'$$ANES^FBAAFS($P(CPTM,"-")) D I FBSUM'>0 Q ; sum of RVUs = 0
131 . . S FBSUM=0 F FBI=3,4,5,6 S FBSUM=FBSUM+$P(FBY,U,FBI)
132 . ; passed checks
133 . S FBCPTY0=FBY
134 . S FBCPT0=$G(^FB(162.97,FBDA,0))
135 Q
136 ;
137ZIP(FBCY,ZIP) ; get GPCIs
138 ; Input
139 ; FBCY = calendar year (4 digit)
140 ; ZIP = zip code (5 digit external value)
141 ; Output
142 ; FBGPCIY0 = zero node from file 162.96 or "" if not found
143 S FBGPCIY0=""
144 Q:$G(FBCY)']""!($G(ZIP)']"")
145 N FBDA,FBDA1
146 S FBDA=$O(^FB(162.96,"B",ZIP,0))
147 S FBDA1=$S(FBDA:$O(^FB(162.96,FBDA,"CY","B",FBCY,0)),1:"")
148 I FBDA,FBDA1 S FBGPCIY0=$G(^FB(162.96,FBDA,"CY",FBDA1,0))
149 Q
150 ;
151CF(FBCY,FBDA) ; get conversion factor
152 ; Input
153 ; FBCY = calendar year
154 ; FBDA = optional conversion category (internal)
155 ; Returns
156 ; conversion factor from file 162.99
157 N FBCF,FBDA1
158 I '$G(FBDA) S FBDA=4 ; use Medicine category if not specified
159 S FBDA1=$O(^FB(162.99,FBDA,"CY","B",FBCY,0))
160 S FBCF=$S(FBDA1:$P($G(^FB(162.99,FBDA,"CY",FBDA1,0)),U,2),1:"")
161 Q +FBCF
162 ;
163CALC(FBCY,FAC,FBCPTY0,FBGPCIY0,FBCF) ;
164 ; Input
165 ; FBCY = calendar year (4 digit)
166 ; FAC = facility flag (0 or 1)
167 ; FBCPTY0 = zero node from file 162.71
168 ; FBGPCI0 = zero node from file 162.61
169 ; FBCF = conversion factor (number)
170 ; Returns $ amount
171 ;
172 N GPCI,RVU,FBI,TMP,TMPRVU
173 S FBAMT=0
174 ;Old formula for RBRVS pre-2007 payment amounts
175 I DOS<3070101 D
176 .S RVU(1)=$P(FBCPTY0,U,3)
177 I (DOS=3070101!(DOS>3070101)&(DOS<3080101)) D
178 .;New formula for RBRVS 2007 payment amounts
179 .;Multiply Work RVU by the Budget Neutrality Adjustor (0.8994)
180 .S TMP=$P(FBCPTY0,U,3),TMPRVU=$J((TMP*(.8994)),".",2)
181 .S RVU(1)=TMPRVU
182 I DOS=3080101!(DOS>3080101) D
183 .;New formula for the RBRVS 2008 payment amounts
184 .;Multiply Work RVU by the Budget Neutrality Adjustor (0.8994)
185 .S TMP=$P(FBCPTY0,U,3),TMPRVU=$J((TMP*(.8806)),".",2)
186 .S RVU(1)=TMPRVU
187 S RVU(2)=$P(FBCPTY0,U,4+FAC)
188 S RVU(3)=$P(FBCPTY0,U,6)
189 F FBI=2,3,4 S GPCI(FBI-1)=$P(FBGPCIY0,U,FBI)
190 S FBAMT=((RVU(1)*GPCI(1))+(RVU(2)*GPCI(2))+(RVU(3)*GPCI(3)))*FBCF
191 ; some procedures can't be performed in a facility setting by
192 ; definition. the facility PE RVU for such a procedure is a null
193 ; value.
194 ; when facility setting - check for a null PE value and don't return amt
195 I RVU(2)="",FAC S FBAMT=0 Q
196 Q
197 ;
198MULT(FBCY,MODL,FBCPT0,FBCPTY0) ;returns multiplier based on table type
199 ; Input
200 ; FBCY = calendar year (4 digit)
201 ; MODL = list of CPT/HCPCS modifiers (external values)
202 ; delimited by commas
203 ; FBCPT0 = zero node of file 162.7 for procedure
204 ; FBCPTY0 = zero node of subfile 162.71 for year
205 ; Returns
206 ; multiplier value OR 1 if none
207 N FBDA,FBDA1,FBI,FBML,FBPD,FBRET,FBTBL,MOD
208 S FBRET=1
209 S FBML=$P(FBCPTY0,U,2) ; mod level table for procedure
210 I MODL]"",FBML]"",FBCY]"" D
211 . S FBTBL=FBCY_"-"_FBML ; mod level table for year
212 . S FBDA=$O(^FB(162.98,"B",FBTBL,0))
213 . Q:'FBDA ; table not found
214 . ; loop thru the modifiers
215 . F FBI=1:1 S MOD=$P(MODL,",",FBI) Q:MOD="" D
216 . . I $P($P(FBCPT0,U),"-",2)=MOD Q ; modifier already built in schedule
217 . . ; look up modifier in mod level table
218 . . S FBDA1=$O(^FB(162.98,FBDA,"M","B",MOD,0))
219 . . Q:'FBDA1 ; modifier not found in table
220 . . S FBPD=$P($G(^FB(162.98,FBDA,"M",FBDA1,0)),U,2) ; percentage
221 . . I FBPD>0 S FBRET=FBRET*(FBPD/100) ; multiplier
222 Q FBRET
223 ;
224LASTCY() ; Determine last calendar year of RBRVS FEE schedule data
225 ; based on last year for Medicine conversion factor
226 N YEAR
227 S YEAR=$O(^FB(162.99,4,"CY","B"," "),-1)
228 Q YEAR
229 ;FBAAFSR
Note: See TracBrowser for help on using the repository browser.