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

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

initial load of WorldVistAEHR

File size: 6.6 KB
RevLine 
[613]1PXRRECSE ;ISL/PKR - Sort through encounters applying the selection criteria. ;6/27/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,72**;Aug 12, 1996
3SORT ;
4 N BD,BUSY,CLASSNAM,CLINIC,CLINIEN,CSSCR
5 N ED,IC,FAC,FACILITY,FOUND
6 N HLOCIEN,HLOCNAM,HLOCMAX,HSSCR,NEWPIEN
7 N PCLMAX,PCLASS,PNAME,PNMAX,PPNAME,PPONLY,PRVCNT,PRVIEN
8 N TEMP,VACODE,VIEN,VISIT
9 ;
10 S (HLOCMAX,PCLMAX,PNMAX)=0
11 ;
12 I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
13 ;
14 ;CSSCR is true if we want selected clinics.
15 I $P($G(PXRRLCSC),U,1)="CS" S CSSCR=1
16 E S CSSCR=0
17 ;
18 ;CLINIC is true if we want clinics instead of hospital locations.
19 I $P($G(PXRRLCSC),U,1)["C" S CLINIC=1
20 E S CLINIC=0
21 ;
22 ;HSSCR is true if we want selected hospital locations.
23 I $P($G(PXRRLCSC),U,1)="HS" S HSSCR=1
24 E S HSSCR=0
25 ;
26 ;PPONLY is true if we want primary providers only.
27 I $P($G(PXRRPRSC),U,1)="P" S PPONLY=1
28 E S PPONLY=0
29 ;
30 ;Allow the task to be cleaned up upon successful completion.
31 S ZTREQ="@"
32 ;
33 S BD=PXRRBDT-.0001
34 S ED=PXRREDT+.2359
35NDATE S BD=$O(^AUPNVSIT("B",BD))
36 ;If we have passed the ending date we are done.
37 I (BD>ED)!(BD="") G DONE
38 ;
39 ;If this is an interactive session let the user know that something
40 ;is happening.
41 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
42 ;
43 ;Check for a user request to stop the task.
44 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
45 ;
46 ;Get the VISIT IEN
47 S VIEN=0
48VISIT S VIEN=$O(^AUPNVSIT("B",BD,VIEN))
49 I VIEN="" G NDATE
50 S VISIT=^AUPNVSIT(VIEN,0)
51 ;
52 ;Screen out inappropriate vists.
53 I PXRRSCAT'[$P(VISIT,U,7) G VISIT
54 ;
55 ;Make sure that the facility is on the list.
56 S FOUND=0
57 S FAC=$P(VISIT,U,6)
58 F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FAC D Q
59 . S FACILITY=FAC
60 . S FOUND=1
61 ;
62 ;If category was an encounter, check if encounter
63 ;occurred at a non-VA site
64 I PXRRSCAT["E"&($P(VISIT,U,7)="E")&(FAC="")&($D(NONVA)) D
65 . I $D(^AUPNVSIT(VIEN,21)) S FACILITY="*",FOUND=1
66 ;
67 I 'FOUND G VISIT
68 ;
69 ;Get the Provider
70 S PRVCNT=0
71 S PRVIEN=0
72PRV ;
73 S PRVIEN=$O(^AUPNVPRV("AD",VIEN,PRVIEN))
74 I (PRVIEN="")&(PRVCNT>0) G VISIT
75 I (PRVIEN="") D
76 . S NEWPIEN=0
77 E D
78 . S NEWPIEN=$P(^AUPNVPRV(PRVIEN,0),U,1)
79 S PRVCNT=PRVCNT+1
80 S (CLASSNAM,HLOCNAM,PPNAME)=""
81 S FOUND=1
82 ;
83 ;Apply any Provider screens.
84 ;List of providers.
85 I $D(PXRRPRPL) D
86 . S FOUND=0
87 . F IC=1:1:NPL I $P(PXRRPRPL(IC),U,2)=NEWPIEN D Q
88 ..;Mark this provider as being matched.
89 .. S $P(PXRRPRPL(IC),U,4)="M"
90 .. S PPNAME=$P(PXRRPRPL(IC),U,1)
91 .. S FOUND=1
92 I 'FOUND G PRV
93 ;
94 ;Get the Person Class.
95 S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
96 ;
97 ;Person class screen.
98 I $D(PXRRPECL) D
99 . S FOUND=$$MATCH^PXRRPECU(PCLASS)
100 I 'FOUND G PRV
101 ;
102 ;Primary Provider only.
103 I PPONLY D
104 . S FOUND=0
105 . I PRVIEN>0 D
106 .. I $P(^AUPNVPRV(PRVIEN,0),U,4)="P" S FOUND=1
107 I 'FOUND G PRV
108 ;
109 ;Clinic screen.
110 I CSSCR D
111 . S FOUND=0
112 . S CLINIEN=$P(VISIT,U,8)
113 . F IC=1:1:NCS I $P(PXRRCS(IC),U,2)=CLINIEN D Q
114 ..;Mark the clinic as being matched.
115 .. S $P(PXRRCS(IC),U,4)="M"
116 .. S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
117 .. S FOUND=1
118 I 'FOUND G PRV
119 ;
120 ;Hospital location screen.
121 I HSSCR D
122 . S FOUND=0
123 . S HLOCIEN=$P(VISIT,U,22)
124 . F IC=1:1:NHL I $P(PXRRLCHL(IC),U,2)=HLOCIEN D Q
125 ..;Mark the hospital location as being matched.
126 .. S $P(PXRRLCHL(IC),U,4)="M"
127 .. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
128 .. S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
129 .. S FOUND=1
130 I 'FOUND G PRV
131 ;
132 ;At this point we have an encounter that can be added to the list.
133 ;Make sure we have a Provider name.
134 I NEWPIEN=0 S PPNAME="Unknown"
135 I $L(PPNAME)=0 D
136 . S PPNAME=$P($G(^VA(200,NEWPIEN,0)),U,1)
137 . I $L(PPNAME)=0 S PPNAME="Unknown",NEWPIEN=0
138 S PNMAX=$$MAX^XLFMTH(PNMAX,$L(PPNAME))
139 S PNAME=PPNAME_U_NEWPIEN
140 ;
141 ;Make sure we have a Person Class.
142 I +$P($G(PCLASS),U,1)'>0 D
143 . S CLASSNAM="Unknown"
144 . S TEMP=CLASSNAM
145 E D
146 . S VACODE=$P(PCLASS,U,7)
147 . S CLASSNAM=$$ALPHA^PXRRPECU(PCLASS)
148 . S TEMP=$$ABBRV^PXRRPECU(VACODE)
149 S PCLMAX=$$MAX^XLFMTH(PCLMAX,$L(TEMP))
150 ;
151 ;Get the hospital location or clinic and stop code.
152 I $L(HLOCNAM)'>0 D
153 . I 'CLINIC D
154 .. ;Get the hospital location.
155 .. S HLOCIEN=$P(VISIT,U,22)
156 .. I HLOCIEN>0 D
157 ... S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
158 ... S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
159 .. E D
160 ...;No hospital location, see if we can at least find the clinic.
161 ... S HLOCNAM="Unknown"
162 ... S CLINIEN=$P(VISIT,U,8)
163 .. I PXRRSCAT["E"&($P(VISIT,U,7)="E")&(FAC="") D
164 ...; If encounter occurred outside VA get location from node 21
165 ...S HLOCNAM=$P(^AUPNVSIT(VIEN,21),U,1)
166 . E D
167 .. ;Get the clinic.
168 .. S CLINIEN=$P(VISIT,U,8)
169 .. I CLINIEN>0 S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
170 .. E S HLOCNAM="Unknown"
171 ;
172 ;Append the clinic stop code.
173 I CLINIEN>0 S HLOCNAM=HLOCNAM_U_$P(^DIC(40.7,CLINIEN,0),U,2)
174 S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
175 ;
176 S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,BD,HLOCNAM,VIEN)=""
177 ;
178 ;Get the next provider.
179 G PRV
180 ;
181DONE ;
182 I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
183 ;
184 ;If there were selected clinic stops build dummy entries for all
185 ;those without entries.
186 I $D(PXRRCS) D
187 . F FAC=1:1:NFAC D
188 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
189 .. F IC=1:1:NCS D
190 ... I $P(PXRRCS(IC),U,4)'="M" D
191 .... S PNAME="Unknown"_U_"0"
192 .... S CLASSNAM="Unknown"
193 .... S HLOCNAM=PXRRCS(IC)
194 .... S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
195 .... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,HLOCNAM,0)=""
196 ;
197 ;If there were selected hospital locations build dummy entries for all
198 ;those without entries.
199 I $D(PXRRLCHL) D
200 . F FAC=1:1:NFAC D
201 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
202 .. F IC=1:1:NHL D
203 ... I $P(PXRRLCHL(IC),U,4)'="M" D
204 .... S PNAME="Unknown"_U_"0"
205 .... S CLASSNAM="Unknown"
206 .... S HLOCNAM=PXRRLCHL(IC)
207 .... S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
208 .... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,HLOCNAM,0)=""
209 ;
210 ;If there were selected providers build dummy entries for all those
211 ;without encounters.
212 I $D(PXRRPRPL) D
213 . N CLASSLST,JC,NPCLASS
214 . F FAC=1:1:NFAC D
215 .. S FACILITY=$P(PXRRFAC(FAC),U,1)
216 .. F IC=1:1:NPL D
217 ... I $P(PXRRPRPL(IC),U,4)'="M" D
218 .... S PNAME=PXRRPRPL(IC)
219 .... S PPNAME=$P(PNAME,U,1)
220 .... S PNMAX=$$MAX^XLFMTH(PNMAX,$L(PPNAME))
221 .... S NEWPIEN=$P(PNAME,U,2)
222 ....;Get the person class list for this provider.
223 .... S NPCLASS=$$PCLLIST^PXRRPECU(NEWPIEN,PXRRBDT,PXRREDT,.CLASSLST)
224 .... F JC=1:1:NPCLASS D
225 ..... S CLASSNAM=CLASSLST(JC)
226 ..... S VACODE=$P(CLASSNAM,U,2)
227 ..... I $L(VACODE)'>0 S TEMP="Unknown"
228 ..... E S TEMP=$$ABBRV^PXRRPECU(VACODE)
229 ..... S PCLMAX=$$MAX^XLFMTH(PCLMAX,$L(TEMP))
230 ..... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,"HLOC")=0
231 ;
232EXIT ;Save the values of HLOCMAX, PCLMAX,and PNMAX.
233 S ^XTMP(PXRRXTMP,"HLOCMAX")=HLOCMAX
234 S ^XTMP(PXRRXTMP,"PCLMAX")=PCLMAX
235 S ^XTMP(PXRRXTMP,"PNMAX")=PNMAX
236 ;
237 Q
Note: See TracBrowser for help on using the repository browser.