PXRRECSE ;ISL/PKR - Sort through encounters applying the selection criteria. ;6/27/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,72,189,222**;Aug 12, 1996;Build 5
;;Reference to ^DIC(4 supported by DBIA 10090
;;Reference to ^DIC(40.7 supported by DBIA 93-C
SORT ;
N BD,BUSY,CLASSNAM,CLINIC,CLINIEN,CSSCR
N ED,IC,FAC,FACILITY,FOUND
N HLOCIEN,HLOCNAM,HLOCMAX,HSSCR,NEWPIEN
N PCLMAX,PCLASS,PNAME,PNMAX,PPNAME,PPONLY,PRVCNT,PRVIEN
N TEMP,VACODE,VIEN,VISIT
N HOSLOC,INS
;
S (HLOCMAX,PCLMAX,PNMAX)=0
;
I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
;
;CSSCR is true if we want selected clinics.
I $P($G(PXRRLCSC),U,1)="CS" S CSSCR=1
E S CSSCR=0
;
;CLINIC is true if we want clinics instead of hospital locations.
I $P($G(PXRRLCSC),U,1)["C" S CLINIC=1
E S CLINIC=0
;
;HSSCR is true if we want selected hospital locations.
I $P($G(PXRRLCSC),U,1)="HS" S HSSCR=1
E S HSSCR=0
;
;PPONLY is true if we want primary providers only.
I $P($G(PXRRPRSC),U,1)="P" S PPONLY=1
E S PPONLY=0
;
;Allow the task to be cleaned up upon successful completion.
S ZTREQ="@"
;
S BD=PXRRBDT-.0001
S ED=PXRREDT+.2359
NDATE S BD=$O(^AUPNVSIT("B",BD))
;If we have passed the ending date we are done.
I (BD>ED)!(BD="") G DONE
;
;If this is an interactive session let the user know that something
;is happening.
I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
;
;Get the VISIT IEN
S VIEN=0
VISIT S VIEN=$O(^AUPNVSIT("B",BD,VIEN))
I VIEN="" G NDATE
S VISIT=$G(^AUPNVSIT(VIEN,0)) G:VISIT="" NDATE
S VISIT=^AUPNVSIT(VIEN,0)
;
;Screen out inappropriate vists.
I $P(VISIT,U,7)'="" I PXRRSCAT'[$P(VISIT,U,7) G VISIT
I $P(VISIT,U,7)="" I PXRRSCAT'=$P(VISIT,U,7) G VISIT
;
;Make sure that the facility is on the list.
S FOUND=0
S FAC=$P(VISIT,U,6)
F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FAC D Q
. S FACILITY=FAC
. S FOUND=1
;
;If category was an encounter, check if encounter
;occurred at a non-VA site
I PXRRSCAT["E"&($P(VISIT,U,7)="E")&(FAC="")&($D(NONVA)) D
. I $D(^AUPNVSIT(VIEN,21)) S FACILITY="*",FOUND=1
;
;If Service Category = EVENT (HISTORICAL), get facility based on
;the hospital location, encounter occurred at a VA site. - *189
I PXRRSCAT["E"&($P(VISIT,U,7)="E")&(FAC="") D
. S (INS,HOSLOC)=""
. I $P(VISIT,U,22)'="" S HOSLOC=$P(VISIT,U,22) D
. . S INS=$P(^SC(HOSLOC,0),U,15)
. . ;S:+INS INS=$P($G(^DG(40.8,INS,0)),U,7)
. . S:+INS INS=$$GET1^DIQ(40.8,INS_",",.07,"I")
. . S INS=$S(+INS&$D(^DIC(4,+INS,0)):INS,1:"")
. . I $D(INS) F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=INS D Q
. . . S FACILITY=INS,FOUND=1
;
I 'FOUND G VISIT
;
;Get the Provider
S PRVCNT=0
S PRVIEN=0
PRV ;
S PRVIEN=$O(^AUPNVPRV("AD",VIEN,PRVIEN))
I (PRVIEN="")&(PRVCNT>0) G VISIT
I (PRVIEN="") D
. S NEWPIEN=0
E D
. S NEWPIEN=$P(^AUPNVPRV(PRVIEN,0),U,1)
S PRVCNT=PRVCNT+1
S (CLASSNAM,HLOCNAM,PPNAME)=""
S FOUND=1
;
;Apply any Provider screens.
;List of providers.
I $D(PXRRPRPL) D
. S FOUND=0
. F IC=1:1:NPL I $P(PXRRPRPL(IC),U,2)=NEWPIEN D Q
..;Mark this provider as being matched.
.. S $P(PXRRPRPL(IC),U,4)="M"
.. S PPNAME=$P(PXRRPRPL(IC),U,1)
.. S FOUND=1
I 'FOUND G PRV
;
;Get the Person Class.
S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
;
;Person class screen.
I $D(PXRRPECL) D
. S FOUND=$$MATCH^PXRRPECU(PCLASS)
I 'FOUND G PRV
;
;Primary Provider only.
I PPONLY D
. S FOUND=0
. I PRVIEN>0 D
.. I $P(^AUPNVPRV(PRVIEN,0),U,4)="P" S FOUND=1
I 'FOUND G PRV
;
;Clinic screen.
I CSSCR D
. S FOUND=0
. S CLINIEN=$P(VISIT,U,8)
. F IC=1:1:NCS I $P(PXRRCS(IC),U,2)=CLINIEN D Q
..;Mark the clinic as being matched.
.. S $P(PXRRCS(IC),U,4)="M"
.. S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
.. S FOUND=1
I 'FOUND G PRV
;
;Hospital location screen.
I HSSCR D
. S FOUND=0
. S HLOCIEN=$P(VISIT,U,22)
. F IC=1:1:NHL I $P(PXRRLCHL(IC),U,2)=HLOCIEN D Q
..;Mark the hospital location as being matched.
.. S $P(PXRRLCHL(IC),U,4)="M"
.. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
.. S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
.. S FOUND=1
I 'FOUND G PRV
;
;At this point we have an encounter that can be added to the list.
;Make sure we have a Provider name.
I NEWPIEN=0 S PPNAME="Unknown"
I $L(PPNAME)=0 D
. S PPNAME=$P($G(^VA(200,NEWPIEN,0)),U,1)
. I $L(PPNAME)=0 S PPNAME="Unknown",NEWPIEN=0
S PNMAX=$$MAX^XLFMTH(PNMAX,$L(PPNAME))
S PNAME=PPNAME_U_NEWPIEN
;
;Make sure we have a Person Class.
I +$P($G(PCLASS),U,1)'>0 D
. S CLASSNAM="Unknown"
. S TEMP=CLASSNAM
E D
. S VACODE=$P(PCLASS,U,7)
. S CLASSNAM=$$ALPHA^PXRRPECU(PCLASS)
. S TEMP=$$ABBRV^PXRRPECU(VACODE)
S PCLMAX=$$MAX^XLFMTH(PCLMAX,$L(TEMP))
;
;Get the hospital location or clinic and stop code.
I $L(HLOCNAM)'>0 D
. I 'CLINIC D
.. ;Get the hospital location.
.. S HLOCIEN=$P(VISIT,U,22)
.. I HLOCIEN>0 D
... S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
... S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
.. E D
...;No hospital location, see if we can at least find the clinic.
... S HLOCNAM="Unknown"
... S CLINIEN=$P(VISIT,U,8)
.. I PXRRSCAT["E"&($P(VISIT,U,7)="E")&(FAC="") D
...; If encounter occurred outside VA get location from node 21
...; Check if node 21 exists - *189
...I $D(^AUPNVSIT(VIEN,21)) S HLOCNAM=$P(^AUPNVSIT(VIEN,21),U,1)
...; If encounter occurred at VA site, get location from field .22 - *189
...I '$D(^AUPNVSIT(VIEN,21)) S HLOCNAM=$P(^SC($P(VISIT,U,22),0),U,1)
. E D
.. ;Get the clinic.
.. S CLINIEN=$P(VISIT,U,8)
.. I CLINIEN>0 S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
.. E S HLOCNAM="Unknown"
;
;Append the clinic stop code.
I CLINIEN>0 S HLOCNAM=HLOCNAM_U_$P(^DIC(40.7,CLINIEN,0),U,2)
S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
;
S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,BD,HLOCNAM,VIEN)=""
;
;Get the next provider.
G PRV
;
DONE ;
I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
;
;If there were selected clinic stops build dummy entries for all
;those without entries.
I $D(PXRRCS) D
. F FAC=1:1:NFAC D
.. S FACILITY=$P(PXRRFAC(FAC),U,1)
.. F IC=1:1:NCS D
... I $P(PXRRCS(IC),U,4)'="M" D
.... S PNAME="Unknown"_U_"0"
.... S CLASSNAM="Unknown"
.... S HLOCNAM=PXRRCS(IC)
.... S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
.... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,HLOCNAM,0)=""
;
;If there were selected hospital locations build dummy entries for all
;those without entries.
I $D(PXRRLCHL) D
. F FAC=1:1:NFAC D
.. S FACILITY=$P(PXRRFAC(FAC),U,1)
.. F IC=1:1:NHL D
... I $P(PXRRLCHL(IC),U,4)'="M" D
.... S PNAME="Unknown"_U_"0"
.... S CLASSNAM="Unknown"
.... S HLOCNAM=PXRRLCHL(IC)
.... S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
.... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,HLOCNAM,0)=""
;
;If there were selected providers build dummy entries for all those
;without encounters.
I $D(PXRRPRPL) D
. N CLASSLST,JC,NPCLASS
. F FAC=1:1:NFAC D
.. S FACILITY=$P(PXRRFAC(FAC),U,1)
.. F IC=1:1:NPL D
... I $P(PXRRPRPL(IC),U,4)'="M" D
.... S PNAME=PXRRPRPL(IC)
.... S PPNAME=$P(PNAME,U,1)
.... S PNMAX=$$MAX^XLFMTH(PNMAX,$L(PPNAME))
.... S NEWPIEN=$P(PNAME,U,2)
....;Get the person class list for this provider.
.... S NPCLASS=$$PCLLIST^PXRRPECU(NEWPIEN,PXRRBDT,PXRREDT,.CLASSLST)
.... F JC=1:1:NPCLASS D
..... S CLASSNAM=CLASSLST(JC)
..... S VACODE=$P(CLASSNAM,U,2)
..... I $L(VACODE)'>0 S TEMP="Unknown"
..... E S TEMP=$$ABBRV^PXRRPECU(VACODE)
..... S PCLMAX=$$MAX^XLFMTH(PCLMAX,$L(TEMP))
..... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,"HLOC")=0
;
EXIT ;Save the values of HLOCMAX, PCLMAX,and PNMAX.
S ^XTMP(PXRRXTMP,"HLOCMAX")=HLOCMAX
S ^XTMP(PXRRXTMP,"PCLMAX")=PCLMAX
S ^XTMP(PXRRXTMP,"PNMAX")=PNMAX
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRECSE 7966 printed Sep 23, 2025@20:06:38 Page 2
PXRRECSE ;ISL/PKR - Sort through encounters applying the selection criteria. ;6/27/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,72,189,222**;Aug 12, 1996;Build 5
+2 ;;Reference to ^DIC(4 supported by DBIA 10090
+3 ;;Reference to ^DIC(40.7 supported by DBIA 93-C
SORT ;
+1 NEW BD,BUSY,CLASSNAM,CLINIC,CLINIEN,CSSCR
+2 NEW ED,IC,FAC,FACILITY,FOUND
+3 NEW HLOCIEN,HLOCNAM,HLOCMAX,HSSCR,NEWPIEN
+4 NEW PCLMAX,PCLASS,PNAME,PNMAX,PPNAME,PPONLY,PRVCNT,PRVIEN
+5 NEW TEMP,VACODE,VIEN,VISIT
+6 NEW HOSLOC,INS
+7 ;
+8 SET (HLOCMAX,PCLMAX,PNMAX)=0
+9 ;
+10 IF '(PXRRQUE!$DATA(IO("S")))
DO INIT^PXRRBUSY(.BUSY)
+11 ;
+12 ;CSSCR is true if we want selected clinics.
+13 IF $PIECE($GET(PXRRLCSC),U,1)="CS"
SET CSSCR=1
+14 IF '$TEST
SET CSSCR=0
+15 ;
+16 ;CLINIC is true if we want clinics instead of hospital locations.
+17 IF $PIECE($GET(PXRRLCSC),U,1)["C"
SET CLINIC=1
+18 IF '$TEST
SET CLINIC=0
+19 ;
+20 ;HSSCR is true if we want selected hospital locations.
+21 IF $PIECE($GET(PXRRLCSC),U,1)="HS"
SET HSSCR=1
+22 IF '$TEST
SET HSSCR=0
+23 ;
+24 ;PPONLY is true if we want primary providers only.
+25 IF $PIECE($GET(PXRRPRSC),U,1)="P"
SET PPONLY=1
+26 IF '$TEST
SET PPONLY=0
+27 ;
+28 ;Allow the task to be cleaned up upon successful completion.
+29 SET ZTREQ="@"
+30 ;
+31 SET BD=PXRRBDT-.0001
+32 SET ED=PXRREDT+.2359
NDATE SET BD=$ORDER(^AUPNVSIT("B",BD))
+1 ;If we have passed the ending date we are done.
+2 IF (BD>ED)!(BD="")
GOTO DONE
+3 ;
+4 ;If this is an interactive session let the user know that something
+5 ;is happening.
+6 IF '(PXRRQUE!$DATA(IO("S")))
DO SPIN^PXRRBUSY("Sorting encounters",.BUSY)
+7 ;
+8 ;Check for a user request to stop the task.
+9 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRGUT
+10 ;
+11 ;Get the VISIT IEN
+12 SET VIEN=0
VISIT SET VIEN=$ORDER(^AUPNVSIT("B",BD,VIEN))
+1 IF VIEN=""
GOTO NDATE
+2 SET VISIT=$GET(^AUPNVSIT(VIEN,0))
if VISIT=""
GOTO NDATE
+3 SET VISIT=^AUPNVSIT(VIEN,0)
+4 ;
+5 ;Screen out inappropriate vists.
+6 IF $PIECE(VISIT,U,7)'=""
IF PXRRSCAT'[$PIECE(VISIT,U,7)
GOTO VISIT
+7 IF $PIECE(VISIT,U,7)=""
IF PXRRSCAT'=$PIECE(VISIT,U,7)
GOTO VISIT
+8 ;
+9 ;Make sure that the facility is on the list.
+10 SET FOUND=0
+11 SET FAC=$PIECE(VISIT,U,6)
+12 FOR IC=1:1:NFAC
IF $PIECE(PXRRFAC(IC),U,1)=FAC
Begin DoDot:1
+13 SET FACILITY=FAC
+14 SET FOUND=1
End DoDot:1
QUIT
+15 ;
+16 ;If category was an encounter, check if encounter
+17 ;occurred at a non-VA site
+18 IF PXRRSCAT["E"&($PIECE(VISIT,U,7)="E")&(FAC="")&($DATA(NONVA))
Begin DoDot:1
+19 IF $DATA(^AUPNVSIT(VIEN,21))
SET FACILITY="*"
SET FOUND=1
End DoDot:1
+20 ;
+21 ;If Service Category = EVENT (HISTORICAL), get facility based on
+22 ;the hospital location, encounter occurred at a VA site. - *189
+23 IF PXRRSCAT["E"&($PIECE(VISIT,U,7)="E")&(FAC="")
Begin DoDot:1
+24 SET (INS,HOSLOC)=""
+25 IF $PIECE(VISIT,U,22)'=""
SET HOSLOC=$PIECE(VISIT,U,22)
Begin DoDot:2
+26 SET INS=$PIECE(^SC(HOSLOC,0),U,15)
+27 ;S:+INS INS=$P($G(^DG(40.8,INS,0)),U,7)
+28 if +INS
SET INS=$$GET1^DIQ(40.8,INS_",",.07,"I")
+29 SET INS=$SELECT(+INS&$DATA(^DIC(4,+INS,0)):INS,1:"")
+30 IF $DATA(INS)
FOR IC=1:1:NFAC
IF $PIECE(PXRRFAC(IC),U,1)=INS
Begin DoDot:3
+31 SET FACILITY=INS
SET FOUND=1
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+32 ;
+33 IF 'FOUND
GOTO VISIT
+34 ;
+35 ;Get the Provider
+36 SET PRVCNT=0
+37 SET PRVIEN=0
PRV ;
+1 SET PRVIEN=$ORDER(^AUPNVPRV("AD",VIEN,PRVIEN))
+2 IF (PRVIEN="")&(PRVCNT>0)
GOTO VISIT
+3 IF (PRVIEN="")
Begin DoDot:1
+4 SET NEWPIEN=0
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET NEWPIEN=$PIECE(^AUPNVPRV(PRVIEN,0),U,1)
End DoDot:1
+7 SET PRVCNT=PRVCNT+1
+8 SET (CLASSNAM,HLOCNAM,PPNAME)=""
+9 SET FOUND=1
+10 ;
+11 ;Apply any Provider screens.
+12 ;List of providers.
+13 IF $DATA(PXRRPRPL)
Begin DoDot:1
+14 SET FOUND=0
+15 FOR IC=1:1:NPL
IF $PIECE(PXRRPRPL(IC),U,2)=NEWPIEN
Begin DoDot:2
+16 ;Mark this provider as being matched.
+17 SET $PIECE(PXRRPRPL(IC),U,4)="M"
+18 SET PPNAME=$PIECE(PXRRPRPL(IC),U,1)
+19 SET FOUND=1
End DoDot:2
QUIT
End DoDot:1
+20 IF 'FOUND
GOTO PRV
+21 ;
+22 ;Get the Person Class.
+23 SET PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
+24 ;
+25 ;Person class screen.
+26 IF $DATA(PXRRPECL)
Begin DoDot:1
+27 SET FOUND=$$MATCH^PXRRPECU(PCLASS)
End DoDot:1
+28 IF 'FOUND
GOTO PRV
+29 ;
+30 ;Primary Provider only.
+31 IF PPONLY
Begin DoDot:1
+32 SET FOUND=0
+33 IF PRVIEN>0
Begin DoDot:2
+34 IF $PIECE(^AUPNVPRV(PRVIEN,0),U,4)="P"
SET FOUND=1
End DoDot:2
End DoDot:1
+35 IF 'FOUND
GOTO PRV
+36 ;
+37 ;Clinic screen.
+38 IF CSSCR
Begin DoDot:1
+39 SET FOUND=0
+40 SET CLINIEN=$PIECE(VISIT,U,8)
+41 FOR IC=1:1:NCS
IF $PIECE(PXRRCS(IC),U,2)=CLINIEN
Begin DoDot:2
+42 ;Mark the clinic as being matched.
+43 SET $PIECE(PXRRCS(IC),U,4)="M"
+44 SET HLOCNAM=$PIECE(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
+45 SET FOUND=1
End DoDot:2
QUIT
End DoDot:1
+46 IF 'FOUND
GOTO PRV
+47 ;
+48 ;Hospital location screen.
+49 IF HSSCR
Begin DoDot:1
+50 SET FOUND=0
+51 SET HLOCIEN=$PIECE(VISIT,U,22)
+52 FOR IC=1:1:NHL
IF $PIECE(PXRRLCHL(IC),U,2)=HLOCIEN
Begin DoDot:2
+53 ;Mark the hospital location as being matched.
+54 SET $PIECE(PXRRLCHL(IC),U,4)="M"
+55 SET HLOCNAM=$PIECE(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
+56 SET CLINIEN=$PIECE(^SC(HLOCIEN,0),U,7)
+57 SET FOUND=1
End DoDot:2
QUIT
End DoDot:1
+58 IF 'FOUND
GOTO PRV
+59 ;
+60 ;At this point we have an encounter that can be added to the list.
+61 ;Make sure we have a Provider name.
+62 IF NEWPIEN=0
SET PPNAME="Unknown"
+63 IF $LENGTH(PPNAME)=0
Begin DoDot:1
+64 SET PPNAME=$PIECE($GET(^VA(200,NEWPIEN,0)),U,1)
+65 IF $LENGTH(PPNAME)=0
SET PPNAME="Unknown"
SET NEWPIEN=0
End DoDot:1
+66 SET PNMAX=$$MAX^XLFMTH(PNMAX,$LENGTH(PPNAME))
+67 SET PNAME=PPNAME_U_NEWPIEN
+68 ;
+69 ;Make sure we have a Person Class.
+70 IF +$PIECE($GET(PCLASS),U,1)'>0
Begin DoDot:1
+71 SET CLASSNAM="Unknown"
+72 SET TEMP=CLASSNAM
End DoDot:1
+73 IF '$TEST
Begin DoDot:1
+74 SET VACODE=$PIECE(PCLASS,U,7)
+75 SET CLASSNAM=$$ALPHA^PXRRPECU(PCLASS)
+76 SET TEMP=$$ABBRV^PXRRPECU(VACODE)
End DoDot:1
+77 SET PCLMAX=$$MAX^XLFMTH(PCLMAX,$LENGTH(TEMP))
+78 ;
+79 ;Get the hospital location or clinic and stop code.
+80 IF $LENGTH(HLOCNAM)'>0
Begin DoDot:1
+81 IF 'CLINIC
Begin DoDot:2
+82 ;Get the hospital location.
+83 SET HLOCIEN=$PIECE(VISIT,U,22)
+84 IF HLOCIEN>0
Begin DoDot:3
+85 SET HLOCNAM=$PIECE(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
+86 SET CLINIEN=$PIECE(^SC(HLOCIEN,0),U,7)
End DoDot:3
+87 IF '$TEST
Begin DoDot:3
+88 ;No hospital location, see if we can at least find the clinic.
+89 SET HLOCNAM="Unknown"
+90 SET CLINIEN=$PIECE(VISIT,U,8)
End DoDot:3
+91 IF PXRRSCAT["E"&($PIECE(VISIT,U,7)="E")&(FAC="")
Begin DoDot:3
+92 ; If encounter occurred outside VA get location from node 21
+93 ; Check if node 21 exists - *189
+94 IF $DATA(^AUPNVSIT(VIEN,21))
SET HLOCNAM=$PIECE(^AUPNVSIT(VIEN,21),U,1)
+95 ; If encounter occurred at VA site, get location from field .22 - *189
+96 IF '$DATA(^AUPNVSIT(VIEN,21))
SET HLOCNAM=$PIECE(^SC($PIECE(VISIT,U,22),0),U,1)
End DoDot:3
End DoDot:2
+97 IF '$TEST
Begin DoDot:2
+98 ;Get the clinic.
+99 SET CLINIEN=$PIECE(VISIT,U,8)
+100 IF CLINIEN>0
SET HLOCNAM=$PIECE(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
+101 IF '$TEST
SET HLOCNAM="Unknown"
End DoDot:2
End DoDot:1
+102 ;
+103 ;Append the clinic stop code.
+104 IF CLINIEN>0
SET HLOCNAM=HLOCNAM_U_$PIECE(^DIC(40.7,CLINIEN,0),U,2)
+105 SET HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$LENGTH($PIECE(HLOCNAM,U,1)))
+106 ;
+107 SET ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,BD,HLOCNAM,VIEN)=""
+108 ;
+109 ;Get the next provider.
+110 GOTO PRV
+111 ;
DONE ;
+1 IF '(PXRRQUE!$DATA(IO("S")))
DO DONE^PXRRBUSY("done")
+2 ;
+3 ;If there were selected clinic stops build dummy entries for all
+4 ;those without entries.
+5 IF $DATA(PXRRCS)
Begin DoDot:1
+6 FOR FAC=1:1:NFAC
Begin DoDot:2
+7 SET FACILITY=$PIECE(PXRRFAC(FAC),U,1)
+8 FOR IC=1:1:NCS
Begin DoDot:3
+9 IF $PIECE(PXRRCS(IC),U,4)'="M"
Begin DoDot:4
+10 SET PNAME="Unknown"_U_"0"
+11 SET CLASSNAM="Unknown"
+12 SET HLOCNAM=PXRRCS(IC)
+13 SET HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$LENGTH($PIECE(HLOCNAM,U,1)))
+14 SET ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,HLOCNAM,0)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 ;If there were selected hospital locations build dummy entries for all
+17 ;those without entries.
+18 IF $DATA(PXRRLCHL)
Begin DoDot:1
+19 FOR FAC=1:1:NFAC
Begin DoDot:2
+20 SET FACILITY=$PIECE(PXRRFAC(FAC),U,1)
+21 FOR IC=1:1:NHL
Begin DoDot:3
+22 IF $PIECE(PXRRLCHL(IC),U,4)'="M"
Begin DoDot:4
+23 SET PNAME="Unknown"_U_"0"
+24 SET CLASSNAM="Unknown"
+25 SET HLOCNAM=PXRRLCHL(IC)
+26 SET HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$LENGTH($PIECE(HLOCNAM,U,1)))
+27 SET ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,HLOCNAM,0)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 ;If there were selected providers build dummy entries for all those
+30 ;without encounters.
+31 IF $DATA(PXRRPRPL)
Begin DoDot:1
+32 NEW CLASSLST,JC,NPCLASS
+33 FOR FAC=1:1:NFAC
Begin DoDot:2
+34 SET FACILITY=$PIECE(PXRRFAC(FAC),U,1)
+35 FOR IC=1:1:NPL
Begin DoDot:3
+36 IF $PIECE(PXRRPRPL(IC),U,4)'="M"
Begin DoDot:4
+37 SET PNAME=PXRRPRPL(IC)
+38 SET PPNAME=$PIECE(PNAME,U,1)
+39 SET PNMAX=$$MAX^XLFMTH(PNMAX,$LENGTH(PPNAME))
+40 SET NEWPIEN=$PIECE(PNAME,U,2)
+41 ;Get the person class list for this provider.
+42 SET NPCLASS=$$PCLLIST^PXRRPECU(NEWPIEN,PXRRBDT,PXRREDT,.CLASSLST)
+43 FOR JC=1:1:NPCLASS
Begin DoDot:5
+44 SET CLASSNAM=CLASSLST(JC)
+45 SET VACODE=$PIECE(CLASSNAM,U,2)
+46 IF $LENGTH(VACODE)'>0
SET TEMP="Unknown"
+47 IF '$TEST
SET TEMP=$$ABBRV^PXRRPECU(VACODE)
+48 SET PCLMAX=$$MAX^XLFMTH(PCLMAX,$LENGTH(TEMP))
+49 SET ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,"HLOC")=0
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+50 ;
EXIT ;Save the values of HLOCMAX, PCLMAX,and PNMAX.
+1 SET ^XTMP(PXRRXTMP,"HLOCMAX")=HLOCMAX
+2 SET ^XTMP(PXRRXTMP,"PCLMAX")=PCLMAX
+3 SET ^XTMP(PXRRXTMP,"PNMAX")=PNMAX
+4 ;
+5 QUIT
