source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBXIP33B.m@ 1608

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

initial load of WorldVistAEHR
File size: 7.3 KB
RevLine 
[613]1FBXIP33B ;WCIOFO/MJE-IMPORT DOL CPT DATA ;9/18/2001
2 ;;3.5;FEE BASIS;**33**;JAN 30, 1995
3 Q
4 ;
5 ; load data into 162.97
6MRGDOL ; MERGE HFCA RVU DATA
7 N CPT,DOL,FBI,HCDATA,TBLN,X
8 D BMES^XPDUTL("--Updating file 162.97")
9 F FBI=1:1 S HCDATA=$P($T(DATA1+FBI),";;",2) Q:HCDATA="END" D
10 .S CPT=$P(HCDATA,U)
11 .S Y=$O(^FB(162.97,"B",CPT,0))
12 .I 'Y D Q:Y'>0
13 ..K DA,DIC
14 ..S DIC="^FB(162.97,",DLAYGO=162.97,DIC(0)="L",X=CPT
15 ..K DD,DO D FILE^DICN I Y'>0 D BMES^XPDUTL("ERROR ADDING NEW CPT "_CPT)
16 ..K DIC,DLAYGO
17 .;
18 .K DA,DIC
19 .S DA(1)=+Y
20 .S Y=$O(^FB(162.97,DA(1),"CY","B",2001,0))
21 .I 'Y D Q:Y'>0
22 ..S DIC="^FB(162.97,"_DA(1)_",""CY"",",DIC(0)="L",DIC("P")="162.971A"
23 ..S X=2001
24 ..K DD,DO D FILE^DICN I Y'>0 D BMES^XPDUTL("ERROR ADDING 2001 RVU'S for "_CPT)
25 ..K DIC,DLAYGO
26 .S DA=+Y
27 .S DIE="^FB(162.97,"_DA(1)_",""CY"","
28 .S DR=""
29 .S:$P(HCDATA,U,2)'="" DR=DR_".03///"_$P(HCDATA,U,2)
30 .S:$P(HCDATA,U,3)'="" DR=DR_";"_".04///"_$P(HCDATA,U,3)
31 .S:$P(HCDATA,U,4)'="" DR=DR_";"_".05///"_$P(HCDATA,U,4)
32 .S:$P(HCDATA,U,5)'="" DR=DR_";"_".06///"_$P(HCDATA,U,5)
33 .I $E(DR)=";" S DR=$E(DR,2,999)
34 .D ^DIE K DIE,DA,DR
35 ;
36 ;MERGE DOL DATA INTO FILED HFCA DATA
37 ;
38 F FBI=1:1 S DOL=$P($T(DATA+FBI),";;",2) Q:DOL="END" D
39 .S TBLN="2001"_"-"_$P(DOL,U,2)
40 .Q:$P(DOL,U,2)='""&('$D(^FB(162.98,"B",TBLN)))
41 .S CPT=$P(DOL,U,3)
42 .I '$O(^FB(162.97,"B",CPT,0)) D BMES^XPDUTL("CPT NOT IN FILE SKIPPING CPT "_CPT) Q
43 .S DA(1)=+($O(^FB(162.97,"B",CPT,0)))
44 .I '$O(^FB(162.97,DA(1),"CY","B",2001,0)) D BMES^XPDUTL("CY NOT IN FILE SKIPPING CPT "_CPT) Q
45 .S DA=+($O(^FB(162.97,DA(1),"CY","B",2001,0)))
46 .S DIE="^FB(162.97,"_DA(1)_",""CY"","
47 .S:$P(DOL,U,2)'="" DR=".02///"_$P(DOL,U,2)
48 .S:$P(DOL,U,2)="" DR=".02///@"
49 .D ^DIE K DIE,DA,DR
50 ;
51 ;
52 ;
53 D BMES^XPDUTL("---Update of file 162.97 complete")
54 Q
55 ;
56DATA ;This is the DOL MOD LVL data tablenumber^mod^%
57 ;;60^61^78320
58 ;;60^61^78803
59 ;;60^61^78320-26
60 ;;60^61^78320-TC
61 ;;60^61^78803-26
62 ;;60^61^78803-TC
63 ;;14^^G0002
64 ;;13^^G0004
65 ;;12^^G0005
66 ;;12^^G0006
67 ;;10^^G0007
68 ;;10^^G0015
69 ;;13^^G0016
70 ;;71^^G0025
71 ;;50^^G0030-26
72 ;;50^^G0031-26
73 ;;50^^G0032-26
74 ;;50^^G0033-26
75 ;;50^^G0034-26
76 ;;50^^G0035-26
77 ;;50^^G0036-26
78 ;;50^^G0037-26
79 ;;50^^G0038-26
80 ;;50^^G0039-26
81 ;;50^^G0040-26
82 ;;50^^G0041-26
83 ;;50^^G0042-26
84 ;;50^^G0043-26
85 ;;50^^G0044-26
86 ;;50^^G0045-26
87 ;;50^^G0046-26
88 ;;50^^G0047-26
89 ;;52^^G0050
90 ;;14^^G0101
91 ;;31^^G0104
92 ;;31^^G0105
93 ;;20^^G0106
94 ;;30^^G0106-26
95 ;;30^^G0106-TC
96 ;;14^^G0108
97 ;;14^^G0109
98 ;;14^^G0110
99 ;;14^^G0111
100 ;;14^^G0112
101 ;;14^^G0113
102 ;;14^^G0114
103 ;;14^^G0115
104 ;;14^^G0116
105 ;;20^^G0120
106 ;;20^^G0120-26
107 ;;20^^G0120-TC
108 ;;71^^G0124
109 ;;52^^G0125
110 ;;52^^G0125-26
111 ;;52^^G0125-TC
112 ;;52^^G0126
113 ;;52^^G0126-26
114 ;;52^^G0126-TC
115 ;;31^^G0127
116 ;;13^^G0128
117 ;;52^^G0130
118 ;;52^^G0130-26
119 ;;52^^G0130-TC
120 ;;52^^G0131
121 ;;52^^G0131-26
122 ;;52^^G0131-TC
123 ;;52^^G0132
124 ;;52^^G0132-26
125 ;;52^^G0132-TC
126 ;;71^^G0141
127 ;;13^^M0064
128 ;;71^^P3001
129 ;;15^^Q0035
130 ;;15^^Q0035-26
131 ;;15^^Q0035-TC
132 ;;20^^Q0091
133 ;;50^^Q0092
134 ;;14^^G0102
135 ;;55^^G0163
136 ;;55^^G0163-26
137 ;;55^^G0163-TC
138 ;;55^^G0164
139 ;;55^^G0164-26
140 ;;55^^G0164-TC
141 ;;55^^G0165
142 ;;55^^G0165-26
143 ;;55^^G0165-TC
144 ;;13^^G0166
145 ;;31^^G0168
146 ;;^12^94760
147 ;;^12^94761
148 ;;^31^15342
149 ;;^21^15343
150 ;;^31^16036
151 ;;^33^19102
152 ;;^33^19103
153 ;;^50^19295
154 ;;^21^20979
155 ;;^38^21199
156 ;;^10^22520
157 ;;^10^22521
158 ;;^10^22522
159 ;;^30^30465
160 ;;^30^33141
161 ;;^30^34800
162 ;;^35^34802
163 ;;^30^34804
164 ;;^35^34808
165 ;;^35^34812
166 ;;^35^34813
167 ;;^35^34820
168 ;;^35^34825
169 ;;^35^34826
170 ;;^35^34830
171 ;;^35^34831
172 ;;^35^34832
173 ;;^30^35600
174 ;;^31^36870
175 ;;^46^43231
176 ;;^46^43232
177 ;;^46^43240
178 ;;^46^43242
179 ;;^46^43256
180 ;;^46^44370
181 ;;^46^44379
182 ;;^46^44383
183 ;;^46^44397
184 ;;^46^45327
185 ;;^46^45341
186 ;;^46^45342
187 ;;^46^45345
188 ;;^46^45387
189 ;;^30^50545
190 ;;^30^50947
191 ;;^30^50948
192 ;;^31^52341
193 ;;^31^52342
194 ;;^31^52343
195 ;;^31^52344
196 ;;^31^52345
197 ;;^31^52346
198 ;;^31^52351
199 ;;^31^52352
200 ;;^31^52353
201 ;;^31^52354
202 ;;^31^52355
203 ;;^31^52400
204 ;;^36^54512
205 ;;^36^54522
206 ;;^38^55873
207 ;;^30^57022
208 ;;^30^57023
209 ;;^38^57287
210 ;;^32^58353
211 ;;^38^61697
212 ;;^38^61698
213 ;;^38^62252
214 ;;^33^64614
215 ;;^34^66982
216 ;;^33^67221
217 ;;^38^69714
218 ;;^38^69715
219 ;;^38^69717
220 ;;^38^69718
221 ;;^50^70496
222 ;;^50^70498
223 ;;^50^70542
224 ;;^50^70543
225 ;;^50^70544
226 ;;^50^70545
227 ;;^50^70546
228 ;;^50^70547
229 ;;^50^70548
230 ;;^50^70549
231 ;;^50^71275
232 ;;^50^71551
233 ;;^50^71552
234 ;;^50^72191
235 ;;^50^72195
236 ;;^50^72197
237 ;;^50^73206
238 ;;^50^73218
239 ;;^50^73219
240 ;;^50^73222
241 ;;^50^73223
242 ;;^50^73706
243 ;;^50^73718
244 ;;^50^73719
245 ;;^50^73722
246 ;;^50^73723
247 ;;^50^74175
248 ;;^50^74182
249 ;;^50^74183
250 ;;^50^75635
251 ;;^50^75952
252 ;;^50^75953
253 ;;^50^76012
254 ;;^50^76013
255 ;;^50^76393
256 ;;^50^76819
257 ;;^15^92586
258 ;;^15^93660
259 ;;^15^93662
260 ;;^05^97532
261 ;;^05^97533
262 ;;^05^97601
263 ;;^38^62252-26
264 ;;^38^62252-TC
265 ;;^50^70496-26
266 ;;^50^70496-TC
267 ;;^50^70498-26
268 ;;^50^70498-TC
269 ;;^50^70542-26
270 ;;^50^70542-TC
271 ;;^50^70543-26
272 ;;^50^70543-TC
273 ;;^50^70544-26
274 ;;^50^70544-TC
275 ;;^50^70545-26
276 ;;^50^70545-TC
277 ;;^50^70546-26
278 ;;^50^70546-TC
279 ;;^50^70547-26
280 ;;^50^70547-TC
281 ;;^50^70548-26
282 ;;^50^70548-TC
283 ;;^50^70549-26
284 ;;^50^70549-TC
285 ;;^50^71275-26
286 ;;^50^71275-TC
287 ;;^50^71551-26
288 ;;^50^71551-TC
289 ;;^50^71552-26
290 ;;^50^71552-TC
291 ;;^50^72191-26
292 ;;^50^72191-TC
293 ;;^50^72195-26
294 ;;^50^72195-TC
295 ;;^50^72197-26
296 ;;^50^72197-TC
297 ;;^50^73206-26
298 ;;^50^73206-TC
299 ;;^50^73218-26
300 ;;^50^73218-TC
301 ;;^50^73219-26
302 ;;^50^73219-TC
303 ;;^50^73222-26
304 ;;^50^73222-TC
305 ;;^50^73223-26
306 ;;^50^73223-TC
307 ;;^50^73706-26
308 ;;^50^73706-TC
309 ;;^50^73718-26
310 ;;^50^73718-TC
311 ;;^50^73719-26
312 ;;^50^73719-TC
313 ;;^50^73722-26
314 ;;^50^73722-TC
315 ;;^50^73723-26
316 ;;^50^73723-TC
317 ;;^50^74175-26
318 ;;^50^74175-TC
319 ;;^50^74182-26
320 ;;^50^74182-TC
321 ;;^50^74183-26
322 ;;^50^74183-TC
323 ;;^50^75635-26
324 ;;^50^75635-TC
325 ;;^50^76393-26
326 ;;^50^76393-TC
327 ;;^50^76819-26
328 ;;^50^76819-TC
329 ;;^15^93660-TC
330 ;;^15^93662-26
331 ;;^15^93662-TC
332 ;;END
333 ;
334DATA1 ;This is the HCFA data CPT^work rvu^non-fac rvu^fac rvu^mp rvu
335 ;;59150^11.2^5.79^5.79^
336 ;;59151^11.1^6.53^6.53^
337 ;;70540^1.1^11.72^11.72^
338 ;;70542^1.33^13.81^13.81^
339 ;;70543^1.76^25.34^25.34^
340 ;;71550^1.22^11.77^11.77^
341 ;;71551^1.44^13.85^13.85^
342 ;;71552^1.89^25.38^25.38^
343 ;;72195^1.22^11.56^11.56^
344 ;;72196^1.44^13.48^13.48^
345 ;;72197^1.89^25.38^25.38^
346 ;;73218^1.1^11.52^11.52^
347 ;;73219^1.33^13.82^13.82^
348 ;;73220^1.76^22.08^22.08^
349 ;;73221^1.1^11.66^11.66^
350 ;;73222^1.33^13.81^13.81^
351 ;;73223^1.76^25.34^25.34^
352 ;;73718^1.1^11.52^11.52^
353 ;;73719^1.33^13.81^13.81^
354 ;;73720^1.76^22.08^22.08^
355 ;;73721^1.1^11.66^11.66^
356 ;;73722^1.33^13.82^13.82^
357 ;;73723^1.76^25.34^25.34^
358 ;;74181^1.22^11.77^11.77^
359 ;;74182^1.44^13.85^13.85^
360 ;;74183^1.89^25.38^25.38^
361 ;;76012^^^^.23
362 ;;99234^2.56^.88^.88^
363 ;;99235^3.42^1.19^1.19^
364 ;;99236^4.27^1.41^1.41^
365 ;;70540-26^1.1^.47^.47^
366 ;;70542-26^1.33^.47^.47^
367 ;;70543-26^1.76^.63^.63^
368 ;;71550-26^1.22^.52^.52^
369 ;;71551-26^1.44^.51^.51^
370 ;;71552-26^1.89^.67^.67^
371 ;;72195-26^1.22^.43^.43^
372 ;;72196-26^1.44^.58^.58^
373 ;;72197-26^1.89^.67^.67^
374 ;;73218-26^1.1^.39^.39^
375 ;;73219-26^1.33^.48^.48^
376 ;;73220-26^1.76^.65^.65^
377 ;;73221-26^1.1^.41^.41^
378 ;;73222-26^1.33^.47^.47^
379 ;;73223-26^1.76^.63^.63^
380 ;;73718-26^1.1^.39^.39^
381 ;;73719-26^1.33^.47^.47^
382 ;;73720-26^1.76^.65^.65^
383 ;;73721-26^1.1^.41^.41^
384 ;;73722-26^1.33^.48^.48^
385 ;;73723-26^1.76^.63^.63^
386 ;;74181-26^1.22^.52^.52^
387 ;;74182-26^1.44^.51^.51^
388 ;;74183-26^1.89^.67^.67^
389 ;;G0195^1.50^1.64^0.86^0.07
390 ;;G0196^1.50^1.64^0.86^0.07
391 ;;G0206^0.58^1.25^1.25^0.08
392 ;;G0206-26^0.58^0.19^0.19^0.03
393 ;;G0206-TC^0.00^1.06^1.06^0.05
394 ;;G0207^0.58^1.25^1.25^0.08
395 ;;G0207-26^0.58^0.19^0.19^0.03
396 ;;G0207-TC^0.00^1.06^1.06^0.05
397 ;;END
398 ;
399 ;FBXIP33B
Note: See TracBrowser for help on using the repository browser.