source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1824C.m@ 729

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1ICD1824C ; ALB/JAT - FY 2007 UPDATE; 7/27/05 14:50;
2 ;;18.0;DRG Grouper;**24**;Oct 13,2000;Build 5
3 Q
4 ;
5DIAG ; - update diagnosis codes
6 ; from Table 6A in Fed Reg - assumes new codes already added by Lexicon
7 D BMES^XPDUTL(">>>Modifying new diagnosis codes - file 80")
8 N LINE,X,ICDDIAG,ENTRY,DA,DIE,DR,IDENT,MDC,MDC25,FDA
9 F LINE=1:1 S X=$T(REVD+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
10 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))
11 .I ENTRY D
12 ..;check for possible inactive dupe
13 ..I $P($G(^ICD9(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I 'ENTRY Q
14 ..S DA=ENTRY,DIE="^ICD9("
15 ..S IDENT=$P(ICDDIAG,U,2)
16 ..S MDC=$P(ICDDIAG,U,3)
17 ..;this would only apply to diagnoses who have no other MDC than a pre-MDC
18 ..I MDC="PRE" S MDC=98
19 ..S MDC25=$P(ICDDIAG,U,4)
20 ..S DR="2///^S X=IDENT;5///^S X=MDC;5.9///^S X=MDC25"
21 ..D ^DIE
22 ..;check if already created in case patch being re-installed
23 ..Q:$D(^ICD9(ENTRY,3,"B",3061001))
24 ..; add 80.071 and 80.711 and 80.072 records
25 ..N FDA
26 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
27 ..S FDA(1820,80.071,"+2,?1,",.01)=3061001
28 ..S FDA(1820,80.072,"+3,?1,",.01)=3061001
29 ..S FDA(1820,80.072,"+3,?1,",1)=$P(ICDDIAG,U,3)
30 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
31 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
32 ..S FDA(1820,80.071,"?2,?1,",.01)=3061001
33 ..S FDA(1820,80.711,"+3,?2,?1,",.01)=$P(ICDDIAG,U,5)
34 ..I $P(ICDDIAG,U,6) S FDA(1820,80.711,"+4,?2,?1,",.01)=$P(ICDDIAG,U,6)
35 ..I $P(ICDDIAG,U,7) S FDA(1820,80.711,"+5,?2,?1,",.01)=$P(ICDDIAG,U,7)
36 ..I $P(ICDDIAG,U,8) S FDA(1820,80.711,"+6,?2,?1,",.01)=$P(ICDDIAG,U,8)
37 ..I $P(ICDDIAG,U,9) S FDA(1820,80.711,"+7,?2,?1,",.01)=$P(ICDDIAG,U,9)
38 ..I $P(ICDDIAG,U,10) S FDA(1820,80.711,"+8,?2,?1,",.01)=$P(ICDDIAG,U,10)
39 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
40 Q
41 ;
42REVD ;
43 ;;052.2^Q^1^^543^561
44 ;;053.14^Q^1^^543^561
45 ;;054.74^Q^1^^543^561
46 ;;238.71^^16^^398^399
47 ;;238.72^^16^^395^396
48 ;;238.73^^16^^395^396
49 ;;238.74^^16^^395^396
50 ;;238.75^^16^^395^396
51 ;;238.76^^17^^401^402^403^404^539^540
52 ;;238.79^^17^^401^402^403^404^539^540
53 ;;277.30^^8^^240^241
54 ;;277.31^^8^^240^241
55 ;;277.39^^8^^240^241
56 ;;284.01^^16^^574
57 ;;284.09^^16^^574
58 ;;284.1^^16^^395^396
59 ;;284.2^^17^^401^402^403^404^539^540
60 ;;288.00^^16^3^574^490
61 ;;288.01^^16^3^574^490
62 ;;288.02^^16^3^574^490
63 ;;288.03^^16^3^574^490
64 ;;288.04^^16^3^574^490
65 ;;288.09^^16^3^574^490
66 ;;288.4^^16^^398^399
67 ;;288.50^^16^^398^399
68 ;;288.51^^16^^398^399
69 ;;288.59^^16^^398^399
70 ;;288.60^^16^^398^398
71 ;;288.61^^16^^398^398
72 ;;288.62^^16^^398^398
73 ;;288.63^^16^^398^398
74 ;;288.64^^16^^398^398
75 ;;288.65^^16^^398^398
76 ;;288.69^^16^^398^398
77 ;;289.53^^16^^398^399
78 ;;289.83^^17^^401^402^403^404^539^540
79 ;;323.01^Q^1^^543^561
80 ;;323.02^Q^1^^543^561
81 ;;323.41^Q^1^^543^561
82 ;;323.42^Q^1^^543^561
83 ;;323.51^Q^1^^543^561
84 ;;323.52^Q^1^^543^561
85 ;;323.61^Q^1^^543^561
86 ;;323.62^Q^1^^543^561
87 ;;323.63^Q^1^^543^561
88 ;;323.71^Q^1^^34^35^543
89 ;;323.72^Q^1^^34^35^543
90 ;;323.81^Q^1^3^543^561^489
91 ;;323.82^Q^1^3^543^561^489
92 ;;331.83^^1^^12
93 ;;333.71^^1^^12
94 ;;333.72^^1^^34^35
95 ;;333.79^^1^^34^35
96 ;;333.85^^1^^34^35
97 ;;333.94^^1^^12
98 ;;338.0^^23^^463^464
99 ;;338.11^^23^^463^464
100 ;;338.12^^23^^463^464
101 ;;338.18^^23^^463^464
102 ;;338.19^^23^^463^464
103 ;;338.21^^23^^463^464
104 ;;338.22^^23^^463^464
105 ;;338.28^^23^^463^464
106 ;;338.29^^23^^463^464
107 ;;338.3^^23^^463^464
108 ;;338.4^^23^^463^464
109 ;;341.20^^1^^543^561
110 ;;341.21^^1^^543^561
111 ;;341.22^^1^^543^561
112 ;;377.43^^2^^45
113 ;;379.60^^2^^46^47^48
114 ;;379.61^^2^^46^47^48
115 ;;379.62^^2^^46^47^48
116 ;;379.63^^2^^46^47^48
117 ;;389.15^^3^^73^74
118 ;;389.16^^3^^73^74
119 ;;429.83^^5^^144^145
120 ;;478.11^^3^^73^74
121 ;;478.19^^3^^73^74
122 ;;518.7^^4^^101^102
123 ;;519.11^Y^4^^96^97^98
124 ;;519.19^Y^4^^96^97^98
125 ;;521.81^Y^3^^185^186^187
126 ;;521.89^Y^3^^185^186^187
127 ;;523.00^Y^3^^185^186^187
128 ;;523.01^Y^3^^185^186^187
129 ;;523.10^Y^3^^185^186^187
130 ;;523.11^Y^3^^185^186^187
131 ;;523.30^Y^3^^185^186^187
132 ;;523.31^Y^3^^185^186^187
133 ;;523.32^Y^3^^185^186^187
134 ;;523.33^Y^3^^185^186^187
135 ;;523.40^Y^3^^185^186^187
136 ;;523.41^Y^3^^185^186^187
137 ;;523.42^Y^3^^185^186^187
138 ;;525.60^Y^3^^185^186^187
139 ;;525.61^Y^3^^185^186^187
140 ;;525.62^Y^3^^185^186^187
141 ;;525.63^Y^3^^185^186^187
142 ;;525.64^Y^3^^185^186^187
143 ;;525.65^Y^3^^185^186^187
144 ;;525.66^Y^3^^185^186^187
145 ;;525.67^Y^3^^185^186^187
146 ;;525.69^Y^3^^185^186^187
147 ;;526.61^Y^3^^185^186^187
148 ;;526.62^Y^3^^185^186^187
149 ;;526.63^Y^3^^185^186^187
150 ;;526.69^Y^3^^185^186^187
151 ;;528.00^Y^3^^185^186^187
152 ;;528.01^Y^3^^185^186^187
153 ;;528.02^Y^3^^185^186^187
154 ;;528.09^Y^3^^185^186^187
155 ;;538.^^6^^182^183^184
156 ;;608.20^^12^^352
157 ;;608.21^^12^^352
158 ;;608.22^^12^^352
159 ;;608.23^^12^^352
160 ;;608.24^^12^^352
161 ;;616.81^^13^^358^359^368
162 ;;616.89^^13^^358^359^368
163 ;;618.84^^13^^358^359^369
164 ;;629.29^^13^^358^359^369
165 ;;629.81^^13^^358^359^369
166 ;;629.89^^13^^358^359^369
167 ;;649.00^^14^^469
168 ;;649.01^^14^^370^371^372^373^374^375
169 ;;649.02^^14^^370^371^372^373^374^375
170 ;;649.03^^14^^383^384
171 ;;649.04^^14^^376^377
172 ;;649.10^^14^^469
173 ;;649.11^^14^^370^371^372^373^374^375
174 ;;649.12^^14^^370^371^372^373^374^375
175 ;;649.13^^14^^383^384
176 ;;649.14^^14^^376^377
177 ;;649.20^^14^^469
178 ;;649.21^^14^^370^371^372^373^374^375
179 ;;649.22^^14^^370^371^372^373^374^375
180 ;;649.23^^14^^383^384
181 ;;649.24^^14^^376^377
182 ;;649.30^^14^^469
183 ;;649.31^^14^^370^371^372^373^374^375
184 ;;649.32^^14^^370^371^372^373^374^375
185 ;;649.33^^14^^383^384
186 ;;649.34^^14^^376^377
187 ;;649.40^^14^^469
188 ;;649.41^^14^^370^371^372^373^374^375
189 ;;649.42^^14^^370^371^372^373^374^375
190 ;;649.43^^14^^383^384
191 ;;649.44^^14^^376^377
192 ;;649.50^^14^^469
193 ;;649.51^^14^^370^371^372^373^374^375
194 ;;649.53^^14^^383^384
195 ;;649.60^^14^^469
196 ;;649.61^^14^^370^371^372^373^374^375
197 ;;649.62^^14^^370^371^372^373^374^375
198 ;;649.63^^14^^383^384
199 ;;649.64^^14^^376^377
200 ;;729.71^^8^^248
201 ;;729.72^^8^^248
202 ;;729.73^^8^^248
203 ;;729.79^^8^^248
204 ;;731.3^^8^^244^245
205 ;;768.7^^15^^390
206 ;;770.87^^15^^390
207 ;;770.88^^15^^390
208 ;;775.81^^15^^390
209 ;;775.89^^15^^390
210 ;;779.85^^15^^387^389
211 ;;780.32^^1^^26^562^563
212 ;;780.96^^23^^463^464
213 ;;780.97^^23^^463^464
214 ;;784.91^^3^^73^74
215 ;;784.99^^3^^73^74
216 ;;788.64^^11^^325^326^327
217 ;;788.65^^11^^325^326^327
218 ;;793.91^^23^^463^464
219 ;;793.99^^23^^463^464
220 ;;795.06^^13^^358^359^369
221 ;;795.81^^23^^463^464
222 ;;795.82^^23^^463^464
223 ;;795.89^^23^^463^464
224 ;;958.90^^21^^454^455
225 ;;958.91^^21^^454^455
226 ;;958.92^^21^^454^455
227 ;;958.93^^21^^454^455
228 ;;958.99^^21^^454^455
229 ;;995.20^^21^^449^450^451
230 ;;995.21^^21^^449^450^451
231 ;;995.22^^21^^449^450^451
232 ;;995.23^^21^^449^450^451
233 ;;995.27^^21^^449^450^451
234 ;;995.29^^21^^449^450^451
235 ;;V18.51^^23^^467
236 ;;V18.59^^23^^467
237 ;;V26.34^^23^^467
238 ;;V26.35^^23^^467
239 ;;V26.39^^23^^467
240 ;;V45.86^^23^^467
241 ;;V58.30^^23^^467
242 ;;V58.31^^23^^467
243 ;;V58.32^^23^^467
244 ;;V72.11^^23^^467
245 ;;V72.19^^23^^467
246 ;;V82.71^^23^^467
247 ;;V82.79^^23^^467
248 ;;V85.51^^23^^467
249 ;;V85.52^^23^^467
250 ;;V85.53^^23^^467
251 ;;V85.54^^23^^467
252 ;;V86.0^^23^^467
253 ;;V86.1^^23^^467
254 ;;EXIT
Note: See TracBrowser for help on using the repository browser.