- PXRRPRSP ;ISL/PKR - Provider encounter summary print. ;6/03/97
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18**;Aug 12, 1996
- ;
- N BMARG,C1S,C3S,C1HS,C2HS,C3HS,C3HSMAX,DONE,HEAD
- N INDENT,MID,MEWPAGE,PAGE,PCLMAX,PNMAX
- N CLASSNAM,DATE,DAY,DTOTAL,GTOTAL,HLOC
- N FACILITY,FACPNAME,FTOTAL
- N PCLASS,PNAME,PPNAME,PTOTAL
- N 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 PCLMAX=^XTMP(PXRRXTMP,"PCLMAX")
- S PNMAX=^XTMP(PXRRXTMP,"PNMAX")
- S INDENT=3
- S C1HS=INDENT
- S C1S=INDENT
- S C2HS=C1S+PNMAX+1
- S C3HS=C2HS+PCLMAX+3
- S C3HS=$$MAX^XLFMTH((C1HS+45),C3HS)
- S C3HSMAX=C2HS+38
- ;If C3HS>C3HSMAX set it to C3HSMAX+2 and wrap the Person Class entries.
- I C3HS>C3HSMAX S C3HS=C3HSMAX+2
- ;We assume that the counts will never be longer than six digits.
- S MID=C3HS+6
- ;
- S (HEAD,PAGE)=1
- S BMARG=2
- S GTOTAL=0
- D HDR^PXRRGPRT(PAGE)
- W !!,"Criteria for Provider Encounter Summary Report"
- D OPRCRIT^PXRRGPRT(3)
- ;
- SET ;Set up print fields
- S FACILITY=0
- FAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
- I +FACILITY=0 G FINAL
- S FTOTAL=0
- ;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 FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
- S HEAD=1
- D HEAD
- ;
- S PNAME=0
- PRV S PNAME=$O(^XTMP(PXRRXTMP,FACILITY,PNAME))
- I PNAME="" D G FAC
- . I $Y>(IOSL-BMARG-3) D
- .. D PAGE^PXRRGPRT
- .. I 'DONE W !!,"Facility: ",FACPNAME
- . I 'DONE D
- .. S TEMP="Total facility encounters "
- .. D PTOTAL^PXRRGPRT(TEMP,FTOTAL,MID,1)
- .. S GTOTAL=GTOTAL+FTOTAL
- .. I $D(PXRRPECL) D CLASSNE^PXRRGPRT(INDENT)
- I DONE G END
- S PPNAME=$P(PNAME,U,1)
- ;
- ;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 S PCLASS=$$OCCUP^PXBGPRV("","",VACODE,1)
- E S PCLASS=-3
- ;If were are doing selected person classes keep track of the ones we
- ;found.
- I $D(PXRRPECL) S TEMP=$$MATCH^PXRRPECU(PCLASS)
- S DATE=0
- ;
- DATE ;
- S DTOTAL=0
- S DATE=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
- I DATE="" D G CLASS
- .;Print the provider totals.
- . D SPRINT(.PTOTAL)
- . 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
- S TEMP="Total encounters "
- I $Y>(IOSL-BMARG-3) D
- . D PAGE^PXRRGPRT
- . I 'DONE W !
- I 'DONE D
- . D PTOTAL^PXRRGPRT(TEMP,GTOTAL,MID,0)
- . D FACNE^PXRRGPRT(INDENT)
- END ;
- D EXIT^PXRRGUT
- D EOR^PXRRGUT
- Q
- ;
- ;=======================================================================
- FMTPCL(PCL,START,END,PCL1,PCL2) ;Format the abbreviated Person Class, PCL so
- ;that it fits between START and END. If it is too long break it into
- ;two lines, PCL1 and PCL2.
- N LBC,LEN,LPLUS,LSPACE,MAXLEN
- S MAXLEN=END-START
- S LEN=$L(PCL)
- I LEN'>MAXLEN D Q
- . S PCL1="("_PCL_")"
- ;PCL is too long to fit on one line find a plus or a space to make the
- ;break.
- S LSPACE=$$LASTCHAR(PCL," ",MAXLEN)
- S LPLUS=$$LASTCHAR(PCL,"+",MAXLEN)
- S LBC=$$MAX^XLFMTH(LPLUS,LSPACE)
- S PCL1="("_$E(PCL,1,LBC)
- S PCL2=" "_$E(PCL,LBC+1,LEN)_")"
- Q
- ;
- ;=======================================================================
- HEAD ;If necessary, write the header.
- I HEAD D
- . I $Y>(IOSL-BMARG-7) D PAGE^PXRRGPRT
- . I DONE Q
- . W !!,"Facility: ",FACPNAME
- . W !!,?(C1HS+20),"Person Class"
- . W !,?C1HS,"Provider (Occupation+Specialty+Subspecialty)",?C3HS,"Encounters"
- . W !,?C1HS,"--------------------------------------------",?C3HS,"----------"
- . S HEAD=0
- Q
- ;
- ;=======================================================================
- LASTCHAR(STRING,CHAR,MAX) ;Return the position of the last character, CHAR, in
- ;STRING ensuring that it is less than MAX.
- ;Return 0 if there are none.
- N IC0,IC1
- S IC0=$F(STRING,CHAR)
- I IC0=0 Q 0
- F S IC1=$F(STRING,CHAR,IC0) Q:(IC1=0)!(IC1>MAX) D
- . S IC0=IC1
- Q IC0-1
- ;
- ;=======================================================================
- SPRINT(PTOTAL) ;Print the provider total and return the total.
- N DAY,END,HLOC,PCL1,PCL2,TEMP,VACODE,VIEN
- S PTOTAL=0
- S DAY=0
- NDAY S DAY=$O(^TMP(PXRRXTMP,$J,PNAME,DAY))
- I DAY="" D Q
- .;No more DAYs to sum over print the total.
- . I $Y>(IOSL-BMARG-1) D
- .. D PAGE^PXRRGPRT
- .. D HEAD
- . I 'DONE D
- .. S C3S=MID-$L(PTOTAL)
- .. S VACODE=$P(CLASSNAM,U,2)
- .. S TEMP=$$ABBRV^PXRRPECU(VACODE)
- .. D FMTPCL(TEMP,C2HS,C3HSMAX,.PCL1,.PCL2)
- .. W !,?C1S,PPNAME,?C2HS,PCL1,?C3S,PTOTAL
- .. I $D(PCL2) W !,?C2HS,PCL2
- I DONE Q
- ;
- S HLOC=""
- NHLOC S HLOC=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC))
- I HLOC="" G NDAY
- ;
- S VIEN=0
- NVIEN S VIEN=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN))
- I VIEN="" G NHLOC
- S PTOTAL=PTOTAL+1
- G NVIEN
- ;
- PXRRPRSP ;ISL/PKR - Provider encounter summary print. ;6/03/97
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18**;Aug 12, 1996
- +2 ;
- +3 NEW BMARG,C1S,C3S,C1HS,C2HS,C3HS,C3HSMAX,DONE,HEAD
- +4 NEW INDENT,MID,MEWPAGE,PAGE,PCLMAX,PNMAX
- +5 NEW CLASSNAM,DATE,DAY,DTOTAL,GTOTAL,HLOC
- +6 NEW FACILITY,FACPNAME,FTOTAL
- +7 NEW PCLASS,PNAME,PPNAME,PTOTAL
- +8 NEW 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 PCLMAX=^XTMP(PXRRXTMP,"PCLMAX")
- +17 SET PNMAX=^XTMP(PXRRXTMP,"PNMAX")
- +18 SET INDENT=3
- +19 SET C1HS=INDENT
- +20 SET C1S=INDENT
- +21 SET C2HS=C1S+PNMAX+1
- +22 SET C3HS=C2HS+PCLMAX+3
- +23 SET C3HS=$$MAX^XLFMTH((C1HS+45),C3HS)
- +24 SET C3HSMAX=C2HS+38
- +25 ;If C3HS>C3HSMAX set it to C3HSMAX+2 and wrap the Person Class entries.
- +26 IF C3HS>C3HSMAX
- SET C3HS=C3HSMAX+2
- +27 ;We assume that the counts will never be longer than six digits.
- +28 SET MID=C3HS+6
- +29 ;
- +30 SET (HEAD,PAGE)=1
- +31 SET BMARG=2
- +32 SET GTOTAL=0
- +33 DO HDR^PXRRGPRT(PAGE)
- +34 WRITE !!,"Criteria for Provider Encounter Summary Report"
- +35 DO OPRCRIT^PXRRGPRT(3)
- +36 ;
- SET ;Set up print fields
- +1 SET FACILITY=0
- FAC SET FACILITY=$ORDER(^XTMP(PXRRXTMP,FACILITY))
- +1 IF +FACILITY=0
- GOTO FINAL
- +2 SET FTOTAL=0
- +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 FACPNAME=$PIECE(PXRRFACN(FACILITY),U,1)_" "_$PIECE(PXRRFACN(FACILITY),U,2)
- +7 SET HEAD=1
- +8 DO HEAD
- +9 ;
- +10 SET PNAME=0
- PRV SET PNAME=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME))
- +1 IF PNAME=""
- Begin DoDot:1
- +2 IF $Y>(IOSL-BMARG-3)
- Begin DoDot:2
- +3 DO PAGE^PXRRGPRT
- +4 IF 'DONE
- WRITE !!,"Facility: ",FACPNAME
- End DoDot:2
- +5 IF 'DONE
- Begin DoDot:2
- +6 SET TEMP="Total facility encounters "
- +7 DO PTOTAL^PXRRGPRT(TEMP,FTOTAL,MID,1)
- +8 SET GTOTAL=GTOTAL+FTOTAL
- +9 IF $DATA(PXRRPECL)
- DO CLASSNE^PXRRGPRT(INDENT)
- End DoDot:2
- End DoDot:1
- GOTO FAC
- +10 IF DONE
- GOTO END
- +11 SET PPNAME=$PIECE(PNAME,U,1)
- +12 ;
- +13 ;Check for a user request to stop the task.
- +14 IF $$S^%ZTLOAD
- SET ZTSTOP=1
- DO EXIT^PXRRGUT
- +15 ;
- +16 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
- SET PCLASS=$$OCCUP^PXBGPRV("","",VACODE,1)
- +7 IF '$TEST
- SET PCLASS=-3
- +8 ;If were are doing selected person classes keep track of the ones we
- +9 ;found.
- +10 IF $DATA(PXRRPECL)
- SET TEMP=$$MATCH^PXRRPECU(PCLASS)
- +11 SET DATE=0
- +12 ;
- DATE ;
- +1 SET DTOTAL=0
- +2 SET DATE=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
- +3 IF DATE=""
- Begin DoDot:1
- +4 ;Print the provider totals.
- +5 DO SPRINT(.PTOTAL)
- +6 SET FTOTAL=FTOTAL+PTOTAL
- End DoDot:1
- GOTO CLASS
- +7 IF DONE
- GOTO END
- +8 ;
- +9 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 ;
- +9 GOTO HLO
- +10 ;
- FINAL ;Print grand totals
- +1 SET TEMP="Total encounters "
- +2 IF $Y>(IOSL-BMARG-3)
- Begin DoDot:1
- +3 DO PAGE^PXRRGPRT
- +4 IF 'DONE
- WRITE !
- End DoDot:1
- +5 IF 'DONE
- Begin DoDot:1
- +6 DO PTOTAL^PXRRGPRT(TEMP,GTOTAL,MID,0)
- +7 DO FACNE^PXRRGPRT(INDENT)
- End DoDot:1
- END ;
- +1 DO EXIT^PXRRGUT
- +2 DO EOR^PXRRGUT
- +3 QUIT
- +4 ;
- +5 ;=======================================================================
- FMTPCL(PCL,START,END,PCL1,PCL2) ;Format the abbreviated Person Class, PCL so
- +1 ;that it fits between START and END. If it is too long break it into
- +2 ;two lines, PCL1 and PCL2.
- +3 NEW LBC,LEN,LPLUS,LSPACE,MAXLEN
- +4 SET MAXLEN=END-START
- +5 SET LEN=$LENGTH(PCL)
- +6 IF LEN'>MAXLEN
- Begin DoDot:1
- +7 SET PCL1="("_PCL_")"
- End DoDot:1
- QUIT
- +8 ;PCL is too long to fit on one line find a plus or a space to make the
- +9 ;break.
- +10 SET LSPACE=$$LASTCHAR(PCL," ",MAXLEN)
- +11 SET LPLUS=$$LASTCHAR(PCL,"+",MAXLEN)
- +12 SET LBC=$$MAX^XLFMTH(LPLUS,LSPACE)
- +13 SET PCL1="("_$EXTRACT(PCL,1,LBC)
- +14 SET PCL2=" "_$EXTRACT(PCL,LBC+1,LEN)_")"
- +15 QUIT
- +16 ;
- +17 ;=======================================================================
- HEAD ;If necessary, write the header.
- +1 IF HEAD
- Begin DoDot:1
- +2 IF $Y>(IOSL-BMARG-7)
- DO PAGE^PXRRGPRT
- +3 IF DONE
- QUIT
- +4 WRITE !!,"Facility: ",FACPNAME
- +5 WRITE !!,?(C1HS+20),"Person Class"
- +6 WRITE !,?C1HS,"Provider (Occupation+Specialty+Subspecialty)",?C3HS,"Encounters"
- +7 WRITE !,?C1HS,"--------------------------------------------",?C3HS,"----------"
- +8 SET HEAD=0
- End DoDot:1
- +9 QUIT
- +10 ;
- +11 ;=======================================================================
- LASTCHAR(STRING,CHAR,MAX) ;Return the position of the last character, CHAR, in
- +1 ;STRING ensuring that it is less than MAX.
- +2 ;Return 0 if there are none.
- +3 NEW IC0,IC1
- +4 SET IC0=$FIND(STRING,CHAR)
- +5 IF IC0=0
- QUIT 0
- +6 FOR
- SET IC1=$FIND(STRING,CHAR,IC0)
- IF (IC1=0)!(IC1>MAX)
- QUIT
- Begin DoDot:1
- +7 SET IC0=IC1
- End DoDot:1
- +8 QUIT IC0-1
- +9 ;
- +10 ;=======================================================================
- SPRINT(PTOTAL) ;Print the provider total and return the total.
- +1 NEW DAY,END,HLOC,PCL1,PCL2,TEMP,VACODE,VIEN
- +2 SET PTOTAL=0
- +3 SET DAY=0
- NDAY SET DAY=$ORDER(^TMP(PXRRXTMP,$JOB,PNAME,DAY))
- +1 IF DAY=""
- Begin DoDot:1
- +2 ;No more DAYs to sum over print the total.
- +3 IF $Y>(IOSL-BMARG-1)
- Begin DoDot:2
- +4 DO PAGE^PXRRGPRT
- +5 DO HEAD
- End DoDot:2
- +6 IF 'DONE
- Begin DoDot:2
- +7 SET C3S=MID-$LENGTH(PTOTAL)
- +8 SET VACODE=$PIECE(CLASSNAM,U,2)
- +9 SET TEMP=$$ABBRV^PXRRPECU(VACODE)
- +10 DO FMTPCL(TEMP,C2HS,C3HSMAX,.PCL1,.PCL2)
- +11 WRITE !,?C1S,PPNAME,?C2HS,PCL1,?C3S,PTOTAL
- +12 IF $DATA(PCL2)
- WRITE !,?C2HS,PCL2
- End DoDot:2
- End DoDot:1
- QUIT
- +13 IF DONE
- QUIT
- +14 ;
- +15 SET HLOC=""
- NHLOC SET HLOC=$ORDER(^TMP(PXRRXTMP,$JOB,PNAME,DAY,HLOC))
- +1 IF HLOC=""
- GOTO NDAY
- +2 ;
- +3 SET VIEN=0
- NVIEN SET VIEN=$ORDER(^TMP(PXRRXTMP,$JOB,PNAME,DAY,HLOC,VIEN))
- +1 IF VIEN=""
- GOTO NHLOC
- +2 SET PTOTAL=PTOTAL+1
- +3 GOTO NVIEN
- +4 ;
