source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMGRP2.m@ 1134

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1QAMGRP2 ;HISC/DAD-AUTO LOAD GROUP DATA: ICD PROCEDURES ;2/10/92 07:33
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3 F QAQLABEL="AN","TR8","TR10","TR11","CV4" S QAQCHECK=0 D LOOP Q:QAQCHECK=-1
4EXIT K X,DIC,DLAYGO,QAMD0,Y,OFFSET,LINE,ST,END,NUM,D0,DIK,DA,LASTD0,TAB,QAQCHECK,QAQCOUNT
5 Q
6LOOP ;
7 S X=$P($T(@QAQLABEL),";;",2) W !!,"Loading: ",X
8 S QAMD0=+$O(^QA(743.5,"B",$E(X,1,30),0)) I QAMD0 W !!?5,"*** ",X," already exists !! ***",*7 D G:(QAQCHECK=-1)!(QAQCHECK=2) XIT
9ASK . W !!?5,"Do you want to check this group's completeness"
10 . S %=2 D YN^DICN I '% W !!?10,"Please answer Y(es) or N(o)" G ASK
11 . S QAQCHECK=%
12 . Q
13 W !!,"Working",! S (QAQCOUNT,TAB)=0
14 I QAQCHECK'>0 K DD,DIC,DINUM,DO S DIC="^QA(743.5,",DIC(0)="LM",DIC("DR")=".02////80.1",DLAYGO=743.5 D FILE^DICN S QAMD0=+Y
15 F OFFSET=1:1 S LINE=$P($T(@QAQLABEL+OFFSET),";;",2) Q:LINE="" D
16 . S ST=+LINE,END=$S(LINE["-":+$P(LINE,"-",2),1:ST),NUM=ST-.000001
17 . F S NUM=$O(^ICD0("BA",NUM)) Q:(NUM'>0)!(NUM>END) D
18 .. F D0=0:0 S D0=$O(^ICD0("BA",NUM,D0)) Q:D0'>0 D
19 ... S NUMBER=$P($G(^ICD0(D0,0)),"^") Q:NUMBER'>0
20 ... S X=NUMBER_";"_D0
21 ... G:$O(^QA(743.5,QAMD0,"GRP","B",$E(X,1,30),0)) SKIP
22 ... S ^QA(743.5,QAMD0,"GRP",D0,0)=X
23 ... S QAQADICT=743.51,QAQAFLD=.01,DA(1)=QAMD0,DA=D0 D ENSET^QAQAXREF
24SKIP ... S LASTD0=D0,QAQCOUNT=QAQCOUNT+1
25 ... W:'TAB ! W ?TAB,NUMBER S TAB=TAB+$S(TAB=70:-70,1:10)
26 ... Q
27 .. Q
28 . Q
29 S ^QA(743.5,QAMD0,"GRP",0)="^743.51A^"_LASTD0_"^"_QAQCOUNT
30 W !!,QAQCOUNT," ICD-9-CM Procedure Codes ",$S(QAQCHECK=1:"checked",1:"loaded"),".",!
31XIT Q
32AN ;;ANESTHESIA INDICATOR PROC LIST
33 ;;01.-02.4
34 ;;02.42-02.93
35 ;;02.99-03.3
36 ;;03.32-03.79
37 ;;03.9
38 ;;03.97
39 ;;04.-04.1
40 ;;04.12-04.79
41 ;;04.9-04.92
42 ;;04.99-05.29
43 ;;05.8-06.1
44 ;;06.12-07.1
45 ;;07.12-08.2
46 ;;08.23-08.24
47 ;;08.3-09.
48 ;;09.1-10.
49 ;;11.1-18.
50 ;;18.2- 20.
51 ;;20.2-20.3
52 ;;20.32-21.0
53 ;;21.03-21.2
54 ;;21.22-21.29
55 ;;21.4-22.
56 ;;22.1
57 ;;22.12
58 ;;22.2-24.0
59 ;;24.2-24.5
60 ;;24.9-25.0
61 ;;25.02
62 ;;25.1-25.5
63 ;;25.59-25.9
64 ;;25.93-26.1
65 ;;26.12-26.9
66 ;;26.99-27.1
67 ;;27.3-27.4
68 ;;27.42-27.51
69 ;;27.53-27.9
70 ;;27.92-28.0
71 ;;28.19-29.1
72 ;;29.12-31.
73 ;;31.1-31.4
74 ;;31.42-33.2
75 ;;33.22-33.25
76 ;;33.27-34.24
77 ;;34.26-34.9
78 ;;34.93-36.00
79 ;;36.03-36.04
80 ;;36.09-37.2
81 ;;37.24-37.6
82 ;;37.62-37.70
83 ;;37.74-37.75
84 ;;37.8-37.9
85 ;;37.99-38.89
86 ;;39.-39.59
87 ;;39.7-39.91
88 ;;39.93-39.94
89 ;;39.96-41.0
90 ;;41.01-41.3
91 ;;41.33-42.21
92 ;;42.23-44.11
93 ;;44.13-44.92
94 ;;44.99-45.11
95 ;;45.13-45.21
96 ;;45.26-45.41
97 ;;45.49-46.94
98 ;;46.99-48.21
99 ;;48.25-49.12
100 ;;49.4
101 ;;49.43-50.1
102 ;;50.12-51.0
103 ;;51.02-51.11
104 ;;51.13-52.1
105 ;;52.12-54.23
106 ;;54.29-54.9
107 ;;54.92-54.95
108 ;;54.99-55.22
109 ;;55.24-55.91
110 ;;55.96-56.32
111 ;;56.34-57.1
112 ;;57.12
113 ;;57.18-57.3
114 ;;57.34-57.91
115 ;;57.93
116 ;;57.96-58.0
117 ;;58.2
118 ;;58.22-58.5
119 ;;58.9-59.92
120 ;;59.99-60.1
121 ;;60.12
122 ;;60.14-60.7
123 ;;60.72-60.91
124 ;;60.93-61.1
125 ;;61.2-61.4
126 ;;61.42-61.9
127 ;;61.92-62.1
128 ;;62.12-63.6
129 ;;63.8-63.9
130 ;;63.92-64.1
131 ;;64.19-64.9
132 ;;64.92-64.93
133 ;;64.95-66.79
134 ;;66.9-67.
135 ;;67.2-67.6
136 ;;67.62-68.1
137 ;;68.13-69.59
138 ;;69.9-69.91
139 ;;69.95
140 ;;69.98-70.
141 ;;70.1
142 ;;70.12-70.2
143 ;;70.3
144 ;;70.32-70.75
145 ;;70.77-71.1
146 ;;71.19-71.2
147 ;;71.22-73.
148 ;;73.1-73.22
149 ;;73.8-75.
150 ;;75.3-75.31
151 ;;75.35-75.50
152 ;;75.52-75.61
153 ;;75.69-76.95
154 ;;76.97-79.02
155 ;;79.05-79.07
156 ;;79.09-79.72
157 ;;79.75-79.77
158 ;;79.79-80.19
159 ;;80.4-81.9
160 ;;81.93-83.95
161 ;;83.99-84.40
162 ;;84.44
163 ;;84.9-85.1
164 ;;85.12-85.50
165 ;;85.53-86.0
166 ;;86.03
167 ;;86.05-86.09
168 ;;86.2-86.22
169 ;;86.4-86.91
170 ;;86.93-86.99
171 ;;93.26
172 ;;94.26-94.27
173 ;;98.5-98.59
174 ;;
175TR8 ;;TR-8 PROC GROUP
176 ;;39.31
177 ;;39.32
178 ;;39.56
179 ;;39.57
180 ;;41.43
181 ;;41.5
182 ;;41.95
183 ;;41.99
184 ;;44.61
185 ;;46.71
186 ;;46.73
187 ;;50.22
188 ;;50.3
189 ;;50.4
190 ;;50.61
191 ;;50.69
192 ;;52.95
193 ;;54.11
194 ;;54.92
195 ;;55.4
196 ;;55.5
197 ;;55.81
198 ;;55.82
199 ;;57.79
200 ;;
201TR10 ;;TR-10 PROC GROUP
202 ;;79.15
203 ;;79.35
204 ;;
205TR11 ;;TR-11 PROC GROUP
206 ;;01.24
207 ;;02.02
208 ;;38.06
209 ;;38.07
210 ;;38.44
211 ;;38.46
212 ;;38.47
213 ;;38.7
214 ;;38.84
215 ;;38.86
216 ;;38.87
217 ;;39.1
218 ;;39.24
219 ;;39.25
220 ;;39.26
221 ;;39.29
222 ;;39.3-39.399999
223 ;;39.56
224 ;;39.57
225 ;;39.58
226 ;;44.49
227 ;;44.61
228 ;;46.10
229 ;;46.20
230 ;;46.21
231 ;;46.73
232 ;;46.75
233 ;;50.22
234 ;;50.4
235 ;;50.6
236 ;;51.71
237 ;;51.79
238 ;;51.91
239 ;;52.5
240 ;;52.6
241 ;;52.95
242 ;;54.11
243 ;;54.19
244 ;;54.3
245 ;;54.74
246 ;;54.75
247 ;;54.91
248 ;;54.92
249 ;;55.4
250 ;;55.5
251 ;;55.81
252 ;;56.82
253 ;;32.3
254 ;;32.4
255 ;;33.4-33.499999
256 ;;34.01
257 ;;34.91
258 ;;34.93
259 ;;38.85
260 ;;39.21
261 ;;39.22
262 ;;39.3-39.399999
263 ;;39.56
264 ;;39.57
265 ;;39.58
266 ;;37.0
267 ;;37.12
268 ;;37.4
269 ;;34.02
270 ;;38.04
271 ;;38.34
272 ;;38.35
273 ;;38.84
274 ;;38.85
275 ;;38.56
276 ;;39.57
277 ;;39.58
278 ;;54.11
279 ;;33.4-33.499999
280 ;;34.01
281 ;;34.02
282 ;;34.04
283 ;;34.09
284 ;;34.71
285 ;;34.91
286 ;;34.92
287 ;;34.93
288 ;;
289CV4 ;;CV-4 PROC GROUP
290 ;;36.1-36.199999
291 ;;36.01
292 ;;36.02
293 ;;36.09
294 ;;
Note: See TracBrowser for help on using the repository browser.