source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECX356PT.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 8.7 KB
Line 
1ECX356PT ;ALB/JAM - PATCH ECX*3.0*48 Post-Init Rtn ; 03/24/03
2 ;;3.0;DSS EXTRACTS;**56**;Sept 19, 2003
3 ;
4 ;Post-init routine to add new entries to:
5 ; NATIONAL CLINIC file (#728.441)
6EN ;
7 ;- Add new entry to file 728.441
8 ; ECXREC is in format: code^short description
9 N ECXFDA,ECXERR,ECXCODE,ECXREC,I,CNT0,CNT1
10 D BMES^XPDUTL(">>> Adding entry to the NATIONAL CLINIC (#728.441) file...")
11 D MES^XPDUTL(" ")
12 S (CNT0,CNT1,CNT2)=0 K ^UTILITY("NATLCODE",$J)
13 ;
14 D LOADDATA ;B/C of the large number of new codes, they are stored in numerous routines. Load all codes into
15 ; a utility global before adding to database
16 D PROCESS
17 D END
18 Q ;End of loading process
19LOADDATA ;Load all new codes into utility global
20 ;
21 S CNT=1
22 F ECX=1:1 S ECXX=$P($T(NATCLIN+ECX),";;",2) Q:ECXX="QUIT" D
23 . S ^UTILITY("NATLCODE",$J,CNT)=ECXX,CNT=CNT+1
24 F ECX=1:1 S ECXX=$P($T(NATCLIN+ECX^ECX356D1),";;",2) Q:ECXX="QUIT" D
25 . S ^UTILITY("NATLCODE",$J,CNT)=ECXX,CNT=CNT+1
26 F ECX=1:1 S ECXX=$P($T(NATCLIN+ECX^ECX356D2),";;",2) Q:ECXX="QUIT" D
27 . S ^UTILITY("NATLCODE",$J,CNT)=ECXX,CNT=CNT+1
28 Q ;LOADDATA
29 ;
30PROCESS ; Get NAT'L CLINIC records from UTL global
31 S SEQ=""
32 F S SEQ=$O(^UTILITY("NATLCODE",$J,SEQ)) Q:SEQ="" D
33 . S ECXREC=^UTILITY("NATLCODE",$J,SEQ)
34 . S ECXCODE=$P(ECXREC,"^")
35 .; Quit w/error message if entry already exists
36 . I $$FIND1^DIC(728.441,"","X",ECXCODE) D Q
37 . . D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" not added, entry already exists.")
38 . . S CNT1=CNT1+1
39 .; Setup field values of new entry
40 . S ECXFDA(728.441,"+1,",.01)=ECXCODE
41 . S ECXFDA(728.441,"+1,",1)=$P(ECXREC,"^",2)
42 .; Add new entry
43 . D UPDATE^DIE("E","ECXFDA","","ECXERR")
44 . I '$D(ECXERR) D Q
45 . . D BMES^XPDUTL(">>>..."_ECXCODE_" "_$P(ECXREC,U,2)_" added to file.")
46 . . S CNT0=CNT0+1
47 . D BMES^XPDUTL(">>>...Unable to add "_ECXCODE_" "_$P(ECXREC,U,2)_" to file.")
48 . S CNT2=CNT2+1
49 . K ECXERR ;clean out error array b4 processing next code
50 ;
51 Q ;FILEONE
52END D MES^XPDUTL(" ")
53 D MES^XPDUTL(" Done... Update to NATIONAL CLINIC File (#728.441).")
54 D MES^XPDUTL(" "_$J(CNT0,3)_" new entries added.")
55 D MES^XPDUTL(" "_$J(CNT1,3)_" were not added, already exist.")
56 D MES^XPDUTL(" "_$J(CNT2,3)_" were not added, unable to add.")
57 D MES^XPDUTL(" ")
58 K ^UTILITY("NATLCODE",$J)
59 Q
60 ;
61NATCLIN ;NAT'L CLINIC entry to add:
62 ;;ICBC^CBC I
63 ;;INUR^RN I
64 ;;IRED^RED TEAM I
65 ;;IBLU^BLUE TEAM I
66 ;;IYEL^YELLOW TEAM I
67 ;;ICPX^C&P CLINIC PROFILE I
68 ;;IOTH^OTHER I
69 ;;IPRI^PRIMARY CARE I
70 ;;ISAT^SATELLITE I
71 ;;ITEM^TEAM I
72 ;;JCBC^CBC J
73 ;;JNUR^RN J
74 ;;JRED^RED TEAM J
75 ;;JBLU^BLUE TEAM J
76 ;;JYEL^YELLOW TEAM J
77 ;;JCPX^C&P CLINIC PROFILE J
78 ;;JOTH^OTHER J
79 ;;JPRI^PRIMARY CARE J
80 ;;JSAT^SATELLITE J
81 ;;JTEM^TEAM J
82 ;;KCBC^CBC K
83 ;;KNUR^RN K
84 ;;KRED^RED TEAM K
85 ;;KBLU^BLUE TEAM K
86 ;;KYEL^YELLOW TEAM K
87 ;;KCPX^C&P CLINIC PROFILE K
88 ;;KOTH^OTHER K
89 ;;KPRI^PRIMARY CARE K
90 ;;KSAT^SATELLITE K
91 ;;KTEM^TEAM K
92 ;;LCBC^CBC L
93 ;;LNUR^RN L
94 ;;LRED^RED TEAM L
95 ;;LBLU^BLUE TEAM L
96 ;;LYEL^YELLOW TEAM L
97 ;;LCPX^C&P CLINIC PROFILE L
98 ;;LOTH^OTHER L
99 ;;LPRI^PRIMARY CARE L
100 ;;LSAT^SATELLITE L
101 ;;LTEM^TEAM L
102 ;;MCBC^CBC M
103 ;;MNUR^RN M
104 ;;MRED^RED TEAM M
105 ;;MBLU^BLUE TEAM M
106 ;;MYEL^YELLOW TEAM M
107 ;;MCPX^C&P CLINIC PROFILE M
108 ;;MOTH^OTHER M
109 ;;MPRI^PRIMARY CARE M
110 ;;MSAT^SATELLITE M
111 ;;MTEM^TEAM M
112 ;;NCBC^CBC N
113 ;;NNUR^RN N
114 ;;NRED^RED TEAM N
115 ;;NBLU^BLUE TEAM N
116 ;;NYEL^YELLOW TEAM N
117 ;;NCPX^C&P CLINIC PROFILE N
118 ;;NOTH^OTHER N
119 ;;NPRI^PRIMARY CARE N
120 ;;NSAT^SATELLITE N
121 ;;NTEM^TEAM N
122 ;;OCBC^CBC O
123 ;;ONUR^RN O
124 ;;ORED^RED TEAM O
125 ;;OBLU^BLUE TEAM O
126 ;;OYEL^YELLOW TEAM O
127 ;;OCPX^C&P CLINIC PROFILE O
128 ;;OOTH^OTHER O
129 ;;OPRI^PRIMARY CARE O
130 ;;OSAT^SATELLITE O
131 ;;OTEM^TEAM O
132 ;;PCBC^CBC P
133 ;;PNUR^RN P
134 ;;PRED^RED TEAM P
135 ;;PBLU^BLUE TEAM P
136 ;;PYEL^YELLOW TEAM P
137 ;;PCPX^C&P CLINIC PROFILE P
138 ;;POTH^OTHER P
139 ;;PPRI^PRIMARY CARE P
140 ;;PSAT^SATELLITE P
141 ;;PTEM^TEAM P
142 ;;QCBC^CBC Q
143 ;;QNUR^RN Q
144 ;;QRED^RED TEAM Q
145 ;;QBLU^BLUE TEAM Q
146 ;;QYEL^YELLOW TEAM Q
147 ;;QCPX^C&P CLINIC PROFILE Q
148 ;;QOTH^OTHER Q
149 ;;QPRI^PRIMARY CARE Q
150 ;;QSAT^SATELLITE Q
151 ;;QTEM^TEAM Q
152 ;;RCBC^CBC R
153 ;;RNUR^RN R
154 ;;RRED^RED TEAM R
155 ;;RBLU^BLUE TEAM R
156 ;;RYEL^YELLOW TEAM R
157 ;;RCPX^C&P CLINIC PROFILE R
158 ;;ROTH^OTHER R
159 ;;RPRI^PRIMARY CARE R
160 ;;RSAT^SATELLITE R
161 ;;RTEM^TEAM R
162 ;;SCBC^CBC S
163 ;;SNUR^RN S
164 ;;SRED^RED TEAM S
165 ;;SBLU^BLUE TEAM S
166 ;;SYEL^YELLOW TEAM S
167 ;;SCPX^C&P CLINIC PROFILE S
168 ;;SOTH^OTHER S
169 ;;SPRI^PRIMARY CARE S
170 ;;SSAT^SATELLITE S
171 ;;STEM^TEAM S
172 ;;TCBC^CBC T
173 ;;TNUR^RN T
174 ;;TRED^RED TEAM T
175 ;;TBLU^BLUE TEAM T
176 ;;TYEL^YELLOW TEAM T
177 ;;TCPX^C&P CLINIC PROFILE T
178 ;;TOTH^OTHER T
179 ;;TPRI^PRIMARY CARE T
180 ;;TSAT^SATELLITE T
181 ;;TTEM^TEAM T
182 ;;UCBC^CBC U
183 ;;UNUR^RN U
184 ;;URED^RED TEAM U
185 ;;UBLU^BLUE TEAM U
186 ;;UYEL^YELLOW TEAM U
187 ;;UCPX^C&P CLINIC PROFILE U
188 ;;UOTH^OTHER U
189 ;;UPRI^PRIMARY CARE U
190 ;;USAT^SATELLITE U
191 ;;UTEM^TEAM U
192 ;;VCBC^CBC V
193 ;;VNUR^RN V
194 ;;VRED^RED TEAM V
195 ;;VBLU^BLUE TEAM V
196 ;;VYEL^YELLOW TEAM V
197 ;;VCPX^C&P CLINIC PROFILE V
198 ;;VOTH^OTHER V
199 ;;VPRI^PRIMARY CARE V
200 ;;VSAT^SATELLITE V
201 ;;VTEM^TEAM V
202 ;;WCBC^CBC W
203 ;;WNUR^RN W
204 ;;WRED^RED TEAM W
205 ;;WBLU^BLUE TEAM W
206 ;;WYEL^YELLOW TEAM W
207 ;;WCPX^C&P CLINIC PROFILE W
208 ;;WOTH^OTHER W
209 ;;WPRI^PRIMARY CARE W
210 ;;WSAT^SATELLITE W
211 ;;WTEM^TEAM W
212 ;;XCBC^CBC X
213 ;;XNUR^RN X
214 ;;XRED^RED TEAM X
215 ;;XBLU^BLUE TEAM X
216 ;;XYEL^YELLOW TEAM X
217 ;;XCPX^C&P CLINIC PROFILE X
218 ;;XOTH^OTHER X
219 ;;XPRI^PRIMARY CARE X
220 ;;XSAT^SATELLITE X
221 ;;XTEM^TEAM X
222 ;;YCBC^CBC Y
223 ;;YNUR^RN Y
224 ;;YRED^RED TEAM Y
225 ;;YBLU^BLUE TEAM Y
226 ;;YYEL^YELLOW TEAM Y
227 ;;YCPX^C&P CLINIC PROFILE Y
228 ;;YOTH^OTHER Y
229 ;;YPRI^PRIMARY CARE Y
230 ;;YSAT^SATELLITE Y
231 ;;YTEM^TEAM Y
232 ;;ZCBC^CBC Z
233 ;;ZNUR^RN Z
234 ;;ZRED^RED TEAM Z
235 ;;ZBLU^BLUE TEAM Z
236 ;;ZYEL^YELLOW TEAM Z
237 ;;ZCPX^C&P CLINIC PROFILE Z
238 ;;ZOTH^OTHER Z
239 ;;ZPRI^PRIMARY CARE Z
240 ;;ZSAT^SATELLITE Z
241 ;;ZTEM^TEAM Z
242 ;;CDSW^Cardiac Disease Social Worker
243 ;;CDRN^Cardiac Disease Registered Nurse
244 ;;CDNP^Cardiac Disease Nurse Practitioner
245 ;;CDRD^Cardiac Disease Registered Dietician
246 ;;CDPT^Cardiac Disease Physical Therapist
247 ;;CDPA^Cardiac Disease Physician Assistant
248 ;;CDPH^Cardiac Disease Pharmacist
249 ;;CDCC^Cardiac Disease CC Team
250 ;;CGSW^Coag Management Social Worker
251 ;;CGRN^Coag Management Registered Nurse
252 ;;CGNP^Coag Management Nurse Practitioner
253 ;;CGRD^Coag Management Registered Dietician
254 ;;CGPT^Coag Management Physical Therapist
255 ;;CGPA^Coag Management Physician Assistant
256 ;;CGPH^Coag Management Pharmacist
257 ;;CGCC^Coag Management CC Team
258 ;;DESW^Dementia Social Worker
259 ;;DERN^Dementia Registered Nurse
260 ;;DENP^Dementia Nurse Practitioner
261 ;;DERD^Dementia Registered Dietician
262 ;;DEPT^Dementia Physical Therapist
263 ;;DEPA^Dementia Physician Assistant
264 ;;DEPH^Dementia Pharmacist
265 ;;DECC^Dementia CC Team
266 ;;DMSW^Diabetes Mellitus Social Worker
267 ;;DMRN^Diabetes Mellitus Registered Nurse
268 ;;DMNP^Diabetes Mellitus Nurse Practitioner
269 ;;DMRD^Diabetes Mellitus Registered Dietician
270 ;;DMPT^Diabetes Mellitus Physical Therapist
271 ;;DMPA^Diabetes Mellitus Physician Assistant
272 ;;DMPH^Diabetes Mellitus Pharmacist
273 ;;DMCC^Diabetes Mellitus CC Team
274 ;;HTSW^Hypertension Social Worker
275 ;;HTRN^Hypertension Registered Nurse
276 ;;HTNP^Hypertension Nurse Practitioner
277 ;;HTRD^Hypertension Registered Dietician
278 ;;HTPT^Hypertension Physical Therapist
279 ;;HTPA^Hypertension Physician Assistant
280 ;;HTPH^Hypertension Pharmacist
281 ;;HTCC^Hypertension CC Team
282 ;;IDSW^Infectious Disease Social Worker
283 ;;IDRN^Infectious Disease Registered Nurse
284 ;;IDNP^Infectious Disease Nurse Practitioner
285 ;;IDRD^Infectious Disease Registered Dietician
286 ;;IDPT^Infectious Disease Physical Therapist
287 ;;IDPA^Infectious Disease Physician Assistant
288 ;;IDPH^Infectious Disease Pharmacist
289 ;;IDCC^Infectious Disease CC Team
290 ;;MHSW^Mental Health Social Worker
291 ;;MHRN^Mental Health Registered Nurse
292 ;;MHNP^Mental Health Nurse Practitioner
293 ;;MHRD^Mental Health Registered Dietician
294 ;;MHPT^Mental Health Physical Therapist
295 ;;MHPA^Mental Health Physician Assistant
296 ;;MHPH^Mental Health Pharmacist
297 ;;MHCC^Mental Health CC Team
298 ;;MMSW^Multiple Co-Morbidities Social Worker
299 ;;MMRN^Multiple Co-Morbidities Registered Nurse
300 ;;MMNP^Multiple Co-Morbidities Nurse Practitioner
301 ;;MMRD^Multiple Co-Morbidities Registered Dietician
302 ;;MMPT^Multiple Co-Morbidities Physical Therapist
303 ;;MMPA^Multiple Co-Morbidities Physician Assistant
304 ;;MMPH^Multiple Co-Morbidities Pharmacist
305 ;;MMCC^Multiple Co-Morbidities CC Team
306 ;;PLSW^Palliative Social Worker
307 ;;PLRN^Palliative Registered Nurse
308 ;;PLNP^Palliative Nurse Practitioner
309 ;;PLRD^Palliative Registered Dietician
310 ;;PLPT^Palliative Physical Therapist
311 ;;PLPA^Palliative Physician Assistant
312 ;;PLPH^Palliative Pharmacist
313 ;;PLCC^Palliative CC Team
314 ;;PNSW^Pain Management Social Worker
315 ;;PNRN^Pain Management Registered Nurse
316 ;;PNNP^Pain Management Nurse Practitioner
317 ;;PNRD^Pain Management Registered Dietician
318 ;;PNPT^Pain Management Physical Therapist
319 ;;QUIT
Note: See TracBrowser for help on using the repository browser.