source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTDDCR.m@ 1141

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

initial load of WorldVistAEHR

File size: 8.4 KB
RevLine 
[613]1DGPTDDCR ;SLC/PKR - Routines for setting and killing Clinical Reminder index. ;08/12/2004
2 ;;5.3;Registration;**478**;Aug 13, 1993
3 ;===========================================================
4INDEX ;Build the indexes for PTF.
5 N D1,DA,DAS,DATE,DFN,DIFF,END,ENTRIES,ETEXT,GLOBAL,HASCODES
6 N ICD0,ICD9,IND,JND,KND,NE0,NE9,NERROR,NODE,START
7 N TEMP0,TEMP70,TEMP71,TEMPP,TEMPS,TENP,TEXT,VISIT
8 ;DBIA 4114
9 ;Don't leave any old stuff around.
10 K ^PXRMINDX(45)
11 S GLOBAL=$$GET1^DID(45,"","","GLOBAL NAME")
12 S ENTRIES=$P(^DGPT(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 DGPT")
17 S TEXT="There are "_ENTRIES_" entries to process."
18 D MES^XPDUTL(TEXT)
19 S START=$H
20 S (DA,IND,NE0,NE9,NERROR)=0
21 F S DA=+$O(^DGPT(DA)) Q:DA=0 D
22 . S IND=IND+1
23 . I IND#TENP=0 D
24 .. S TEXT="Processing entry "_IND
25 .. D MES^XPDUTL(TEXT)
26 . I IND#10000=0 W "."
27 . S TEMP0=$G(^DGPT(DA,0))
28 .;Cenus records are not indexed.
29 . I $P(TEMP0,U,11)=2 Q
30 . S DFN=$P(TEMP0,U,1)
31 . I DFN="" D Q
32 .. S ETEXT=DA_" no patient"
33 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
34 . S D1=0
35 . F S D1=+$O(^DGPT(DA,"S",D1)) Q:D1=0 D
36 .. S TEMPS=$G(^DGPT(DA,"S",D1,0))
37 .. S DATE=$P(TEMPS,U,1)
38 .. I DATE="" D Q
39 ... S ETEXT=DA_" S node missing date"
40 ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
41 .. S DAS=DA_";S;"_D1_";0"
42 .. S KND=0
43 .. F JND=8,9,10,11,12 D
44 ... S KND=KND+1
45 ... S NODE="S"_KND
46 ... S ICD0=$P(TEMPS,U,JND)
47 ... I (ICD0'="") D
48 .... I $D(^ICD0(ICD0)) D
49 ..... S NE0=NE0+1
50 ..... S ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""
51 ..... S ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""
52 .... E D
53 ..... S ETEXT=DAS_" node "_NODE_" invalid ICD0"
54 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
55 .;
56 . S D1=0
57 . F S D1=+$O(^DGPT(DA,"P",D1)) Q:D1=0 D
58 .. S TEMPP=$G(^DGPT(DA,"P",D1,0))
59 .. S DATE=$P(TEMPP,U,1)
60 .. I DATE="" D Q
61 ... S ETEXT=DA_" P node missing date"
62 ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
63 .. S DAS=DA_";P;"_D1_";0"
64 .. S KND=0
65 .. F JND=5,6,7,8,9 D
66 ... S KND=KND+1
67 ... S NODE="P"_KND
68 ... S ICD0=$P(TEMPP,U,JND)
69 ... I (ICD0'="") D
70 .... I $D(^ICD0(ICD0)) D
71 ..... S NE0=NE0+1
72 ..... S ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""
73 ..... S ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""
74 .... E D
75 ..... S ETEXT=DAS_" "_NODE_" invalid ICD0"
76 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
77 .;
78 .;Discharge ICD9 codes
79 . I $D(^DGPT(DA,70)) D
80 .. S TEMP70=$G(^DGPT(DA,70))
81 .. S TEMP71=$G(^DGPT(DA,71))
82 .. S DATE=$P(TEMP70,U,1)
83 .. I DATE="" S DATE=$P(TEMP0,U,2)
84 .. S DAS=DA_";70"
85 .. S ICD9=$P(TEMP70,U,10)
86 .. I (ICD9'="") D
87 ... I $D(^ICD9(ICD9)) D
88 .... S NE9=NE9+1
89 .... S ^PXRMINDX(45,"ICD9","INP",ICD9,"DXLS",DFN,DATE,DAS)=""
90 .... S ^PXRMINDX(45,"ICD9","PNI",DFN,"DXLS",ICD9,DATE,DAS)=""
91 ... E D
92 .... S ETEXT=DAS_" DXLS invalid ICD9"
93 .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
94 ..;
95 .. S ICD9=$P(TEMP70,U,11)
96 .. I (ICD9'="") D
97 ... I $D(^ICD9(ICD9)) D
98 .... S NE9=NE9+1
99 .... S ^PXRMINDX(45,"ICD9","INP",ICD9,"PDX",DFN,DATE,DAS)=""
100 .... S ^PXRMINDX(45,"ICD9","PNI",DFN,"PDX",ICD9,DATE,DAS)=""
101 ... E D
102 .... S ETEXT=DAS_" PDX invalid ICD9"
103 .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
104 ..;
105 .. S KND=0
106 .. F JND=16,17,18,19,20,21,22,23,24 D
107 ... S KND=KND+1
108 ... S NODE="D SD"_KND
109 ... S ICD9=$P(TEMP70,U,JND)
110 ... I (ICD9'="") D
111 .... I $D(^ICD9(ICD9)) D
112 ..... S NE9=NE9+1
113 ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""
114 ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""
115 .... E D
116 ..... S ETEXT=DAS_" node "_NODE_" invalid ICD9"
117 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
118 ..;
119 .. S KND=9
120 .. F JND=1,2,3,4 D
121 ... S KND=KND+1
122 ... S NODE="D SD"_KND
123 ... S ICD9=$P(TEMP71,U,JND)
124 ... I (ICD9'="") D
125 .... I $D(^ICD9(ICD9)) D
126 ..... S NE9=NE9+1
127 ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""
128 ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""
129 .... E D
130 ..... S ETEXT=DAS_" node "_NODE_" invalid ICD9"
131 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
132 ..;
133 .;Movement ICD9 codes
134 . I '$D(^DGPT(DA,"M")) Q
135 . S D1=0
136 . F S D1=$O(^DGPT(DA,"M",D1)) Q:+D1=0 D
137 .. S TEMPS=$G(^DGPT(DA,"M",D1,0))
138 .. S DATE=$P(TEMPS,U,10)
139 .. I DATE="" D Q
140 ... S HASCODES=0
141 ... F JND=5,6,7,8,9,11,12,13,14,15 D
142 .... S ICD9=$P(TEMPS,U,JND)
143 .... I ICD9'="" S HASCODES=1
144 ... I HASCODES D
145 .... S ETEXT=DA_";M;"_D1_";0"_" M node missing date"
146 .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
147 .. S DAS=DA_";M;"_D1
148 .. S KND=0
149 .. F JND=5,6,7,8,9,11,12,13,14,15 D
150 ... S KND=KND+1
151 ... S NODE="M ICD"_KND
152 ... S ICD9=$P(TEMPS,U,JND)
153 ... I (ICD9'="") D
154 .... I $D(^ICD9(ICD9)) D
155 ..... S NE9=NE9+1
156 ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""
157 ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""
158 .... E D
159 ..... S ETEXT=DAS_" M node invalid ICD9"
160 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
161 .;
162 S END=$H
163 S TEXT=NE0_" PTF ICD0 results indexed."
164 D MES^XPDUTL(TEXT)
165 S TEXT=NE9_" PTF ICD9 results indexed."
166 D MES^XPDUTL(TEXT)
167 D DETIME^PXRMSXRM(START,END)
168 ;If there were errors send a message.
169 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
170 ;Send a MailMan message with the results.
171 D COMMSG^PXRMSXRM(GLOBAL,START,END,(NE0+NE9),NERROR)
172 S ^PXRMINDX(45,"GLOBAL NAME")=GLOBAL
173 S ^PXRMINDX(45,"BUILT BY")=DUZ
174 S ^PXRMINDX(45,"DATE BUILT")=$$NOW^XLFDT
175 Q
176 ;
177 ;===============================================================
178KDGPT0(X,DA,NODE,NUM) ;Delete index for PTF ICD0 data.
179 ;Census records are not indexed.
180 I $P(^DGPT(DA(1),0),U,11)=2 Q
181 N DAS,DFN,NNAME
182 S DFN=$P(^DGPT(DA(1),0),U,1)
183 S NNAME=NODE_NUM
184 S DAS=DA(1)_";"_NODE_";"_DA_";0"
185 ;DBIA 4114
186 K ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)
187 K ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)
188 Q
189 ;
190 ;===============================================================
191KDGPT9D(X,DA,NODE) ;Delete index for PTF discharge ICD9 data.
192 N DAS,DATE
193 ;Census records are not indexed.
194 I X(3)=2 Q
195 ;If there is no discharge date use the admission date.
196 S DATE=$S(X(5)'="":X(5),1:X(2))
197 S DAS=DA_";70"
198 ;DBIA 4114
199 K ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)
200 K ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)
201 Q
202 ;
203 ;===============================================================
204KDGPT9M(X,DA,NODE) ;Delete index for PTF movement ICD9 data.
205 ;Census records are not indexed.
206 I $P(^DGPT(DA(1),0),U,11)=2 Q
207 N DAS,DFN,TEMP
208 S TEMP=^DGPT(DA(1),0)
209 S DFN=$P(TEMP,U,1)
210 S DAS=DA(1)_";M;"_DA
211 ;DBIA 4114
212 K ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)
213 K ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)
214 Q
215 ;
216 ;===============================================================
217SDGPT0(X,DA,NODE,NUM) ;Set index for PTF ICD0 data.
218 ;For node 401 surgery node:
219 ;X(1)=SURGERY/PROCEDURE DATE, X(2)=ICD0
220 ;X(2) nodes: 45.01,8; 45.01,9; 45.01,10; 45.01,11; 45.01,12
221 ;For node 601, procedure node:
222 ;X(1)=PROCEDURE DATE, X(2)=ICD0
223 ;X(2) source nodes: 45.05,4; 45.05,5; 45.05,6; 45.05,7; 45.05,8
224 ;Census records are not indexed.
225 I $P(^DGPT(DA(1),0),U,11)=2 Q
226 N DAS,DFN,NNAME
227 S DFN=$P(^DGPT(DA(1),0),U,1)
228 S NNAME=NODE_NUM
229 S DAS=DA(1)_";"_NODE_";"_DA_";0"
230 ;DBIA 4114
231 S ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)=""
232 S ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)=""
233 Q
234 ;
235 ;===============================================================
236SDGPT9D(X,DA,NODE) ;Set index for PTF discharge ICD9 data.
237 ;X(1)=DFN, X(2)=ADMISSION DATE, X(3)=TYPE OF RECORD, X(4)=ICD9,
238 ;X(5)=DISCHARGE DATE
239 ;ICD9 from nodes: 45,79; 45,80; 45,79.16 45,79.17; 45,79.18;
240 ;45,79.19; 45,79.20; 45,79.21; 45,79.22; 45,79.22; 45.79.23;
241 ;45.79.24.
242 ;By name these nodes are: DXLS, PRINCIPAL DIAGNOSIS, SECONDARY
243 ;DIAGNOSIS 1 through SECONDARY DIAGNOSIS 13.
244 ;Census records are not indexed.
245 I X(3)=2 Q
246 N DAS,DATE
247 ;If there is no discharge date use the admission date.
248 S DATE=$S(X(5)'="":X(5),1:X(2))
249 S DAS=DA_";70"
250 ;DBIA 4114
251 S ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)=""
252 S ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)=""
253 Q
254 ;
255 ;===============================================================
256SDGPT9M(X,DA,NODE) ;Set index for PTF movement ICD9 data.
257 ;X(1)=MOVEMENT DATE, X(3)=TYPE OF RECORD, X(3)=ICD9
258 ;ICD9 from nodes: 45.02,5 45.02,6, 45.02,7 45.02,8 45.02,9
259 ;45.02,11 45.02,12 45.02,13 45.02,14 45.02,15
260 ;By name these nodes are: ICD 1, through ICD 10.
261 ;Census records are not indexed.
262 I $P(^DGPT(DA(1),0),U,11)=2 Q
263 N DAS,DFN,TEMP
264 S TEMP=^DGPT(DA(1),0)
265 S DFN=$P(TEMP,U,1)
266 S DAS=DA(1)_";M;"_DA
267 ;DBIA 4114
268 S ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)=""
269 S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)=""
270 Q
271 ;
Note: See TracBrowser for help on using the repository browser.