[613] | 1 | PXRRECSE ;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
|
---|
| 3 | SORT ;
|
---|
| 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
|
---|
| 35 | NDATE 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
|
---|
| 48 | VISIT 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
|
---|
| 72 | PRV ;
|
---|
| 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 | ;
|
---|
| 181 | DONE ;
|
---|
| 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 | ;
|
---|
| 232 | EXIT ;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
|
---|