- LRCAPTS1 ; IHS/DIR/FJE - PRINT TREATING SPECIALTY WKLD REPORT @16:04 ; [ 2/6/91 ]
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- EN ; called by LRCAPTS
- TOP ;
- S LRPAGE=0
- W:$E(IOST)="C" @IOF ;Clear the 'WORKING' dots
- D:'LRSUMM PRN
- D:('LREND)&(LRGTU) SUMM
- Q
- PRN ; PRINT THE REPORT
- S LRLAB="!!!,""TREATING SPECIALTY"_$S($D(LRPTF):" (PTF)",1:"")_" : "",LRTS,!!,""CODE"",?11,""PROCEDURE"",?42,""UNIT COST"",?53,""UNIT COUNT"",?65,""TOTAL COST"""
- D HDR
- I LRGTU=0 D:$Y>(IOSL-6) PG Q:LREND W !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!! D:$E(IOST)="C" WAIT Q:LREND W @IOF Q
- S LRTS=0
- F S LRTS=$O(^TMP($J,"LR-WL",LRTS)) Q:(LRTS="")!(LREND) D TS
- Q:LREND
- D:$Y>(IOSL-6) PG Q:LREND
- W !!,"GRAND TOTAL",?52,$J(LRGTU,7),?65,$J(LRGT,9,2)
- D:$E(IOST)="C" WAIT Q:LREND W @IOF
- Q
- SUMM ;
- S LRLAB="!!,?"_(IOM-7\2)_",""SUMMARY"",!!!,""TREATING SPECIALTY"","_$S($D(LRPTF):""" (PTF) """,1:""" """)_",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
- D HDR
- W @LRLAB
- S LRTS=""
- F S LRTS=$O(^TMP($J,"LR-WL",LRTS)) Q:LRTS=""!(LREND) D PSUM
- Q:LREND
- D:$Y>(IOSL-6) PG Q:LREND
- W !!,"GRAND TOTAL",?31,$J(LRGTU,7),?55,$J(LRGT,9,2)
- D:$E(IOST)="C" WAIT Q:LREND W @IOF
- Q
- PSUM ;
- Q:'$D(^TMP($J,"LR-WL",LRTS,0))#2 S LRX=^(0)
- D:$Y>(IOSL-6) PG Q:LREND
- W !,$E(LRTS,1,30),?31,$J($P(LRX,U,2),7)
- W ?45,$J($S(LRGTU:$P(LRX,U,2)/LRGTU,1:0)*100,5,1),?55,$J($P(LRX,U,1),9,2)
- W ?70,$J($P(LRX,U)/$S(LRGT=0:1,1:LRGT)*100,5,1)
- Q
- TS ;
- D:$Y>(IOSL-6) PG Q:LREND W @LRLAB
- S (LRSTU,LRST,LRCC)=0
- F S LRCC=$O(^TMP($J,"LR-WL",LRTS,LRCC)) Q:(LRCC="")!(LREND) D PCC
- Q:LREND
- S:$D(^TMP($J,"LR-WL",LRTS,0))#2 LRST=$P(^(0),"^"),LRSTU=$P(^(0),"^",2)
- D:$Y>(IOSL-6) PG Q:LREND
- W !!,?40,"SUB TOTAL",?52,$J(LRSTU,7),?65,$J(LRST,9,2)
- Q
- PCC ;
- S LRX="" S:$D(^TMP($J,"LR-WL",LRTS,LRCC))#2 LRX=^(LRCC)
- D:$Y>(IOSL-6) PG Q:LREND
- W !,$P(LRX,U,4),?11,$E(LRCC,1,30),?44,$J(+$P(LRX,U,3),5,2)
- W ?52,$J(+$P(LRX,U),7),?65,$J(+$P(LRX,U,2),9,2)
- Q
- PG ;
- I $E(IOST)="C" D WAIT Q:LREND
- W @IOF D HDR W @LRLAB
- Q
- WAIT ;
- R !,"PRESS RETURN TO CONTINUE, ""^"" TO QUIT. ",LRANS:DTIME
- I ('$T)!(LRANS["^") S LREND=1 Q
- G:LRANS["?" WAIT W @IOF
- Q
- HDR ;
- S LRPAGE=LRPAGE+1
- W !!,?((IOM-34)\2),"TREATING SPECIALTY WORKLOAD REPORT"
- W !!,?((IOM-$L(LRINN))\2),LRINN,?(IOM-10),"PAGE ",LRPAGE
- W !!,?((IOM-(23+$L(LRDT1)+$L(LRDT2)))\2),"REPORT DATE RANGE: "
- W LRDT1," - ",LRDT2
- Q
- LRCAPTS1 ; IHS/DIR/FJE - PRINT TREATING SPECIALTY WKLD REPORT @16:04 ; [ 2/6/91 ]
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- EN ; called by LRCAPTS
- TOP ;
- +1 SET LRPAGE=0
- +2 ;Clear the 'WORKING' dots
- IF $EXTRACT(IOST)="C"
- WRITE @IOF
- +3 IF 'LRSUMM
- DO PRN
- +4 IF ('LREND)&(LRGTU)
- DO SUMM
- +5 QUIT
- PRN ; PRINT THE REPORT
- +1 SET LRLAB="!!!,""TREATING SPECIALTY"_$SELECT($DATA(LRPTF):" (PTF)",1:"")_" : "",LRTS,!!,""CODE"",?11,""PROCEDURE"",?42,""UNIT COST"",?53,""UNIT COUNT"",?65,""TOTAL COST"""
- +2 DO HDR
- +3 IF LRGTU=0
- IF $Y>(IOSL-6)
- DO PG
- IF LREND
- QUIT
- WRITE !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!!
- IF $EXTRACT(IOST)="C"
- DO WAIT
- IF LREND
- QUIT
- WRITE @IOF
- QUIT
- +4 SET LRTS=0
- +5 FOR
- SET LRTS=$ORDER(^TMP($JOB,"LR-WL",LRTS))
- IF (LRTS="")!(LREND)
- QUIT
- DO TS
- +6 IF LREND
- QUIT
- +7 IF $Y>(IOSL-6)
- DO PG
- IF LREND
- QUIT
- +8 WRITE !!,"GRAND TOTAL",?52,$JUSTIFY(LRGTU,7),?65,$JUSTIFY(LRGT,9,2)
- +9 IF $EXTRACT(IOST)="C"
- DO WAIT
- IF LREND
- QUIT
- WRITE @IOF
- +10 QUIT
- SUMM ;
- +1 SET LRLAB="!!,?"_(IOM-7\2)_",""SUMMARY"",!!!,""TREATING SPECIALTY"","_$SELECT($DATA(LRPTF):""" (PTF) """,1:""" """)_",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
- +2 DO HDR
- +3 WRITE @LRLAB
- +4 SET LRTS=""
- +5 FOR
- SET LRTS=$ORDER(^TMP($JOB,"LR-WL",LRTS))
- IF LRTS=""!(LREND)
- QUIT
- DO PSUM
- +6 IF LREND
- QUIT
- +7 IF $Y>(IOSL-6)
- DO PG
- IF LREND
- QUIT
- +8 WRITE !!,"GRAND TOTAL",?31,$JUSTIFY(LRGTU,7),?55,$JUSTIFY(LRGT,9,2)
- +9 IF $EXTRACT(IOST)="C"
- DO WAIT
- IF LREND
- QUIT
- WRITE @IOF
- +10 QUIT
- PSUM ;
- +1 IF '$DATA(^TMP($JOB,"LR-WL",LRTS,0))#2
- QUIT
- SET LRX=^(0)
- +2 IF $Y>(IOSL-6)
- DO PG
- IF LREND
- QUIT
- +3 WRITE !,$EXTRACT(LRTS,1,30),?31,$JUSTIFY($PIECE(LRX,U,2),7)
- +4 WRITE ?45,$JUSTIFY($SELECT(LRGTU:$PIECE(LRX,U,2)/LRGTU,1:0)*100,5,1),?55,$JUSTIFY($PIECE(LRX,U,1),9,2)
- +5 WRITE ?70,$JUSTIFY($PIECE(LRX,U)/$SELECT(LRGT=0:1,1:LRGT)*100,5,1)
- +6 QUIT
- TS ;
- +1 IF $Y>(IOSL-6)
- DO PG
- IF LREND
- QUIT
- WRITE @LRLAB
- +2 SET (LRSTU,LRST,LRCC)=0
- +3 FOR
- SET LRCC=$ORDER(^TMP($JOB,"LR-WL",LRTS,LRCC))
- IF (LRCC="")!(LREND)
- QUIT
- DO PCC
- +4 IF LREND
- QUIT
- +5 IF $DATA(^TMP($JOB,"LR-WL",LRTS,0))#2
- SET LRST=$PIECE(^(0),"^")
- SET LRSTU=$PIECE(^(0),"^",2)
- +6 IF $Y>(IOSL-6)
- DO PG
- IF LREND
- QUIT
- +7 WRITE !!,?40,"SUB TOTAL",?52,$JUSTIFY(LRSTU,7),?65,$JUSTIFY(LRST,9,2)
- +8 QUIT
- PCC ;
- +1 SET LRX=""
- IF $DATA(^TMP($JOB,"LR-WL",LRTS,LRCC))#2
- SET LRX=^(LRCC)
- +2 IF $Y>(IOSL-6)
- DO PG
- IF LREND
- QUIT
- +3 WRITE !,$PIECE(LRX,U,4),?11,$EXTRACT(LRCC,1,30),?44,$JUSTIFY(+$PIECE(LRX,U,3),5,2)
- +4 WRITE ?52,$JUSTIFY(+$PIECE(LRX,U),7),?65,$JUSTIFY(+$PIECE(LRX,U,2),9,2)
- +5 QUIT
- PG ;
- +1 IF $EXTRACT(IOST)="C"
- DO WAIT
- IF LREND
- QUIT
- +2 WRITE @IOF
- DO HDR
- WRITE @LRLAB
- +3 QUIT
- WAIT ;
- +1 READ !,"PRESS RETURN TO CONTINUE, ""^"" TO QUIT. ",LRANS:DTIME
- +2 IF ('$TEST)!(LRANS["^")
- SET LREND=1
- QUIT
- +3 IF LRANS["?"
- GOTO WAIT
- WRITE @IOF
- +4 QUIT
- HDR ;
- +1 SET LRPAGE=LRPAGE+1
- +2 WRITE !!,?((IOM-34)\2),"TREATING SPECIALTY WORKLOAD REPORT"
- +3 WRITE !!,?((IOM-$LENGTH(LRINN))\2),LRINN,?(IOM-10),"PAGE ",LRPAGE
- +4 WRITE !!,?((IOM-(23+$LENGTH(LRDT1)+$LENGTH(LRDT2)))\2),"REPORT DATE RANGE: "
- +5 WRITE LRDT1," - ",LRDT2
- +6 QUIT
