- 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 Jan 18, 2025@03:32: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 ;