source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRFDSE.m@ 724

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

initial load of WorldVistAEHR

File size: 7.9 KB
Line 
1PXRRFDSE ;ISL/PKR - Sort through encounters applying the selection criteria. ;3/11/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,31,49**;Aug 12, 1996
3SORT ;
4 N BD,BUSY,CLASSIEN,CLASSNAM,CLINIC,CLINIEN,CSSCR,DOB,DFN,ED
5 N IC,FAC,FACILITY,FOUND
6 N HLOC,HLOCIEN,HLOCNAM,HSSCR,NEWPIEN
7 N PATSCR,PCLASS,PNAME,PPONLY,PRVIEN,PRVALL,PRVSCR
8 N RACEUNK,TEMP,VIEN,VISIT
9 ;
10 ;Allow the task to be cleaned up upon successful completion.
11 S ZTREQ="@"
12 ;
13 I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
14 ;
15 ;CSSCR is true if we want selected clinics.
16 I $G(NCS)>0 S CSSCR=1
17 E S CSSCR=0,CLINIC=0
18 ;
19 ;CLINIC is true if we want clinics instead of hospital locations.
20 I $P($G(PXRRLCSC),U,1)["C" S CLINIC=1
21 E S CLINIC=0
22 ;
23 ;HSSCR is true if we want selected hospital locations.
24 I $P($G(PXRRLCSC),U,1)="HS" S HSSCR=1
25 E S HSSCR=0
26 ;
27 ;HLOC is true if we want hospital locations.
28 I $P($G(PXRRLCSC),U,1)["H" S HLOC=1
29 E S HLOC=0
30 ;
31 ;PATSCR is true if we have a patient screen.
32 S PATSCR=0
33 I $D(PXRRDOB) D
34 . S PATSCR=1
35 .;If the starting or ending date of birth is not defined at this point
36 .;then we should not screen for them. So set them to values that will
37 .;always be true. Remember the test is DOBS <= DOB <= DOBE so that
38 .;DOBS corresponds to the maximum age and DOBE to the minimum age.
39 . I '$D(PXRRDOBS) S PXRRDOBS=0
40 . I '$D(PXRRDOBE) S PXRRDOBE=DT
41 I $D(PXRRRACE) D
42 . S PATSCR=1
43 .;Find the "UNKNOWN" race entry.
44 . N TRACE,TERR
45 . D FIND^DIC(10,"","","O","UNKNOWN",1,"B","","","TRACE","TERR")
46 . S RACEUNK=TRACE("DILIST",2,1)_U_TRACE("DILIST",1,1)
47 I $D(PXRRSEX) S PATSCR=1
48 ;
49 ;PRVSCR is true if we have a provider screen
50 I $D(PXRRPRSC) S PRVSCR=1
51 E S CLASSNAM=0,PRVSCR=0,PNAME=1
52 ;
53 ;If they are asking for all providers then we don't really need to
54 ; screen.
55 ;I PRVSCR I $P(PXRRPRSC,U,1)="A" S CLASSNAM=0,PRVSCR=0,PNAME=1
56 ;See if all providers were requested.
57 I PRVSCR I $P(PXRRPRSC,U,1)="A" S PRVALL=1
58 E S PRVALL=0
59 ;
60 ;PPONLY is true if we want primary providers only.
61 I PRVSCR I $P(PXRRPRSC,U,1)="P" S PPONLY=1
62 E S PPONLY=0
63 ;
64 ;Allow the task to be cleaned up upon successful completion.
65 S ZTREQ="@"
66 ;
67 S BD=PXRRBDT-.0001
68 S ED=PXRREDT+.2359
69NDATE S BD=$O(^AUPNVSIT("B",BD))
70 ;If we have passed the ending date we are done.
71 I (BD>ED)!(BD="") G DONE
72 ;
73 ;Check for a user request to stop the task.
74 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRFDD
75 ;
76 ;Get the VISIT IEN
77 S VIEN=0
78VISIT S VIEN=$O(^AUPNVSIT("B",BD,VIEN))
79 I VIEN="" G NDATE
80 S VISIT=^AUPNVSIT(VIEN,0)
81 ;
82 ;If this is an interactive session let the user know that something
83 ;is happening.
84 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
85 ;
86 ;Service category screen.
87 I $D(PXRRSCAT) I PXRRSCAT'[$P(VISIT,U,7) G VISIT
88 ;
89 ;Encounter type screen.
90 I $D(PXRRETYP) I PXRRETYP'[$P(VISIT,U,3) G VISIT
91 ;
92 ;Patient screen. If we have a patient screen then we need to make a
93 ;VADPT call to get the patient information.
94 I PATSCR D
95 . S DFN=$P(VISIT,U,5)
96 . D KVAR^VADPT
97 . D DEM^VADPT
98 ;
99 S FOUND=1
100 ;
101 ;Patient DOB screen.
102 I $D(PXRRDOB) D
103 . S DOB=$P(VADM(3),U,1)
104 . I (DOB<PXRRDOBS)!(DOB>PXRRDOBE) S FOUND=0
105 I 'FOUND G VISIT
106 ;
107 ;Patient RACE screen.
108 I $D(PXRRRACE) D
109 . S FOUND=0
110 . I VADM(8)="" S VADM(8)=RACEUNK
111 . F IC=1:1:NRACE Q:FOUND D
112 .. I PXRRRACE(IC)=VADM(8) S FOUND=1
113 I 'FOUND G VISIT
114 ;
115 ;Patient SEX screen.
116 I $D(PXRRSEX) D
117 . I PXRRSEX'=VADM(5) S FOUND=0
118 I 'FOUND G VISIT
119 ;
120 ;Make sure that the facility is on the list.
121 S FOUND=0
122 S FAC=$P(VISIT,U,6)
123 F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FAC D Q
124 . S FACILITY=FAC
125 . S FOUND=1
126 I 'FOUND G VISIT
127 ;
128 ;Provider screen.
129 S PRVIEN=0
130PRV ;To allow for encounters without a provider the check for a null PRVIEN
131 ;is made after everything else has been done.
132 I PRVIEN="" G VISIT
133 I PRVSCR D
134 . S PRVIEN=$O(^AUPNVPRV("AD",VIEN,PRVIEN))
135 . I $L(PRVIEN)>0 S NEWPIEN=$P(^AUPNVPRV(PRVIEN,0),U,1)
136 . E S NEWPIEN=0
137 . S (CLASSNAM,PNAME)=1
138 S FOUND=1
139 ;
140 ;All providers by name.
141 I PRVALL D
142 . S PNAME=$P($G(^VA(200,NEWPIEN,0)),U,1)
143 . I $L(PNAME)=0 S PNAME=1
144 . E S PNAME=PNAME_U_NEWPIEN
145 ;
146 ;List of providers.
147 I $D(PXRRPRPL) D
148 . S FOUND=0
149 . F IC=1:1:NPL I $P(PXRRPRPL(IC),U,2)=NEWPIEN D Q
150 ..;Mark this provider as being found.
151 .. S $P(PXRRPRPL(IC),U,4)="M"
152 .. S PNAME=$P(PXRRPRPL(IC),U,1,2)
153 .. S FOUND=1
154 ;
155 ;If we are storing provider names, i.e., PNAME'=1, then store the Person
156 ;Class alpha abbreviation as the third piece of PNAME.
157 I PNAME'=1 D
158 . S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1)
159 . S TEMP=$$ALPHA^PXRRPECU(PCLASS)
160 . S PNAME=PNAME_U_TEMP
161 I 'FOUND G PRV
162 ;
163 ;Person class screen.
164 I $D(PXRRPECL) D
165 . S CLASSNAM=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
166 . S FOUND=$$MATCH^PXRRPECU(CLASSNAM)
167 . I FOUND S CLASSNAM=$P(CLASSNAM,U,7)
168 I 'FOUND G PRV
169 ;
170 ;Primary Provider only.
171 I PPONLY D
172 . S FOUND=0
173 . I PRVIEN>0 D
174 .. I $P(^AUPNVPRV(PRVIEN,0),U,4)="P" S FOUND=1
175 I 'FOUND G PRV
176 ;
177 S HLOCNAM=1
178 ;By Clinic
179 I CLINIC D
180 . S CLINIEN=$P(VISIT,U,8)
181 . S TEMP=$S(+CLINIEN>0:^DIC(40.7,CLINIEN,0),1:"Unknown")
182 . S HLOCNAM=$P(TEMP,U,1)_U_CLINIEN_U_$P(TEMP,U,2)
183 ;Clinic screen.
184 I CSSCR D
185 . S FOUND=0
186 . F IC=1:1:NCS I $P(PXRRCS(IC),U,2)=CLINIEN D Q
187 ..;Mark the clinic as being matched.
188 .. S $P(PXRRCS(IC),U,4)="M"
189 .. S FOUND=1
190 I 'FOUND G VISIT
191 ;
192 ;By hospital location.
193 I HLOC D
194 . S HLOCIEN=$P(VISIT,U,22)
195 . I +HLOCIEN>0 D
196 .. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
197 .. S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
198 .. S TEMP=$S(+CLINIEN>0:^DIC(40.7,CLINIEN,0),1:"")
199 .. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN_U_$P(TEMP,U,2)
200 . E D
201 ..;No hospital location, see if we can at least find the clinic.
202 .. S HLOCNAM="Unknown"
203 .. S CLINIEN=$P(VISIT,U,8)
204 .. S TEMP=$S(+CLINIEN>0:^DIC(40.7,CLINIEN,0),1:"")
205 .. S HLOCNAM="Unknown"_U_U_$P(TEMP,U,2)
206 ;Hospital location screen.
207 I HSSCR D
208 . S FOUND=0
209 . F IC=1:1:NHL I $P(PXRRLCHL(IC),U,2)=HLOCIEN D Q
210 ..;Mark the hospital location as being matched.
211 .. S $P(PXRRLCHL(IC),U,4)="M"
212 .. S FOUND=1
213 I 'FOUND G VISIT
214 ;
215 ;At this point we have an encounter that can be added to the list.
216 S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,VIEN)=""
217 ;
218 ;Get the next encounter.
219 G VISIT
220 ;
221DONE ;
222 D KVAR^VADPT
223 I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
224 ;
225 ;If there were selected clinic stops build dummy entries for all
226 ;those without entries.
227 I $D(PXRRCS) D
228 . F FAC=1:1:NFAC D
229 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
230 .. F IC=1:1:NCS D
231 ... I $P(PXRRCS(IC),U,4)'="M" D
232 .... S PNAME=0
233 .... S CLASSNAM=0
234 .... S HLOCNAM=PXRRCS(IC)
235 .... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,0)=""
236 ;
237 ;If there were selected hospital locations build dummy entries for all
238 ;those without entries.
239 I $D(PXRRLCHL) D
240 . F FAC=1:1:NFAC D
241 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
242 .. F IC=1:1:NHL D
243 ... I $P(PXRRLCHL(IC),U,4)'="M" D
244 .... S PNAME=0
245 .... S CLASSNAM=0
246 .... S HLOCNAM=PXRRLCHL(IC)
247 .... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,0)=""
248 ;
249 ;If there were selected providers build dummy entries for all those
250 ;without encounters.
251 I $D(PXRRPRPL) D
252 . N CLASSLST,JC,NPCLASS
253 . F FAC=1:1:NFAC D
254 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
255 .. F IC=1:1:NPL D
256 ... I $P(PXRRPRPL(IC),U,4)'="M" D
257 .... S PNAME=$P(PXRRPRPL(IC),U,1,2)
258 .... S NEWPIEN=$P(PNAME,U,2)
259 ....;Get the person class list for this provider.
260 .... S NPCLASS=$$PCLLIST^PXRRPECU(NEWPIEN,PXRRBDT,PXRREDT,.CLASSLST)
261 .... F JC=1:1:NPCLASS D
262 ..... S TEMP=PNAME_U_CLASSLST(JC)
263 ..... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,TEMP,0,0)=""
264 ;
265 ;If there were person classes build dummy entries for all those
266 ;without entries.
267 I $D(PXRRPECL) D
268 . F FAC=1:1:NFAC D
269 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
270 .. F IC=1:1:NCL D
271 ... I $P(PXRRPECL(IC),U,4)'="M" D
272 .... S PNAME=0
273 .... S CLASSNAM=$P(PXRRPECL(IC),U,1,3)
274 .... S HLOCNAM=0
275 .... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,0)=""
276 ;
277EXIT ;
278 ;Run the next task in the series.
279 I PXRRQUE D
280 . N DESC,ROUTINE,TASK
281 . S DESC="Frequency of Diagnosis Report - sort diagnosis data"
282 . S ROUTINE="SORT^PXRRFDSD"
283 . S TASK=^XTMP(PXRRXTMP,"SORTDZTSK")
284 . S ZTDTH=$$NOW^XLFDT
285 . D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
286 E D SORT^PXRRFDSD
287 ;
288 Q
Note: See TracBrowser for help on using the repository browser.