source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXPXRMI2.m@ 1671

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1PXPXRMI2 ; SLC/PKR - Build indexes for the V files (continued). ;06/17/2003
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**119**;Aug 12, 1996
3 ;DBIA 4113 supports PXRMSXRM entry points.
4 ;DBIA 4114 supports setting and killing ^PXRMINDX
5 ;===============================================================
6VPED ;Build the indexes for V PATIENT ED.
7 N DAS,DATE,DFN,DIFF,DONE,EDU,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR
8 N START,TEMP,TENP,TEXT,VISIT
9 ;Don't leave any old stuff around.
10 K ^PXRMINDX(9000010.16)
11 S GLOBAL=$$GET1^DID(9000010.16,"","","GLOBAL NAME")
12 S ENTRIES=$P(^AUPNVPED(0),U,4)
13 S TENP=ENTRIES/10
14 S TENP=+$P(TENP,".",1)
15 I TENP<1 S TENP=1
16 D BMES^XPDUTL("Building indexes for V PATIENT ED")
17 S TEXT="There are "_ENTRIES_" entries to process."
18 D MES^XPDUTL(TEXT)
19 S START=$H
20 S (DAS,DONE,IND,NE,NERROR)=0
21 F S DAS=$O(^AUPNVPED(DAS)) Q:DONE D
22 . I +DAS=0 S DONE=1 Q
23 . I +DAS'=DAS D Q
24 .. S DONE=1
25 .. S ETEXT="Bad ien: "_DAS_", cannot continue."
26 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
27 . S IND=IND+1
28 . I IND#TENP=0 D
29 .. S TEXT="Processing entry "_IND
30 .. D MES^XPDUTL(TEXT)
31 . I IND#10000=0 W "."
32 . S TEMP=^AUPNVPED(DAS,0)
33 . S EDU=$P(TEMP,U,1)
34 . I EDU="" D Q
35 .. S ETEXT=DAS_" missing education topic"
36 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
37 . I '$D(^AUTTEDT(EDU)) D Q
38 .. S ETEXT=DAS_" invalid education topic"
39 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
40 . S DFN=$P(TEMP,U,2)
41 . I DFN="" D Q
42 .. S ETEXT=DAS_" missing DFN"
43 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
44 . S VISIT=$P(TEMP,U,3)
45 . I VISIT="" D Q
46 .. S ETEXT=DAS_" missing visit"
47 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
48 . I '$D(^AUPNVSIT(VISIT)) D Q
49 .. S ETEXT=DAS_" invalid visit"
50 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
51 . S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
52 . I DATE="" D Q
53 .. S ETEXT=DAS_" missing visit date"
54 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
55 . S NE=NE+1
56 . S ^PXRMINDX(9000010.16,"IP",EDU,DFN,DATE,DAS)=""
57 . S ^PXRMINDX(9000010.16,"PI",DFN,EDU,DATE,DAS)=""
58 S END=$H
59 S TEXT=NE_" V PATIENT ED results indexed."
60 D MES^XPDUTL(TEXT)
61 D DETIME^PXRMSXRM(START,END)
62 ;If there were errors send a message.
63 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
64 ;Send a MailMan message with the results.
65 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
66 S ^PXRMINDX(9000010.16,"GLOBAL NAME")=GLOBAL
67 S ^PXRMINDX(9000010.16,"BUILT BY")=DUZ
68 S ^PXRMINDX(9000010.16,"DATE BUILT")=$$NOW^XLFDT
69 Q
70 ;
71 ;===============================================================
72VPOV ;Build the indexes for V POV.
73 N DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR,POV,PS
74 N START,TEMP,TENP,TEXT,VISIT
75 ;Don't leave any old stuff around.
76 K ^PXRMINDX(9000010.07)
77 S GLOBAL=$$GET1^DID(9000010.07,"","","GLOBAL NAME")
78 S ENTRIES=$P(^AUPNVPOV(0),U,4)
79 S TENP=ENTRIES/10
80 S TENP=+$P(TENP,".",1)
81 I TENP<1 S TENP=1
82 D BMES^XPDUTL("Building indexes for V POV")
83 S TEXT="There are "_ENTRIES_" entries to process."
84 D MES^XPDUTL(TEXT)
85 S START=$H
86 S (DAS,DONE,IND,NE,NERROR)=0
87 F S DAS=$O(^AUPNVPOV(DAS)) Q:DONE D
88 . I +DAS=0 S DONE=1 Q
89 . I +DAS'=DAS D Q
90 .. S DONE=1
91 .. S ETEXT="Bad ien: "_DAS_", cannot continue."
92 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
93 . S IND=IND+1
94 . I IND#TENP=0 D
95 .. S TEXT="Processing entry "_IND
96 .. D MES^XPDUTL(TEXT)
97 . I IND#10000=0 W "."
98 . S TEMP=^AUPNVPOV(DAS,0)
99 . S POV=$P(TEMP,U,1)
100 . I POV="" D Q
101 .. S ETEXT=DAS_" missing POV (ICD9)"
102 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
103 . I '$D(^ICD9(POV)) D Q
104 .. S ETEXT=DAS_" invalid ICD9"
105 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
106 . S DFN=$P(TEMP,U,2)
107 . I DFN="" D Q
108 .. S ETEXT=DAS_" missing DFN"
109 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
110 . S VISIT=$P(TEMP,U,3)
111 . I VISIT="" D Q
112 .. S ETEXT=DAS_" missing visit"
113 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
114 . I '$D(^AUPNVSIT(VISIT)) D Q
115 .. S ETEXT=DAS_" invalid visit"
116 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
117 . S PS=$P(TEMP,U,12)
118 . I PS="" S PS="U"
119 . S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
120 . I DATE="" D Q
121 .. S ETEXT=DAS_" missing visit date"
122 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
123 . S NE=NE+1
124 . S ^PXRMINDX(9000010.07,"IPP",POV,PS,DFN,DATE,DAS)=""
125 . S ^PXRMINDX(9000010.07,"PPI",DFN,PS,POV,DATE,DAS)=""
126 S END=$H
127 S TEXT=NE_" V POV results indexed."
128 D MES^XPDUTL(TEXT)
129 D DETIME^PXRMSXRM(START,END)
130 ;If there were errors send a message.
131 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
132 ;Send a MailMan message with the results.
133 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
134 S ^PXRMINDX(9000010.07,"GLOBAL NAME")=GLOBAL
135 S ^PXRMINDX(9000010.07,"BUILT BY")=DUZ
136 S ^PXRMINDX(9000010.07,"DATE BUILT")=$$NOW^XLFDT
137 Q
138 ;
139 ;===============================================================
140VSK ;Build the indexes for V SKIN TEST.
141 N DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,GLOBAL,IND,NE,NERROR
142 N SK,START,TEMP,TENP,TEXT,VISIT
143 ;Don't leave any old stuff around.
144 K ^PXRMINDX(9000010.12)
145 S GLOBAL=$$GET1^DID(9000010.12,"","","GLOBAL NAME")
146 S ENTRIES=$P(^AUPNVSK(0),U,4)
147 S TENP=ENTRIES/10
148 S TENP=+$P(TENP,".",1)
149 I TENP<1 S TENP=1
150 D BMES^XPDUTL("Building indexes for V SKIN TEST")
151 S TEXT="There are "_ENTRIES_" entries to process."
152 D MES^XPDUTL(TEXT)
153 S START=$H
154 S (DAS,DONE,IND,NE,NERROR)=0
155 F S DAS=$O(^AUPNVSK(DAS)) Q:DONE D
156 . I +DAS=0 S DONE=1 Q
157 . I +DAS'=DAS D Q
158 .. S DONE=1
159 .. S ETEXT="Bad ien: "_DAS_", cannot continue."
160 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
161 . S IND=IND+1
162 . I IND#TENP=0 D
163 .. S TEXT="Processing entry "_IND
164 .. D MES^XPDUTL(TEXT)
165 . I IND#10000=0 W "."
166 . S TEMP=^AUPNVSK(DAS,0)
167 . S SK=$P(TEMP,U,1)
168 . I SK="" D Q
169 .. S ETEXT=DAS_" missing skin test"
170 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
171 . I '$D(^AUTTSK(SK)) D Q
172 .. S ETEXT=DAS_" invalid skin test"
173 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
174 . S DFN=$P(TEMP,U,2)
175 . I DFN="" D Q
176 .. S ETEXT=DAS_" missing DFN"
177 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
178 . S VISIT=$P(TEMP,U,3)
179 . I VISIT="" D Q
180 .. S ETEXT=DAS_" missing visit"
181 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
182 . I '$D(^AUPNVSIT(VISIT)) D Q
183 .. S ETEXT=DAS_" invalid visit"
184 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
185 . S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
186 . I DATE="" D Q
187 .. S ETEXT=DAS_" missing visit date"
188 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
189 . S NE=NE+1
190 . S ^PXRMINDX(9000010.12,"IP",SK,DFN,DATE,DAS)=""
191 . S ^PXRMINDX(9000010.12,"PI",DFN,SK,DATE,DAS)=""
192 S END=$H
193 S TEXT=NE_" V SKIN TEST results indexed."
194 D MES^XPDUTL(TEXT)
195 D DETIME^PXRMSXRM(START,END)
196 ;If there were errors send a message.
197 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
198 ;Send a MailMan message with the results.
199 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
200 S ^PXRMINDX(9000010.12,"GLOBAL NAME")=GLOBAL
201 S ^PXRMINDX(9000010.12,"BUILT BY")=DUZ
202 S ^PXRMINDX(9000010.12,"DATE BUILT")=$$NOW^XLFDT
203 Q
204 ;
205 ;===============================================================
206VXAM ;Build the indexes for V EXAM.
207 N DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,EXAM,GLOBAL,IND,NE,NERROR
208 N START,TEMP,TENP,TEXT,VISIT
209 ;Don't leave any old stuff around.
210 K ^PXRMINDX(9000010.13)
211 S GLOBAL=$$GET1^DID(9000010.13,"","","GLOBAL NAME")
212 S ENTRIES=$P(^AUPNVXAM(0),U,4)
213 S TENP=ENTRIES/10
214 S TENP=+$P(TENP,".",1)
215 I TENP<1 S TENP=1
216 D BMES^XPDUTL("Building indexes for V EXAM")
217 S TEXT="There are "_ENTRIES_" entries to process."
218 D MES^XPDUTL(TEXT)
219 S START=$H
220 S (DAS,DONE,IND,NE,NERROR)=0
221 F S DAS=$O(^AUPNVXAM(DAS)) Q:DONE D
222 . I +DAS=0 S DONE=1 Q
223 . I +DAS'=DAS D Q
224 .. S DONE=1
225 .. S ETEXT="Bad ien: "_DAS_", cannot continue."
226 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
227 . S IND=IND+1
228 . I IND#TENP=0 D
229 .. S TEXT="Processing entry "_IND
230 .. D MES^XPDUTL(TEXT)
231 . I IND#10000=0 W "."
232 . S TEMP=^AUPNVXAM(DAS,0)
233 . S EXAM=$P(TEMP,U,1)
234 . I EXAM="" D Q
235 .. S ETEXT=DAS_" missing exam"
236 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
237 . I '$D(^AUTTEXAM(EXAM)) D Q
238 .. S ETEXT=DAS_" invalid exam"
239 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
240 . S DFN=$P(TEMP,U,2)
241 . I DFN="" D Q
242 .. S ETEXT=DAS_" missing DFN"
243 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
244 . S VISIT=$P(TEMP,U,3)
245 . I VISIT="" D Q
246 .. S ETEXT=DAS_" missing visit"
247 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
248 . I '$D(^AUPNVSIT(VISIT)) D Q
249 .. S ETEXT=DAS_" invalid visit"
250 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
251 . S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
252 . I DATE="" D Q
253 .. S ETEXT=DAS_" missing visit date"
254 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
255 . S NE=NE+1
256 . S ^PXRMINDX(9000010.13,"IP",EXAM,DFN,DATE,DAS)=""
257 . S ^PXRMINDX(9000010.13,"PI",DFN,EXAM,DATE,DAS)=""
258 S END=$H
259 S TEXT=NE_" V EXAM results indexed."
260 D MES^XPDUTL(TEXT)
261 D DETIME^PXRMSXRM(START,END)
262 ;If there were errors send a message.
263 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
264 ;Send a MailMan message with the results.
265 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
266 S ^PXRMINDX(9000010.13,"GLOBAL NAME")=GLOBAL
267 S ^PXRMINDX(9000010.13,"BUILT BY")=DUZ
268 S ^PXRMINDX(9000010.13,"DATE BUILT")=$$NOW^XLFDT
269 Q
270 ;
Note: See TracBrowser for help on using the repository browser.