source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1831S.m@ 1336

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1ICD1831S ;;ALB/EG/JAT - FY 2008 UPDATE; 6/19/05 4:08pm ; 11/14/07 5:22pm
2 ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
3 ;
4 Q
5 ;
6PRO ;-update operation/procedure codes
7 ; from Table 6B in Fed Reg - assumes new codes already added by Lexicon
8 D BMES^XPDUTL(">>>Modifying new op/pro codes - file 80.1")
9 N LINE,X,ICDPROC,ENTRY,DA,DIE,DR,IDENT,MDC24,SUBLINE,DATA,FDA
10 F LINE=1:1 S X=$T(REV+LINE) S ICDPROC=$P(X,";;",2) Q:ICDPROC="EXIT" D
11 .Q:ICDPROC["+"
12 .; check if already created in case patch being re-installed
13 .S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0))
14 .I $D(^ICD0(ENTRY,2,"B",3071001)) D
15 ..;kill existing entry for FY
16 .. S DA(1)=ENTRY,DA=$O(^ICD0(ENTRY,2,"B",3071001,0))
17 .. S DIK="^ICD0("_DA(1)_",2," D ^DIK K DIK,DA
18 .I ENTRY D
19 ..;check for possible inactive dupe
20 ..I $P($G(^ICD0(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",ENTRY)) I 'ENTRY Q
21 ..S DA=ENTRY,DIE="^ICD0("
22 ..S IDENT=$P(ICDPROC,U,2)
23 ..S MDC24=$P(ICDPROC,U,3)
24 ..S DR="2///^S X=IDENT;5///^S X=MDC24"
25 ..I IDENT=""&(MDC24="") Q
26 ..D ^DIE
27 ..;add 80.171, 80.1711 and 80.17111 records
28 ..F SUBLINE=1:1 S X=$T(REV+LINE+SUBLINE) S DATA=$P(X,";;",2) Q:DATA'["+" D
29 ...I SUBLINE=1 D
30 ....S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
31 ....S FDA(1820,80.171,"+2,?1,",.01)=3071001
32 ....D UPDATE^DIE("","FDA(1820)") K FDA(1820)
33 ...S DATA=$E(DATA,2,99)
34 ...S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
35 ...S FDA(1820,80.171,"?2,?1,",.01)=3071001
36 ...S FDA(1820,80.1711,"+3,?2,?1,",.01)=$P(DATA,U)
37 ...D UPDATE^DIE("","FDA(1820)") K FDA(1820)
38 ...S FDA(1820,80.1,"?1,",.01)="`"_ENTRY
39 ...S FDA(1820,80.171,"?2,?1,",.01)=3071001
40 ...S FDA(1820,80.1711,"?3,?2,?1,",.01)=$P(DATA,U)
41 ...S FDA(1820,80.17111,"+4,?3,?2,?1,",.01)=$P(DATA,U,2)
42 ...I $P(DATA,U,3) S FDA(1820,80.17111,"+5,?3,?2,?1,",.01)=$P(DATA,U,3)
43 ...I $P(DATA,U,4) S FDA(1820,80.17111,"+6,?3,?2,?1,",.01)=$P(DATA,U,4)
44 ...I $P(DATA,U,5) S FDA(1820,80.17111,"+7,?3,?2,?1,",.01)=$P(DATA,U,5)
45 ...I $P(DATA,U,6) S FDA(1820,80.17111,"+8,?3,?2,?1,",.01)=$P(DATA,U,6)
46 ...I $P(DATA,U,7) S FDA(1820,80.17111,"+9,?3,?2,?1,",.01)=$P(DATA,U,7)
47 ...I $P(DATA,U,8) S FDA(1820,80.17111,"+10,?3,?2,?1,",.01)=$P(DATA,U,8)
48 ...I $P(DATA,U,9) S FDA(1820,80.17111,"+11,?3,?2,?1,",.01)=$P(DATA,U,9)
49 ...D UPDATE^DIE("","FDA(1820)") K FDA(1820)
50 Q
51 ;
52REV ;PROC/OP^IDENTIFIER^MDC24^DRG...
53 ;;39.72^OQK^
54 ;;+1^25^26^27^23^24^20^21^22
55 ;;+5^237^238
56 ;;+11^673^374^675
57 ;;+21^907^908^909
58 ;;+24^957^958^959
59 ;;39.74^OQK^
60 ;;+1^25^26^27^23^24
61 ;;+21^907^908^909
62 ;;+24^957^958^959
63 ;;39.79^OQK^
64 ;;+1^25^26^27^23^24^20^21^22
65 ;;+5^237^238
66 ;;+11^673^374^675
67 ;;+21^907^908^909
68 ;;+24^957^958^959
69 ;;00.62^O^
70 ;;+1^25^26^27^23^24
71 ;;+5^237^238
72 ;;+11^673^374^675
73 ;;+21^907^908^909
74 ;;+24^957^958^959
75 ;;00.83^OM^
76 ;;+8^485^486^487^488^489
77 ;;+21^907^908^909
78 ;;+24^957^958^959
79 ;;00.84^OM^
80 ;;+8^485^486^487^488^489
81 ;;+21^907^908^909
82 ;;+24^957^958^959
83 ;;84.59^O^
84 ;;+1^28^29^30
85 ;;+8^490^491
86 ;;+21^907^908^909
87 ;;+24^957^958^959
88 ;;84.65^O^
89 ;;+1^28^29^30
90 ;;+8^490^491
91 ;;+21^907^908^909
92 ;;+24^957^958^959
93 ;;84.62^O^
94 ;;+1^28^29^30
95 ;;+8^490^491
96 ;;+21^907^908^909
97 ;;+24^957^958^959
98 ;;84.82^O^
99 ;;+1^28^29^30
100 ;;+8^490^491
101 ;;+21^907^908^909
102 ;;+24^957^958^959
103 ;;00.52^O^
104 ;;+5^245
105 ;;00.54^O^
106 ;;+5^245
107 ;;37.95^O^
108 ;;+5^245
109 ;;37.96^O^
110 ;;+5^245
111 ;;37.97^O^
112 ;;+5^245
113 ;;37.98^O^
114 ;;+5^245
115 ;;57.83^O^
116 ;;+6^344^345^346
117 ;;+11^653^654^655
118 ;;+12^715^716^718
119 ;;+13^749^750
120 ;;+17^820^821^822^826^827^828
121 ;;+21^907^908^909
122 ;;+24^957^958^959
123 ;;69.42^O^
124 ;;+6^344^345^346
125 ;;+13^736^737^743
126 ;;+21^907^908^909
127 ;;+24^957^958^959
128 ;;70.75^O^
129 ;;+6^344^345^346
130 ;;+13^746^747
131 ;;+17^820^821^822^826^827^828
132 ;;+21^907^908^909
133 ;;+24^957^958^959
134 ;;71.72^O^
135 ;;+6^344^345^346
136 ;;+13^746^747
137 ;;+21^907^908^909
138 ;;+24^957^958^959
139 ;;53.00^OzJ^
140 ;;53.01^OzJ^
141 ;;53.02^OzJ^
142 ;;53.03^OzJ^
143 ;;53.04^OzJ^
144 ;;53.05^OzJ^
145 ;;53.10^OzJ^
146 ;;53.11^OzJ^
147 ;;53.12^OzJ^
148 ;;53.13^OzJ^
149 ;;53.14^OzJ^
150 ;;53.15^OzJ^
151 ;;53.16^OzJ^
152 ;;53.17^OzJ^
153 ;;53.21^OzJ^
154 ;;53.29^OzJ^
155 ;;53.31^OzJ^
156 ;;53.39^OzJ^
157 ;;81.00^O
158 ;;+1^28^29^30
159 ;;+8^456^457^458^459^460
160 ;;+21^907^908^909
161 ;;+24^957^958^959
162 ;;81.01^O
163 ;;+8^471^472^473
164 ;;81.04^O
165 ;;+8^453^454^455^456^457^458
166 ;;81.05^O
167 ;;+8^453^454^455^
168 ;;81.30^O
169 ;;+1^28^29^30
170 ;;+8^456^457^458^459^460
171 ;;+21+21^907^908^909
172 ;;+24^957^958^959
173 ;;81.39^O
174 ;;+1^28^29^30
175 ;;+8^456^457^458^459^460
176 ;;+21+21^907^908^909
177 ;;+24^957^958^959
178 ;;81.32^O
179 ;;+8^453^454^455^471^472^473
180 ;;81.34^O
181 ;;+8^453^454^455^456^457^458
182 ;;81.36^O
183 ;;+8^453^454^455^456^457^458
184 ;;81.03^O
185 ;;+8^453^454^455^471^472^473
186 ;;81.07^O
187 ;;+8^453^454^455^456^457^458
188 ;;81.08^O
189 ;;+8^453^454^455^456^457^458
190 ;;81.31^O
191 ;;+8^471^472^473
192 ;;81.33^O
193 ;;+8^453^454^455^471^472^473
194 ;;81.35^O
195 ;;+8^453^454^455^456^457^458
196 ;;81.37^O
197 ;;+8^453^454^455^456^457^458
198 ;;81.38^O
199 ;;+8^453^454^455^456^457^458
200 ;;81.02^O
201 ;;+8^453^454^455^471^472^473
202 ;;81.06^O
203 ;;+8^453^454^455^456^457^458
204 ;;01.15^OQ
205 ;;+1^23^24^25^26^27
206 ;;+8^477^478^479
207 ;;+10^628^629^630
208 ;;01.19^OQ
209 ;;+1^23^24^25^26^27
210 ;;+8^477^478^479
211 ;;+21^907^908^909
212 ;;+24^957^958^959
213 ;;01.6^OQ
214 ;;+1^23^24^25^26^27
215 ;;+3^131^132
216 ;;+8^495^496^497
217 ;;+17^820^821^822^826^827^828
218 ;;+24^955
219 ;;01.25^OQ
220 ;;+1^23^24^25^26^27
221 ;;+3^131^132
222 ;;+8^515^516^517
223 ;;+17^820^821^822^826^827^828
224 ;;+21^907^908^909
225 ;;+24^955
226 ;;02.01^OQ
227 ;;+1^23^24^25^26^27
228 ;;+3^131^132
229 ;;+8^515^516^517
230 ;;+21^907^908^909
231 ;;+24^955
232 ;;02.02^OQ
233 ;;+1^23^24^25^26^27
234 ;;+3^131^132
235 ;;+8^515^516^517
236 ;;+21^907^908^909
237 ;;+24^955
238 ;;02.03^OQ
239 ;;+1^23^24^25^26^27
240 ;;+3^131^132
241 ;;+8^515^516^517
242 ;;+21^907^908^909
243 ;;+24^955
244 ;;02.04^OQ
245 ;;+1^23^24^25^26^27
246 ;;+3^131^132
247 ;;+8^515^516^517
248 ;;+21^907^908^909
249 ;;+24^955
250 ;;02.05^OQ
251 ;;+1^23^24^25^26^27
252 ;;+3^131^132
253 ;;+8^515^516^517
254 ;;+21^907^908^909
255 ;;+24^955
256 ;;02.06^OQ
257 ;;+1^23^24^25^26^27
258 ;;+3^131^132
259 ;;+8^515^516^517
260 ;;+21^907^908^909
261 ;;+24^955
262 ;;02.07^OQ
263 ;;+1^23^24^25^26^27
264 ;;+3^131^132
265 ;;+8^515^516^517
266 ;;+21^907^908^909
267 ;;+24^955
268 ;;85.22^Om^
269 ;;+9^582^583^584^585
270 ;;+21^907^908^909
271 ;;+24^957^958^959
272 ;;85.23^Om
273 ;;+9^582^583^584^585
274 ;;+21^907^908^909
275 ;;+24^957^958^959
276 ;;EXIT
Note: See TracBrowser for help on using the repository browser.