source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXPXRMI1.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: 6.8 KB
Line 
1PXPXRMI1 ; SLC/PKR - Build indexes for the V files. ;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 ;===============================================================
6VCPT ;Build the indexes for V CPT.
7 N CPT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR,PP
8 N START,TEMP,TENP,TEXT,VISIT
9 ;Don't leave any old stuff around.
10 K ^PXRMINDX(9000010.18)
11 S GLOBAL=$$GET1^DID(9000010.18,"","","GLOBAL NAME")
12 S ENTRIES=$P(^AUPNVCPT(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 CPT")
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(^AUPNVCPT(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=^AUPNVCPT(DAS,0)
33 . S CPT=$P(TEMP,U,1)
34 . I CPT="" D Q
35 .. S ETEXT=DAS_" missing CPT"
36 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
37 . I '$D(^ICPT(CPT)) D Q
38 .. S ETEXT=DAS_" invalid CPT"
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 PP=$P(TEMP,U,7)
56 . I PP="" S PP="U"
57 . S NE=NE+1
58 . S ^PXRMINDX(9000010.18,"IPP",CPT,PP,DFN,DATE,DAS)=""
59 . S ^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,DAS)=""
60 S END=$H
61 S TEXT=NE_" V CPT results indexed."
62 D MES^XPDUTL(TEXT)
63 D DETIME^PXRMSXRM(START,END)
64 ;If there were errors send a message.
65 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
66 ;Send a MailMan message with the results.
67 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
68 S ^PXRMINDX(9000010.18,"GLOBAL NAME")=GLOBAL
69 S ^PXRMINDX(9000010.18,"BUILT BY")=DUZ
70 S ^PXRMINDX(9000010.18,"DATE BUILT")=$$NOW^XLFDT
71 Q
72 ;
73 ;===============================================================
74VHF ;Build the indexes for V HEALTH FACTORS.
75 N CAT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,HF,IND,NE,NERROR
76 N START,TEMP,TENP,TEXT,VISIT
77 ;Don't leave any old stuff around.
78 K ^PXRMINDX(9000010.23)
79 S GLOBAL=$$GET1^DID(9000010.23,"","","GLOBAL NAME")
80 S ENTRIES=$P(^AUPNVHF(0),U,4)
81 S TENP=ENTRIES/10
82 S TENP=+$P(TENP,".",1)
83 I TENP<1 S TENP=1
84 D BMES^XPDUTL("Building indexes for V HEALTH FACTORS")
85 S TEXT="There are "_ENTRIES_" entries to process."
86 D MES^XPDUTL(TEXT)
87 S START=$H
88 S (DAS,DONE,IND,NE,NERROR)=0
89 F S DAS=$O(^AUPNVHF(DAS)) Q:DONE D
90 . I +DAS=0 S DONE=1 Q
91 . I +DAS'=DAS D Q
92 .. S DONE=1
93 .. S ETEXT="Bad ien: "_DAS_", cannot continue."
94 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
95 . S IND=IND+1
96 . I IND#TENP=0 D
97 .. S TEXT="Processing entry "_IND
98 .. D MES^XPDUTL(TEXT)
99 . I IND#10000=0 W "."
100 . S TEMP=^AUPNVHF(DAS,0)
101 . S HF=$P(TEMP,U,1)
102 . I HF="" D Q
103 .. S ETEXT=DAS_" missing HF"
104 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
105 . I '$D(^AUTTHF(HF)) D Q
106 .. S ETEXT=DAS_" invalid HF"
107 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
108 . S DFN=$P(TEMP,U,2)
109 . I DFN="" D Q
110 .. S ETEXT=DAS_" missing DFN"
111 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
112 . S CAT=$P(^AUTTHF(HF,0),U,3)
113 . I CAT="" D Q
114 .. S ETEXT=DAS_" HF "_HF_" missing category"
115 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
116 . I HF=CAT D Q
117 .. S ETEXT=DAS_" HF "_HF_" is a category"
118 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
119 . S VISIT=$P(TEMP,U,3)
120 . I VISIT="" D Q
121 .. S ETEXT=DAS_" missing visit"
122 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
123 . I '$D(^AUPNVSIT(VISIT)) D Q
124 .. S ETEXT=DAS_" invalid visit"
125 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
126 . S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
127 . I DATE="" D Q
128 .. S ETEXT=DAS_" missing visit date"
129 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
130 . S NE=NE+1
131 . S ^PXRMINDX(9000010.23,"IP",HF,DFN,DATE,DAS)=""
132 . S ^PXRMINDX(9000010.23,"PI",DFN,HF,DATE,DAS)=""
133 S END=$H
134 S TEXT=NE_" V HEALTH FACTOR results indexed."
135 D MES^XPDUTL(TEXT)
136 D DETIME^PXRMSXRM(START,END)
137 ;If there were errors send a message.
138 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
139 ;Send a MailMan message with the results.
140 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
141 S ^PXRMINDX(9000010.23,"GLOBAL NAME")=GLOBAL
142 S ^PXRMINDX(9000010.23,"BUILT BY")=DUZ
143 S ^PXRMINDX(9000010.23,"DATE BUILT")=$$NOW^XLFDT
144 Q
145 ;
146 ;===============================================================
147VIMM ;Build the indexes for V IMMUNIZATION.
148 N DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IMM,IND,NE,NERROR
149 N START,TEMP,TENP,TEXT,VISIT
150 ;Don't leave any old stuff around.
151 K ^PXRMINDX(9000010.11)
152 S GLOBAL=$$GET1^DID(9000010.11,"","","GLOBAL NAME")
153 S ENTRIES=$P(^AUPNVIMM(0),U,4)
154 S TENP=ENTRIES/10
155 S TENP=+$P(TENP,".",1)
156 I TENP<1 S TENP=1
157 D BMES^XPDUTL("Building indexes for V IMMUNIZATION")
158 S TEXT="There are "_ENTRIES_" entries to process."
159 D MES^XPDUTL(TEXT)
160 S START=$H
161 S (DAS,DONE,IND,NE,NERROR)=0
162 F S DAS=$O(^AUPNVIMM(DAS)) Q:DONE D
163 . I +DAS=0 S DONE=1 Q
164 . I +DAS'=DAS D Q
165 .. S DONE=1
166 .. S ETEXT="Bad ien: "_DAS_", cannot continue."
167 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
168 . S IND=IND+1
169 . I IND#TENP=0 D
170 .. S TEXT="Processing entry "_IND
171 .. D MES^XPDUTL(TEXT)
172 . I IND#10000=0 W "."
173 . S TEMP=^AUPNVIMM(DAS,0)
174 . S IMM=$P(TEMP,U,1)
175 . I IMM="" D Q
176 .. S ETEXT=DAS_" missing immunization"
177 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
178 . I '$D(^AUTTIMM(IMM)) D Q
179 .. S ETEXT=DAS_" invalid immunization"
180 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
181 . S DFN=$P(TEMP,U,2)
182 . I DFN="" D Q
183 .. S ETEXT=DAS_" missing DFN"
184 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
185 . S VISIT=$P(TEMP,U,3)
186 . I VISIT="" D Q
187 .. S ETEXT=DAS_" missing visit"
188 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
189 . I '$D(^AUPNVSIT(VISIT)) D Q
190 .. S ETEXT=DAS_" invalid visit"
191 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
192 . S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
193 . I DATE="" D Q
194 .. S ETEXT=DAS_" missing visit date"
195 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
196 . S NE=NE+1
197 . S ^PXRMINDX(9000010.11,"IP",IMM,DFN,DATE,DAS)=""
198 . S ^PXRMINDX(9000010.11,"PI",DFN,IMM,DATE,DAS)=""
199 S END=$H
200 S TEXT=NE_" V IMMUNIZATION results indexed."
201 D MES^XPDUTL(TEXT)
202 D DETIME^PXRMSXRM(START,END)
203 ;If there were errors send a message.
204 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
205 ;Send a MailMan message with the results.
206 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
207 S ^PXRMINDX(9000010.11,"GLOBAL NAME")=GLOBAL
208 S ^PXRMINDX(9000010.11,"BUILT BY")=DUZ
209 S ^PXRMINDX(9000010.11,"DATE BUILT")=$$NOW^XLFDT
210 Q
211 ;
Note: See TracBrowser for help on using the repository browser.