source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRPAPI.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.8 KB
Line 
1PXRRPAPI ;ISL/PKR - Build the patient specific info for each patient on the list. ;6/27/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**18,121,165**;Aug 12, 1996
3 ;
4PAT ;
5 N ACTIVITY,BACDATE,BD,BUSY,DATE,DFN,EACDATE,ED,ERIEN,ERR
6 N IC,IEN,JC,FACIEN,FACNAM
7 N HLOCIEN,HLOCNAM,LABTEST,LOCIEN,LRDFN,NERM
8 N PNAME,SPEC,SSN,SSNF,UNITS
9 N TEMP
10 ;
11 ;Allow the task to be cleaned up upon successful completion.
12 S ZTREQ="@"
13 ;
14 S BACDATE=PXRRBCDT-.0001
15 S EACDATE=PXRRECDT+.2359
16 ;
17 ;Build a list of emergency room iens, get list from PCE parameter file.
18 S NERM=0
19 S IC=0
20 F S IC=$O(^PX(815,IC)) Q:+IC=0 D
21 . S JC=0
22 . F S JC=$O(^PX(815,IC,"RR1",JC)) Q:+JC=0 D
23 .. S NERM=NERM+1
24 .. S TEMP=^PX(815,IC,"RR1",JC,0)
25 .. S ERIEN(NERM)=TEMP_U_$P(^SC(TEMP,0),U,1)
26 ;
27 I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
28 ;
29 S FACIEN=""
30NFAC1 S FACIEN=$O(^XTMP(PXRRXTMP,"APPT",FACIEN))
31 I +FACIEN=0 G DONE
32 ;
33 S HLOCIEN=""
34NHLOC1 S HLOCIEN=$O(^XTMP(PXRRXTMP,"APPT",FACIEN,HLOCIEN))
35 I +HLOCIEN=0 G NFAC1
36 ;
37 ;Check for a user request to stop the task.
38 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
39 ;
40 S DFN=0
41NPAT S DFN=$O(^XTMP(PXRRXTMP,"APPT",FACIEN,HLOCIEN,DFN))
42 I +DFN=0 G NHLOC1
43 S ACTIVITY=0
44 ;
45 ;If this is an interactive session let the user know that something
46 ;is happening.
47 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting patient information",.BUSY)
48 ;
49 ;Emergency room visits.
50 I NERM>0 D
51 . S BD=BACDATE
52 . S ED=EACDATE
53 . F S BD=$O(^AUPNVSIT("AET",DFN,BD)) Q:((BD>EACDATE)!(BD="")) D
54 .. S LOCIEN=""
55 .. F S LOCIEN=$O(^AUPNVSIT("AET",DFN,BD,LOCIEN)) Q:LOCIEN="" D
56 ... F IC=1:1:NERM D
57 .... I $P(ERIEN(IC),U,1)=LOCIEN D
58 ..... S ^TMP(PXRRXTMP,$J,"ER",DFN,BD)=ERIEN(IC)
59 . I $D(^TMP(PXRRXTMP,$J,"ER",DFN)) S ACTIVITY=1
60 ;
61 ;Build a list of future appointments.
62 D KVA^VADPT
63 S VASD("F")=PXRRBFDT
64 S VASD("T")=PXRREFDT
65 D SDA^VADPT
66 S IC=0
67 F S IC=$O(^UTILITY("VASD",$J,IC)) Q:+IC=0 D
68 . S ^TMP(PXRRXTMP,$J,"FUT",DFN,IC)=^UTILITY("VASD",$J,IC,"E")
69 K ^UTILITY("VASD",$J)
70 D KVA^VADPT
71 I $D(^TMP(PXRRXTMP,$J,"FUT",DFN)) S ACTIVITY=1
72 ;
73 ;Save all admissions and discharges in the date range.
74 ;We will need a DBIA to use the cross-ref. Numerous similar
75 ;ones are already in place, i.e., DBIA244-D, DBIA325-B, DBIA966, DBIA1358.
76 S BD=BACDATE
77 S ED=EACDATE
78NADM S BD=$O(^DGPM("APTT1",DFN,BD))
79 ;If we have passed the ending date we are done.
80 I (BD>ED)!(BD="") G DIS
81 S IEN=$O(^DGPM("APTT1",DFN,BD,""))
82 S ^TMP(PXRRXTMP,$J,"ADM",DFN,BD,IEN)=""
83 G NADM
84 I $D(^TMP(PXRRXTMP,$J,"ADM",DFN)) S ACTIVITY=1
85 ;
86DIS S BD=BACDATE
87 S ED=EACDATE
88NDIS S BD=$O(^DGPM("APTT3",DFN,BD))
89 ;If we have passed the ending date we are done.
90 I (BD>ED)!(BD="") G CLAB
91 S IEN=$O(^DGPM("APTT3",DFN,BD,""))
92 S ^TMP(PXRRXTMP,$J,"DIS",DFN,BD,IEN)=""
93 G NDIS
94 I $D(^TMP(PXRRXTMP,$J,"DIS",DFN)) S ACTIVITY=1
95 ;
96 ;Get critical lab values.
97 ;This will probably require a DBIA to read DPT.
98 ;We will need a DBIA to look at lab stuff.
99CLAB S LRDFN=$G(^DPT(DFN,"LR"))
100 I LRDFN="" G SAVPAT
101 S ED=$$FMDFINVL(BACDATE,0)
102 S BD=$$FMDFINVL(EACDATE,0)
103NLAB S BD=$O(^LR(LRDFN,"CH",BD))
104 ;If we have passed the ending date we are done.
105 I (BD>ED)!(BD="") G SAVPAT
106 S IC=0
107 F S IC=$O(^LR(LRDFN,"CH",BD,IC)) Q:+IC=0 D
108 . S TEMP=$G(^LR(LRDFN,"CH",BD,IC))
109 . I $P(TEMP,U,2)["*" D
110 .. D FIELD^DID(63.04,IC,"","LABEL","LABTEST","ERR")
111 ..;Try to get the units.
112 .. S SPEC=$P(^LR(LRDFN,"CH",BD,0),U,5)
113 .. S JC=$O(^LAB(60,"C","CH;"_IC_";1",""))
114 .. S UNITS=$P($G(^LAB(60,JC,1,SPEC,0)),U,7)
115 .. S ^TMP(PXRRXTMP,$J,"CLAB",DFN,BD,IC)=LABTEST("LABEL")_U_TEMP_U_UNITS
116 G NLAB
117 I $D(^TMP(PXRRXTMP,$J,"CLAB",DFN)) S ACTIVITY=1
118 ;
119SAVPAT ;Save the patient data in XTMP in a format suitable for printing.
120 ;We only want those patients that had some activity.
121 I 'ACTIVITY G NPAT
122 S TEMP=$G(^DPT(DFN,0))
123 S PNAME=$P(TEMP,U,1)
124 S SSN=$P(TEMP,U,9)
125 S FACNAM=PXRRFACN(FACIEN)_U_FACIEN
126 S HLOCNAM=$P($G(^SC(HLOCIEN,0)),U,1)
127 S ^XTMP(PXRRXTMP,"ALPHA",FACNAM,HLOCNAM_U_HLOCIEN,PNAME,SSN)=DFN
128 D KVA^VADPT
129 D ADD^VADPT
130 S SSNF=$$SSNFORM(SSN)
131 S ^XTMP(PXRRXTMP,"PATIENT",DFN)=SSNF_U_VAPA(1)_U_VAPA(2)_U_VAPA(3)_U_VAPA(4)_U_VAPA(5)_U_VAPA(6)_U_VAPA(8)
132 D KVA^VADPT
133 ;
134 ;Appointment data.
135 S IC=0
136 F S IC=$O(^XTMP(PXRRXTMP,"APPT",FACIEN,HLOCIEN,DFN,IC)) Q:+IC=0 D
137 . S ^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"APPT",IC)=^XTMP(PXRRXTMP,"APPT",FACIEN,HLOCIEN,DFN,IC)
138 ;
139 ;Process admission data, build a complete entry including discharge
140 ;date, last treating specialty, last provider, admitting diagnosis.
141 S IC=0
142 F S IC=$O(^TMP(PXRRXTMP,$J,"ADM",DFN,IC)) Q:+IC=0 D
143 . S IEN=$O(^TMP(PXRRXTMP,$J,"ADM",DFN,IC,""))
144 . D ADMISS(DFN,IC,IEN)
145 ;
146 ;Process discharge admission data, build a complete entry just as for
147 ;admissions above. Match the discharge to the admission, avoiding
148 ;duplicate entries.
149 S IC=0
150 F S IC=$O(^TMP(PXRRXTMP,$J,"DIS",DFN,IC)) Q:+IC=0 D
151 . S IEN=$O(^TMP(PXRRXTMP,$J,"DIS",DFN,IC,""))
152 . D DISCHRG(DFN,IC,IEN)
153 ;
154 ;Look for any current inpatient data whose admission we may have
155 ;missed.
156 I '$D(^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"ADMDIS")) D
157 . D KVA^VADPT
158 . D IN5^VADPT
159 . I $L(VAIP(13))>0 D
160 .. S DATE=$P(VAIP(13,1),U,1)
161 ..;The admission date must be less than the beginning activity date
162 ..;in order for the patient to be an inpatient during the activity
163 ..;date range.
164 .. I DATE<PXRRBCDT D
165 ...;Ward
166 ... S TEMP=$P(VAIP(14,4),U,2)
167 ...;Last treating specialty
168 ... S TEMP=TEMP_U_$P(VAIP(14,6),U,2)
169 ... ;Last provider
170 ... S TEMP=TEMP_U_$P(VAIP(14,5),U,2)
171 ...;Admitting diagnosis
172 ... S TEMP=TEMP_U_VAIP(13,7)
173 ... S DISDATE=DT+1
174 ... S ^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"ADMDIS",DATE,DISDATE)=TEMP
175 ;
176 ;Critical lab data.
177 S IC=0
178 F S IC=$O(^TMP(PXRRXTMP,$J,"CLAB",DFN,IC)) Q:+IC=0 D
179 . S TEMP=$$FMDFINVL(IC,1)
180 . S JC=0
181 . F S JC=$O(^TMP(PXRRXTMP,$J,"CLAB",DFN,IC,JC)) Q:+JC=0 D
182 .. S ^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"CLAB",TEMP,JC)=^TMP(PXRRXTMP,$J,"CLAB",DFN,IC,JC)
183 ;
184 ;Emergency room visits.
185 S IC=0
186 F S IC=$O(^TMP(PXRRXTMP,$J,"ER",DFN,IC)) Q:+IC=0 D
187 . S ^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"ER",IC)=^TMP(PXRRXTMP,$J,"ER",DFN,IC)
188 ;
189 ;Future appointments.
190 S IC=0
191 F S IC=$O(^TMP(PXRRXTMP,$J,"FUT",DFN,IC)) Q:+IC=0 D
192 . S ^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"FUT",IC)=^TMP(PXRRXTMP,$J,"FUT",DFN,IC)
193 ;
194 G NPAT
195DONE ;
196 I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
197 ;
198EXIT ;
199 K ^TMP(PXRRXTMP)
200 ;
201 ;Print the report.
202 I PXRRQUE D
203 .;Start the report that was queued but not scheduled.
204 . N DESC,ROUTINE,TASK
205 . S DESC="Patient Activity Report - print"
206 . S ROUTINE="PXRRPAPR"
207 . S ZTDTH=$$NOW^XLFDT
208 . S TASK=^XTMP(PXRRXTMP,"PRZTSK")
209 . D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
210 E D ^PXRRPAPR
211 Q
212 ;
213 ;=======================================================================
214ADMISS(DFN,DATE,IEN) ;Given a patient and an admission date find the
215 ;associated discharge, if any. Save the other information listed
216 ;below.
217 N DISDATE,TEMP
218 D KVA^VADPT
219 S VAIP("D")=DATE
220 S VAIP("E")=IEN
221 S VAIP("M")=0
222 D IN5^VADPT
223 ;Store the information in TEMP in printing order.
224 ;Ward
225 S TEMP=$P(VAIP(14,4),U,2)
226 ;Last treating specialty
227 S TEMP=TEMP_U_$P(VAIP(14,6),U,2)
228 ;Last provider
229 S TEMP=TEMP_U_$P(VAIP(14,5),U,2)
230 ;Admitting diagnosis
231 S TEMP=TEMP_U_VAIP(13,7)
232 I $L(VAIP(17))>0 D
233 . S DISDATE=$P(VAIP(17,1),U,1)
234 E D
235 . S DISDATE=DT+1
236 S ^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"ADMDIS",DATE,DISDATE)=TEMP
237 ;
238ADMDONE ;
239 D KVA^VADPT
240 Q
241 ;
242 ;=======================================================================
243DISCHRG(DFN,DATE,IEN) ;Given a patient and a discharge date find the
244 ;associated admission. Determine if the combined admission-discharge
245 ;data has already been stored. If it has quit otherwise store it.
246 N ADMDATE,ICD9IEN,TEMP
247 D KVA^VADPT
248 S VAIP("D")=$P(DATE,".",1)
249 S VAIP("E")=IEN
250 S VAIP("M")=0
251 D IN5^VADPT
252 S ADMDATE=$P(VAIP(13,1),U,1)
253 I ADMDATE="" S ADMDATE=DATE_"NA"
254 I $D(^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"ADMDIS",ADMDATE,DATE)) G DISDONE
255 ;Information is not already there, store the data.
256 ;Ward
257 S TEMP=""
258 ;Last treating specialty
259 S TEMP=TEMP_U_$P(VAIP(17,6),U,2)
260 ;Last provider
261 S TEMP=TEMP_U_$P(VAIP(17,5),U,2)
262 ;Admitting diagnosis
263 S TEMP=TEMP_U_VAIP(13,7)
264 ;Will need a DBIA for these reads.
265 ;Try to get DXLS
266 I +VAIP(12)>0 S ICD9IEN=$P($G(^DGPT(VAIP(12),70)),U,10)
267 ;I +$G(ICD9IEN)>0 S TEMP=TEMP_U_$P(^ICD9(ICD9IEN,0),U,3)
268 I +$G(ICD9IEN)>0 S TEMP=TEMP_U_$P($$ICDDX^ICDCODE(ICD9IEN),U,4)
269 ;
270 S ^XTMP(PXRRXTMP,FACIEN,HLOCIEN,DFN,"ADMDIS",ADMDATE,DATE)=TEMP
271DISDONE ;
272 D KVA^VADPT
273 Q
274 ;
275 ;=======================================================================
276SSNFORM(SSN) ;Format the social security number with dashes.
277 N FSSN,TEMP
278 S TEMP=$E(SSN,1,3)
279 S FSSN=TEMP_"-"
280 S TEMP=$E(SSN,4,5)
281 S FSSN=FSSN_TEMP_"-"
282 S TEMP=$E(SSN,6,9)
283 S FSSN=FSSN_TEMP
284 Q FSSN
285 ;
286 ;=======================================================================
287FMDFINVL(INVDT,DATE) ;Convert an inverse date (LABORATORY format
288 ;9999999-date) to Fileman format.
289 I $L(INVDT)=0 Q INVDT
290 N TEMP
291 S TEMP=9999999-INVDT
292 ;If DATE is TRUE return only the date portion.
293 I DATE S TEMP=$P(TEMP,".",1)
294 Q TEMP
295 ;
Note: See TracBrowser for help on using the repository browser.