PXRRPRDP ;ISL/PKR - Provider encounter detailed print. ;2/26/98
;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,48,189**;Aug 12, 1996;Build 13
;
N BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,INDENT,MID,PAGE
N CLASSNAM,CLINNAM
N DATE,DAY,DTOTAL,GTOTAL,HLOC,HLOCMAX,IC
N FACILITY,FACPNAME,FTOTAL
N OCC,NEWPIEN,PCLASS,PNAME,PPNAME,PTOTAL
N SPEC,SUBSPEC,TEMP,VACODE,VIEN
;
;Allow the task to be cleaned up upon successful completion.
S ZTREQ="@"
;
U IO
S DONE=0
;Setup the formatting parameters.
S HLOCMAX=^XTMP(PXRRXTMP,"HLOCMAX")
S INDENT=3
S C1HS=INDENT+4
S C2HS=INDENT+15
S C3HS=C2HS+45
;We assume that the counts will never be longer than six digits.
S MID=C3HS+6
S C1S=C2HS+HLOCMAX+1
S C2S=C1S+7
;
S PAGE=1
S GTOTAL=0
I ($E(IOST)="C")&(IO=IO(0)) S BMARG=3
E S BMARG=2
D HDR^PXRRGPRT(PAGE)
W !!,"Criteria for Provider Encounter Detailed Report"
D OPRCRIT^PXRRGPRT(3)
;
SET ;Set up print fields
S FACILITY=0
FAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
; Fix to include Non-VA site - *189
I (+FACILITY=0)&(FACILITY'="*") G FINAL
;Mark the facility as being found.
F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
. S $P(PXRRFAC(IC),U,4)="M"
S FTOTAL=0
S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
S HAVEPRV=0
D HEAD(HAVEPRV)
;
S PNAME=0
PRV S PNAME=$O(^XTMP(PXRRXTMP,FACILITY,PNAME))
I PNAME="" D G FAC
. S TEMP="Total facility encounters "
. I $Y>(IOSL-BMARG-1) D HEAD(HAVEPRV)
. I 'DONE D
.. D PTOTAL^PXRRGPRT(TEMP,FTOTAL,MID,0)
.. S GTOTAL=GTOTAL+FTOTAL
.. I $D(PXRRPECL) D CLASSNE^PXRRGPRT(INDENT)
I DONE G END
S PPNAME=$P(PNAME,U,1)
S NEWPIEN=$P(PNAME,U,2)
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
;
S CLASSNAM=0
CLASS ;
I DONE G END
S CLASSNAM=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM))
I CLASSNAM="" D G PRV
. K ^TMP(PXRRXTMP,$J,PNAME)
S VACODE=$P(CLASSNAM,U,2)
I $L(VACODE)>0 D
. S PCLASS=$$OCCUP^PXBGPRV("","",VACODE,1)
. S OCCUP=$P(PCLASS,U,2)
. S SPEC=$P(PCLASS,U,3)
. S SUBSPEC=$P(PCLASS,U,4)
E D
. S PCLASS=-3
. S OCCUP="Unknown"
. S SPEC=""
. S SUBSPEC=""
;If we are doing selected person classes keep track of the ones we
;found.
I $D(PXRRPECL) S TEMP=$$MATCH^PXRRPECU(PCLASS)
S (DATE,PTOTAL)=0
I DONE G END
D PPRINT
S HAVEPRV=1
;
DATE ;
S DATE=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
I DATE="" D G CLASS
.;Print the daily totals and get the total count.
. D DPRINT(.PTOTAL)
. I 'DONE D
.. S TEMP="Total encounters for "_PPNAME_" "
.. I $Y>(IOSL-BMARG-3) D HEAD(HAVEPRV)
.. I 'DONE D
... D PTOTAL^PXRRGPRT(TEMP,PTOTAL,MID,1)
... S HAVEPRV=0
... S FTOTAL=FTOTAL+PTOTAL
I DONE G END
;
S HLOC=0
HLO S HLOC=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC))
I HLOC="" G DATE
;
;Build a ^TMP array of all the visits for the current provider.
S DAY=$P(DATE,".",1)
S VIEN=0
F S VIEN=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC,VIEN)) Q:+VIEN=0 D
. S ^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN)=""
G HLO
;
FINAL ;Print grand totals.
I DONE G END
I GTOTAL>0 D
. S TEMP="Total encounters "
. I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
. I 'DONE D PTOTAL^PXRRGPRT(TEMP,GTOTAL,MID,0)
I DONE G END
;Check for facilities that were listed but had no encounters.
D FACNE^PXRRGPRT(INDENT)
END ;
D EXIT^PXRRGUT
D EOR^PXRRGUT
Q
;
;=======================================================================
DPRINT(PTOTAL) ;Print the daily totals and return the total provider count.
N DAY,HLOC,HLOCNAM,NVISITS,SC,SCAT,VIEN,VISITS
S PTOTAL=0
S DAY=0
NDAY S DAY=$O(^TMP(PXRRXTMP,$J,PNAME,DAY))
I DAY="" Q
;
S HLOC=""
NHLOC S HLOC=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC))
S HLOCNAM=$P(HLOC,U,1)
S SC=$P(HLOC,U,3)
I HLOC="" G NDAY
;
S NVISITS=0
K VISITS
S VIEN=0
NVIEN S VIEN=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN))
I VIEN="" D G NHLOC
. S SCAT=$$SCAT(NVISITS,.VISITS)
. S PTOTAL=PTOTAL+NVISITS
. S C3S=MID-$L(NVISITS)
. I $Y>(IOSL-BMARG-3) D HEAD(HAVEPRV)
. I 'DONE D
.. W !,?INDENT,$$FMTE^XLFDT(DAY,"1D"),?C2HS,HLOCNAM
.. W ?C1S,SC,?C2S,SCAT,?C3S,NVISITS
I DONE Q
S NVISITS=NVISITS+1
S VISITS(NVISITS)=VIEN
G NVIEN
Q
;
;=======================================================================
HEAD(HAVEPRV) ;Write the header.
N LEN,TEMP,VACODE
I $Y>(IOSL-BMARG-7) D PAGE^PXRRGPRT
I DONE Q
W !!,"Facility: ",FACPNAME
W !!,"Provider - Person Class"
W !,?C1HS,"Date",?C2HS,"Hos. Loc. (Stop Code) Serv. Cat.",?C3HS,"Encounters"
W !,?INDENT,"------------",?C2HS,"------------------------------------------",?C3HS,"----------"
I $G(HAVEPRV) W !,PPNAME," (continued)"
Q
;
;=======================================================================
PPRINT ;Print the provider information.
I $Y>(IOSL-BMARG-4) D HEAD(HAVEPRV)
I DONE Q
S TEMP=PPNAME_" - "_OCCUP
S LEN=$L(TEMP)
I LEN>C3HS D
. W !,PPNAME," - "
. W !?3,OCCUP
. I $L(SPEC)>0 W !,?4,SPEC
. I $L(SUBSPEC)>0 W !,?5,SUBSPEC
E D
. W !,TEMP
. I $L(SPEC)>0 W !,?4,SPEC
. I $L(SUBSPEC)>0 W !,?5,SUBSPEC
W !
Q
;
;=======================================================================
SCAT(NVISITS,VISITS) ;Given a list of VISIT IENS return the service categories.
;
N IC,SCATL,VISIT
S SCATL=""
F IC=1:1:NVISITS D
. S VISIT=^AUPNVSIT(VISITS(IC),0)
. S SCATL=$$USTRINS^PXRRGUT(SCATL,$P(VISIT,U,7))
Q SCATL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRPRDP 5501 printed Dec 13, 2024@02:31:10 Page 2
PXRRPRDP ;ISL/PKR - Provider encounter detailed print. ;2/26/98
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,48,189**;Aug 12, 1996;Build 13
+2 ;
+3 NEW BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,INDENT,MID,PAGE
+4 NEW CLASSNAM,CLINNAM
+5 NEW DATE,DAY,DTOTAL,GTOTAL,HLOC,HLOCMAX,IC
+6 NEW FACILITY,FACPNAME,FTOTAL
+7 NEW OCC,NEWPIEN,PCLASS,PNAME,PPNAME,PTOTAL
+8 NEW SPEC,SUBSPEC,TEMP,VACODE,VIEN
+9 ;
+10 ;Allow the task to be cleaned up upon successful completion.
+11 SET ZTREQ="@"
+12 ;
+13 USE IO
+14 SET DONE=0
+15 ;Setup the formatting parameters.
+16 SET HLOCMAX=^XTMP(PXRRXTMP,"HLOCMAX")
+17 SET INDENT=3
+18 SET C1HS=INDENT+4
+19 SET C2HS=INDENT+15
+20 SET C3HS=C2HS+45
+21 ;We assume that the counts will never be longer than six digits.
+22 SET MID=C3HS+6
+23 SET C1S=C2HS+HLOCMAX+1
+24 SET C2S=C1S+7
+25 ;
+26 SET PAGE=1
+27 SET GTOTAL=0
+28 IF ($EXTRACT(IOST)="C")&(IO=IO(0))
SET BMARG=3
+29 IF '$TEST
SET BMARG=2
+30 DO HDR^PXRRGPRT(PAGE)
+31 WRITE !!,"Criteria for Provider Encounter Detailed Report"
+32 DO OPRCRIT^PXRRGPRT(3)
+33 ;
SET ;Set up print fields
+1 SET FACILITY=0
FAC SET FACILITY=$ORDER(^XTMP(PXRRXTMP,FACILITY))
+1 ; Fix to include Non-VA site - *189
+2 IF (+FACILITY=0)&(FACILITY'="*")
GOTO FINAL
+3 ;Mark the facility as being found.
+4 FOR IC=1:1:NFAC
IF $PIECE(PXRRFAC(IC),U,1)=FACILITY
Begin DoDot:1
+5 SET $PIECE(PXRRFAC(IC),U,4)="M"
End DoDot:1
QUIT
+6 SET FTOTAL=0
+7 SET FACPNAME=$PIECE(PXRRFACN(FACILITY),U,1)_" "_$PIECE(PXRRFACN(FACILITY),U,2)
+8 SET HAVEPRV=0
+9 DO HEAD(HAVEPRV)
+10 ;
+11 SET PNAME=0
PRV SET PNAME=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME))
+1 IF PNAME=""
Begin DoDot:1
+2 SET TEMP="Total facility encounters "
+3 IF $Y>(IOSL-BMARG-1)
DO HEAD(HAVEPRV)
+4 IF 'DONE
Begin DoDot:2
+5 DO PTOTAL^PXRRGPRT(TEMP,FTOTAL,MID,0)
+6 SET GTOTAL=GTOTAL+FTOTAL
+7 IF $DATA(PXRRPECL)
DO CLASSNE^PXRRGPRT(INDENT)
End DoDot:2
End DoDot:1
GOTO FAC
+8 IF DONE
GOTO END
+9 SET PPNAME=$PIECE(PNAME,U,1)
+10 SET NEWPIEN=$PIECE(PNAME,U,2)
+11 ;
+12 ;Check for a user request to stop the task.
+13 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRGUT
+14 ;
+15 SET CLASSNAM=0
CLASS ;
+1 IF DONE
GOTO END
+2 SET CLASSNAM=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM))
+3 IF CLASSNAM=""
Begin DoDot:1
+4 KILL ^TMP(PXRRXTMP,$JOB,PNAME)
End DoDot:1
GOTO PRV
+5 SET VACODE=$PIECE(CLASSNAM,U,2)
+6 IF $LENGTH(VACODE)>0
Begin DoDot:1
+7 SET PCLASS=$$OCCUP^PXBGPRV("","",VACODE,1)
+8 SET OCCUP=$PIECE(PCLASS,U,2)
+9 SET SPEC=$PIECE(PCLASS,U,3)
+10 SET SUBSPEC=$PIECE(PCLASS,U,4)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET PCLASS=-3
+13 SET OCCUP="Unknown"
+14 SET SPEC=""
+15 SET SUBSPEC=""
End DoDot:1
+16 ;If we are doing selected person classes keep track of the ones we
+17 ;found.
+18 IF $DATA(PXRRPECL)
SET TEMP=$$MATCH^PXRRPECU(PCLASS)
+19 SET (DATE,PTOTAL)=0
+20 IF DONE
GOTO END
+21 DO PPRINT
+22 SET HAVEPRV=1
+23 ;
DATE ;
+1 SET DATE=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
+2 IF DATE=""
Begin DoDot:1
+3 ;Print the daily totals and get the total count.
+4 DO DPRINT(.PTOTAL)
+5 IF 'DONE
Begin DoDot:2
+6 SET TEMP="Total encounters for "_PPNAME_" "
+7 IF $Y>(IOSL-BMARG-3)
DO HEAD(HAVEPRV)
+8 IF 'DONE
Begin DoDot:3
+9 DO PTOTAL^PXRRGPRT(TEMP,PTOTAL,MID,1)
+10 SET HAVEPRV=0
+11 SET FTOTAL=FTOTAL+PTOTAL
End DoDot:3
End DoDot:2
End DoDot:1
GOTO CLASS
+12 IF DONE
GOTO END
+13 ;
+14 SET HLOC=0
HLO SET HLOC=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC))
+1 IF HLOC=""
GOTO DATE
+2 ;
+3 ;Build a ^TMP array of all the visits for the current provider.
+4 SET DAY=$PIECE(DATE,".",1)
+5 SET VIEN=0
+6 FOR
SET VIEN=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC,VIEN))
if +VIEN=0
QUIT
Begin DoDot:1
+7 SET ^TMP(PXRRXTMP,$JOB,PNAME,DAY,HLOC,VIEN)=""
End DoDot:1
+8 GOTO HLO
+9 ;
FINAL ;Print grand totals.
+1 IF DONE
GOTO END
+2 IF GTOTAL>0
Begin DoDot:1
+3 SET TEMP="Total encounters "
+4 IF $Y>(IOSL-BMARG-3)
DO PAGE^PXRRGPRT
+5 IF 'DONE
DO PTOTAL^PXRRGPRT(TEMP,GTOTAL,MID,0)
End DoDot:1
+6 IF DONE
GOTO END
+7 ;Check for facilities that were listed but had no encounters.
+8 DO FACNE^PXRRGPRT(INDENT)
END ;
+1 DO EXIT^PXRRGUT
+2 DO EOR^PXRRGUT
+3 QUIT
+4 ;
+5 ;=======================================================================
DPRINT(PTOTAL) ;Print the daily totals and return the total provider count.
+1 NEW DAY,HLOC,HLOCNAM,NVISITS,SC,SCAT,VIEN,VISITS
+2 SET PTOTAL=0
+3 SET DAY=0
NDAY SET DAY=$ORDER(^TMP(PXRRXTMP,$JOB,PNAME,DAY))
+1 IF DAY=""
QUIT
+2 ;
+3 SET HLOC=""
NHLOC SET HLOC=$ORDER(^TMP(PXRRXTMP,$JOB,PNAME,DAY,HLOC))
+1 SET HLOCNAM=$PIECE(HLOC,U,1)
+2 SET SC=$PIECE(HLOC,U,3)
+3 IF HLOC=""
GOTO NDAY
+4 ;
+5 SET NVISITS=0
+6 KILL VISITS
+7 SET VIEN=0
NVIEN SET VIEN=$ORDER(^TMP(PXRRXTMP,$JOB,PNAME,DAY,HLOC,VIEN))
+1 IF VIEN=""
Begin DoDot:1
+2 SET SCAT=$$SCAT(NVISITS,.VISITS)
+3 SET PTOTAL=PTOTAL+NVISITS
+4 SET C3S=MID-$LENGTH(NVISITS)
+5 IF $Y>(IOSL-BMARG-3)
DO HEAD(HAVEPRV)
+6 IF 'DONE
Begin DoDot:2
+7 WRITE !,?INDENT,$$FMTE^XLFDT(DAY,"1D"),?C2HS,HLOCNAM
+8 WRITE ?C1S,SC,?C2S,SCAT,?C3S,NVISITS
End DoDot:2
End DoDot:1
GOTO NHLOC
+9 IF DONE
QUIT
+10 SET NVISITS=NVISITS+1
+11 SET VISITS(NVISITS)=VIEN
+12 GOTO NVIEN
+13 QUIT
+14 ;
+15 ;=======================================================================
HEAD(HAVEPRV) ;Write the header.
+1 NEW LEN,TEMP,VACODE
+2 IF $Y>(IOSL-BMARG-7)
DO PAGE^PXRRGPRT
+3 IF DONE
QUIT
+4 WRITE !!,"Facility: ",FACPNAME
+5 WRITE !!,"Provider - Person Class"
+6 WRITE !,?C1HS,"Date",?C2HS,"Hos. Loc. (Stop Code) Serv. Cat.",?C3HS,"Encounters"
+7 WRITE !,?INDENT,"------------",?C2HS,"------------------------------------------",?C3HS,"----------"
+8 IF $GET(HAVEPRV)
WRITE !,PPNAME," (continued)"
+9 QUIT
+10 ;
+11 ;=======================================================================
PPRINT ;Print the provider information.
+1 IF $Y>(IOSL-BMARG-4)
DO HEAD(HAVEPRV)
+2 IF DONE
QUIT
+3 SET TEMP=PPNAME_" - "_OCCUP
+4 SET LEN=$LENGTH(TEMP)
+5 IF LEN>C3HS
Begin DoDot:1
+6 WRITE !,PPNAME," - "
+7 WRITE !?3,OCCUP
+8 IF $LENGTH(SPEC)>0
WRITE !,?4,SPEC
+9 IF $LENGTH(SUBSPEC)>0
WRITE !,?5,SUBSPEC
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 WRITE !,TEMP
+12 IF $LENGTH(SPEC)>0
WRITE !,?4,SPEC
+13 IF $LENGTH(SUBSPEC)>0
WRITE !,?5,SUBSPEC
End DoDot:1
+14 WRITE !
+15 QUIT
+16 ;
+17 ;=======================================================================
SCAT(NVISITS,VISITS) ;Given a list of VISIT IENS return the service categories.
+1 ;
+2 NEW IC,SCATL,VISIT
+3 SET SCATL=""
+4 FOR IC=1:1:NVISITS
Begin DoDot:1
+5 SET VISIT=^AUPNVSIT(VISITS(IC),0)
+6 SET SCATL=$$USTRINS^PXRRGUT(SCATL,$PIECE(VISIT,U,7))
End DoDot:1
+7 QUIT SCATL
+8 ;
