source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1831V.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1ICD1831V ;;ALB/EG/JAT - FY 2008 UPDATE; 6/19/05 4:08pm ; 11/14/07 5:25pm
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 ;;07.13^OQ^
60 ;;+1^23^24^25^26^27
61 ;;+10^614^615
62 ;;07.14^OQ^
63 ;;+1^23^24^25^26^27
64 ;;+10^614^615
65 ;;07.15^OQ^
66 ;;+1^23^24^25^26^27
67 ;;+10^614^615
68 ;;07.17^OQ^
69 ;;+1^23^24^25^26^27
70 ;;+10^614^615
71 ;;07.51^OQ^
72 ;;+1^23^24^25^26^27
73 ;;+10^614^615
74 ;;07.52^OQ^
75 ;;+1^23^24^25^26^27
76 ;;+10^614^615
77 ;;07.53^OQ^
78 ;;+1^23^24^25^26^27
79 ;;+10^614^615
80 ;;07.54^OQ^
81 ;;+1^23^24^25^26^27
82 ;;+10^614^615
83 ;;07.59^OQ^
84 ;;+1^23^24^25^26^27
85 ;;+10^614^615
86 ;;07.61^OQ^
87 ;;+1^23^24^25^26^27
88 ;;+10^614^615
89 ;;07.62^OQ^
90 ;;+1^23^24^25^26^27
91 ;;+10^614^615
92 ;;07.63^OQ^
93 ;;+1^23^24^25^26^27
94 ;;+9^579^580^581
95 ;;+10^614^615
96 ;;07.64^OQ^
97 ;;+1^23^24^25^26^27
98 ;;+9^579^580^581
99 ;;+10^614^615
100 ;;07.65^OQ^
101 ;;+1^23^24^25^26^27
102 ;;+9^579^580^581
103 ;;+10^614^615
104 ;;07.68^OQ^
105 ;;+1^23^24^25^26^27
106 ;;+9^579^580^581
107 ;;+10^614^615
108 ;;07.69^OQ^
109 ;;+1^23^24^25^26^27
110 ;;+9^579^580^581
111 ;;+10^614^615
112 ;;07.71^OQ^
113 ;;+1^23^24^25^26^27
114 ;;+10^614^615
115 ;;07.72^OQ^
116 ;;+1^23^24^25^26^27
117 ;;+9^579^580^581
118 ;;+10^614^615
119 ;;07.79^OQ^
120 ;;+1^23^24^25^26^27
121 ;;+9^579^580^581
122 ;;+10^614^615
123 ;;51.23^OT
124 ;;+6^356^357^358
125 ;;+7^411^412^413^417^418^419
126 ;;+17^820^821^822^826^827^828
127 ;;+21^907^908^909
128 ;;+24^957^958^959
129 ;;57.6^O
130 ;;+11^653^654^655
131 ;;+12^707^708
132 ;;+13^749^750
133 ;;+17^820^821^822^826^827^828
134 ;;+21^907^908^909
135 ;;+24^957^958^959
136 ;;57.71^O
137 ;;+11^653^654^655
138 ;;+12^707^708
139 ;;+13^749^750
140 ;;+17^820^821^822^826^827^828
141 ;;57.79^O
142 ;;+11^653^654^655
143 ;;+12^707^708
144 ;;+13^749^750
145 ;;+17^820^821^822^826^827^828
146 ;;+21^907^908^909
147 ;;+24^957^958^959
148 ;;57.71^O
149 ;;+11^653^654^655
150 ;;+12^707^708
151 ;;+13^749^750
152 ;;+17^820^821^822^826^827^828
153 ;;+21^907^908^909
154 ;;+24^957^958^959
155 ;;57.88^O
156 ;;+11^653^654^655
157 ;;+12^707^708
158 ;;+17^820^821^822^826^827^828
159 ;;01.12^OQ
160 ;;+1^23^24^25^26^27
161 ;;+17^820^821^822^826^827^828
162 ;;01.14^OQ
163 ;;+1^23^24^25^26^27
164 ;;+17^820^821^822^826^827^828
165 ;;01.42^OQ
166 ;;+1^23^24^25^26^27
167 ;;+17^820^821^822^826^827^828
168 ;;+24^955
169 ;;01.51^OQ
170 ;;+1^23^24^25^26^27
171 ;;+17^820^821^822^826^827^828
172 ;;+24^955
173 ;;01.52^OQ
174 ;;+1^23^24^25^26^27
175 ;;+17^820^821^822^826^827^828
176 ;;+24^955
177 ;;01.53^OQ
178 ;;+1^23^24^25^26^27
179 ;;+17^820^821^822^826^827^828
180 ;;+24^955
181 ;;01.59^OQ
182 ;;+1^23^24^25^26^27
183 ;;+17^820^821^822^826^827^828
184 ;;+24^955
185 ;;02.99^OQ
186 ;;+1^23^24^25^26^27
187 ;;+3^131^132
188 ;;+8^515^516^517
189 ;;+17^820^821^822^826^827^828
190 ;;+21^907^908^909
191 ;;+24^955
192 ;;02.91^OQ
193 ;;+1^23^24^25^26^27
194 ;;+17^820^821^822^826^827^828
195 ;;+21^907^908^909
196 ;;+24^955
197 ;;01.18^OQ
198 ;;+1^23^24^25^26^27
199 ;;+17^820^821^822^826^827^828
200 ;;+21^907^908^909
201 ;;+24^957^958^959
202 ;;01.23^OQ
203 ;;+1^23^24^25^26^27
204 ;;+3^131^132
205 ;;+17^820^821^822^826^827^828
206 ;;+21^907^908^909
207 ;;+24^955
208 ;;01.24^OQ
209 ;;+1^23^24^25^26^27
210 ;;+3^131^132
211 ;;+17^820^821^822^826^827^828
212 ;;+21^907^908^909
213 ;;+24^955
214 ;;01.31^OQ
215 ;;+1^23^24^25^26^27
216 ;;+17^820^821^822^826^827^828
217 ;;+21^907^908^909
218 ;;+24^955
219 ;;01.32^OQ
220 ;;+1^23^24^25^26^27
221 ;;+17^820^821^822^826^827^828
222 ;;+21^907^908^909
223 ;;+24^955
224 ;;01.39^OQ
225 ;;+1^23^24^25^26^27
226 ;;+17^820^821^822^826^827^828
227 ;;+21^907^908^909
228 ;;+24^955
229 ;;01.41^OQ
230 ;;+1^23^24^25^26^27
231 ;;+17^820^821^822^826^827^828
232 ;;+21^907^908^909
233 ;;+24^955
234 ;;EXIT
Note: See TracBrowser for help on using the repository browser.