LRARCTS1 ;DALISC/CKA - PRINT TREATING SPECIALTY ARCHIVED WKLD REPORT; 6/1/95
 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
 ;same as LRCAPTS1 except archived wkld file
EN ; called by LRARCPTS
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,"LRAR-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,"LRAR-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,"LRAR-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,"LRAR-WL",LRTS,LRCC)) Q:(LRCC="")!(LREND)  D PCC
 Q:LREND
 S:$D(^TMP($J,"LRAR-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,"LRAR-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 ARCHIVED 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