source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1817P.m@ 1042

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1ICD1817P ;;ALB/EG/JAT - CORRECT PROC CODES ; 6/27/05 1:03pm
2 ;;18.0;DRG Grouper;**17**;Oct 13,2000
3 ;
4 D CHGPROC
5 D CHGDIAG
6 Q
7 ;
8CHGPROC ;
9 D BMES^XPDUTL(">>>Modifying records in file 80.1")
10 ; modify Identifier field (#2) in file 80.1
11 N LINE,X,ICDPROC,ENTRY,DA,DIE,DR,IDENT,DIC
12 S LINE=1
13 F S X=$T(REVP+LINE) S ICDPROC=$P(X,";;",2) Q:ICDPROC="EXIT" D
14 .S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0)) I ENTRY D
15 ..S DA=ENTRY,DIE="^ICD0("
16 ..S IDENT=$P(ICDPROC,U,2)
17 ..S DR="2///^S X=IDENT"
18 ..D ^DIE
19 ..S LINE=LINE+1
20 ; kill 80.171 sub-file record and descendants for proc 80.51
21 N DA,DIK
22 S DA(1)=3867
23 S DA=2
24 S DIK="^ICD0("_DA(1)_",""2"","
25 D ^DIK
26 ; add Oct 1,2004 record to 80.171, MDC 1 to 80.1711, and 543
27 ; to 80.17111 for proc 01.14 ONLY
28 S ENTRY=2963
29 ; check if already created in case patch being re-installed
30 I $D(^ICD0(ENTRY,2,2)) G SKIP
31 S DA(1)=ENTRY
32 S DIC="^ICD0("_DA(1)_",2,"
33 S DIC(0)="L"
34 S X=3041001 K DO D FILE^DICN K DIC,DA
35 S DA(2)=ENTRY
36 S DA(1)=2
37 S DIC="^ICD0("_DA(2)_",2,"_DA(1)_",1,"
38 S DIC(0)="L"
39 S X=1 K DO D FILE^DICN K DIC,DA
40 S DA(3)=ENTRY
41 S DA(2)=2
42 S DA(1)=1
43 S DIC="^ICD0("_DA(3)_",2,"_DA(2)_",1,"_DA(1)_",1,"
44 S DIC(0)="L"
45 S X=543 K DO D FILE^DICN K DIC,DA
46 ; add 80.17111 sub-file records to 80.1711 and 80.171
47SKIP ;
48 S LINE=1
49 N Z
50 F S Z=$T(REVPRO+LINE) S ICDPROC=$P(Z,";;",2) Q:ICDPROC="EXIT" D
51 .S ENTRY=+$O(^ICD0("BA",$P(ICDPROC,U)_" ",0)) I ENTRY D
52 ..S DA(3)=ENTRY,DA(2)=2,DA(1)=1
53 ..S DIC="^ICD0("_DA(3)_",2,"_DA(2)_",1,"_DA(1)_",1,"
54 ..S DIC(0)="L"
55 ..; check if already created in case patch being re-installed
56 ..I $D(^ICD0(ENTRY,2,2,1,1,1,2,0)) S LINE=LINE+1 Q
57 ..; add DRG 1,2 and 3
58 ..S X=1
59 ..K DO
60 ..D FILE^DICN
61 ..S X=2
62 ..D FILE^DICN
63 ..S X=3
64 ..D FILE^DICN
65 ..S LINE=LINE+1
66 Q
67 ;
68REVP ;
69 ;;36.12^Ob6
70 ;;36.13^Ob6
71 ;;36.14^Ob6
72 ;;51.23^TT
73 ;;81.61^O
74 ;;01.14^OQ
75 ;;02.13^OQK
76 ;;38.01^OQK
77 ;;38.11^OQK
78 ;;38.31^OQK
79 ;;38.41^OQK
80 ;;38.51^OQK
81 ;;38.61^OQK
82 ;;38.81^OQK
83 ;;39.28^OQK
84 ;;39.51^OQK
85 ;;39.52^OQK
86 ;;39.53^OQK
87 ;;39.72^OQK
88 ;;39.79^OQK
89 ;;EXIT
90 Q
91REVPRO ;
92 ;;01.59^
93 ;;01.12^
94 ;;01.14^
95 ;;01.15^
96 ;;01.18^
97 ;;01.19^
98 ;;01.21^
99 ;;01.22^
100 ;;01.23^
101 ;;01.24^
102 ;;01.25^
103 ;;01.31^
104 ;;01.32^
105 ;;01.39^
106 ;;01.41^
107 ;;01.42^
108 ;;01.51^
109 ;;01.52^
110 ;;01.53^
111 ;;01.6^
112 ;;02.01^
113 ;;02.02^
114 ;;02.03^
115 ;;02.04^
116 ;;02.05^
117 ;;02.06^
118 ;;02.07^
119 ;;02.11^
120 ;;02.12^
121 ;;02.13^
122 ;;02.14^
123 ;;02.2^
124 ;;02.91^
125 ;;02.92^
126 ;;02.93^
127 ;;02.94^
128 ;;02.99^
129 ;;04.01^
130 ;;04.41^
131 ;;07.13^
132 ;;07.14^
133 ;;07.15^
134 ;;07.17^
135 ;;07.51^
136 ;;07.52^
137 ;;07.53^
138 ;;07.54^
139 ;;07.59^
140 ;;07.61^
141 ;;07.62^
142 ;;07.63^
143 ;;07.64^
144 ;;07.65^
145 ;;07.68^
146 ;;07.69^
147 ;;07.71^
148 ;;07.72^
149 ;;07.79^
150 ;;29.92^
151 ;;38.01^
152 ;;38.11^
153 ;;38.31^
154 ;;38.41^
155 ;;38.51^
156 ;;38.61^
157 ;;38.81^
158 ;;39.28^
159 ;;39.51^
160 ;;39.52^
161 ;;39.53^
162 ;;39.72^
163 ;;39.79^
164 ;;EXIT
165 Q
166 ;
167CHGDIAG ;
168 D BMES^XPDUTL(">>>Modifying records in file 80")
169 ; modify Identifier field (#2) in file 80
170 N LINE,X,ICDDIAG,ENTRY,DA,DIE,DR,IDENT
171 S LINE=1
172 F S X=$T(REVD+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
173 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0)) I ENTRY D
174 ..S DA=ENTRY,DIE="^ICD9("
175 ..S IDENT=$P(ICDDIAG,U,2)
176 ..S DR="2///^S X=IDENT"
177 ..D ^DIE
178 ..S LINE=LINE+1
179 ; change MDC
180 S DA=8725,DIE="^ICD9(",IDENT=5
181 S DR="5///^S X=IDENT"
182 D ^DIE
183 ; add 80.071, 80.711 and 80.072 records for diag 428.0
184 I $D(^ICD9(9061,3)) G DELETE
185 N FDA
186 S FDA(428,80,"?1,",.01)="`9061"
187 S FDA(428,80.071,"+2,?1,",.01)=3031001
188 S FDA(428,80.072,"+3,?1,",.01)=3031001
189 S FDA(428,80.072,"+3,?1,",1)=5
190 D UPDATE^DIE("","FDA(428)") K FDA(428)
191 S FDA(428,80,"?1,",.01)="`9061"
192 S FDA(428,80.071,"?2,?1,",.01)=3031001
193 S FDA(428,80.711,"+3,?2,?1,",.01)=115
194 S FDA(428,80.711,"+4,?2,?1,",.01)=121
195 S FDA(428,80.711,"+5,?2,?1,",.01)=124
196 S FDA(428,80.711,"+6,?2,?1,",.01)=127
197 D UPDATE^DIE("","FDA(428)")
198 ; kill 80.071 and 80.072 subfile records for diag 309.81
199DELETE ;
200 N DA,DIK
201 S DA(1)=1399
202 S DA=2
203 S DIK="^ICD9("_DA(1)_",""3"","
204 D ^DIK
205 S DIK="^ICD9("_DA(1)_",""4"","
206 D ^DIK
207 ;kill 80.071 and 80.072 subfile records for diag 250.70
208 S DA(1)=8725
209 S DA=2
210 S DIK="^ICD9("_DA(1)_",""3"","
211 D ^DIK
212 S DIK="^ICD9("_DA(1)_",""4"","
213 D ^DIK
214 Q
215 ;
216REVD ;
217 ;;402.91^ZX
218 ;;428.32^ZX
219 ;;430.^CQK
220 ;;431.^CQK
221 ;;432.9^CQK
222 ;;EXIT
Note: See TracBrowser for help on using the repository browser.