LRCAPML3 ;SLC/AM/DALISC/FHS - WKLD COST REP BY MAJ SCTN; 2/6/91@16:04
;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
SUM ;
K LRHDR3
S LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
D HDR^LRCAPU W @LRLAB
S LRMAA=""
F S LRMAA=$O(^TMP("LR-WL",$J,"AA",LRMAA)) Q:(LRMAA="")!(LREND) D
. S LRLSSA=""
. F S LRLSSA=$O(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
I $Y>(IOSL-4) D NPG^LRCAPU Q:LREND W @LRLAB
W !!,"COMBINED GRAND TOTAL",?31,$J(LRGTU,7),?55,$J(LRGT,9,2)
D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
Q
PSUM ;
Q:LREND
S LRX=$G(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0))
Q:'$L(LRX)
I $Y>(IOSL-3) D NPG^LRCAPU Q:LREND W @LRLAB
W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,15)
W ?31,$J($P(LRX,"^",2),7),?45,$J($S(LRGTU:$P(LRX,"^",2)/LRGTU,1:0)*100,5,1)
W ?55,$J($P(LRX,"^",1),9,2)
W ?70,$J($P(LRX,U)/$S(LRGT=0:1,1:LRGT)*100,5,1),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPML3 998 printed Nov 22, 2024@17:23:10 Page 2
LRCAPML3 ;SLC/AM/DALISC/FHS - WKLD COST REP BY MAJ SCTN; 2/6/91@16:04
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
SUM ;
+1 KILL LRHDR3
+2 SET LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
+3 DO HDR^LRCAPU
WRITE @LRLAB
+4 SET LRMAA=""
+5 FOR
SET LRMAA=$ORDER(^TMP("LR-WL",$JOB,"AA",LRMAA))
if (LRMAA="")!(LREND)
QUIT
Begin DoDot:1
+6 SET LRLSSA=""
+7 FOR
SET LRLSSA=$ORDER(^TMP("LR-WL",$JOB,"AA",LRMAA,LRLSSA))
if (LRLSSA="")!(LREND)
QUIT
DO PSUM
End DoDot:1
+8 IF $Y>(IOSL-4)
DO NPG^LRCAPU
if LREND
QUIT
WRITE @LRLAB
+9 WRITE !!,"COMBINED GRAND TOTAL",?31,$JUSTIFY(LRGTU,7),?55,$JUSTIFY(LRGT,9,2)
+10 if ($EXTRACT(IOST,1,2)="C-")&('LREND)
DO PAUSE^LRCAPU
WRITE @IOF
+11 QUIT
PSUM ;
+1 if LREND
QUIT
+2 SET LRX=$GET(^TMP("LR-WL",$JOB,"AA",LRMAA,LRLSSA,0))
+3 if '$LENGTH(LRX)
QUIT
+4 IF $Y>(IOSL-3)
DO NPG^LRCAPU
if LREND
QUIT
WRITE @LRLAB
+5 WRITE !,$EXTRACT(LRMAN(LRMAA),1,14),?15,$EXTRACT(LRLSSN(LRLSSA),1,15)
+6 WRITE ?31,$JUSTIFY($PIECE(LRX,"^",2),7),?45,$JUSTIFY($SELECT(LRGTU:$PIECE(LRX,"^",2)/LRGTU,1:0)*100,5,1)
+7 WRITE ?55,$JUSTIFY($PIECE(LRX,"^",1),9,2)
+8 WRITE ?70,$JUSTIFY($PIECE(LRX,U)/$SELECT(LRGT=0:1,1:LRGT)*100,5,1),!
+9 QUIT
