LRARCMA3 ;DALISC/CKA - ARCHIVED WKLD REPORT BY MAJOR SECTION; 6/1/95
;;5.2;LAB SERVICE;**59**;Aug 31,1995
;same as LRCAPMA3 except archived wkld file
EN ;
SUM ;
K LRHDR3
S LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" TOTAL"",!"
D HDR^LRARCU W @LRLAB
S LRMAA=""
F S LRMAA=$O(^TMP("LRAR-WL",$J,"AA",LRMAA)) Q:(LRMAA="")!(LREND) D
. S LRLSSA=""
. F S LRLSSA=$O(^TMP("LRAR-WL",$J,"AA",LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
I $Y>(IOSL-4) D NPG^LRARCU Q:LREND W @LRLAB
W !!,"GRAND TOTAL",?43,$J(LRAGT,7)
D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRARCU W @IOF
Q
PSUM ;
Q:LREND
Q:'$D(^TMP("LRAR-WL",$J,"AA",LRMAA,LRLSSA,0))#2 S LRX=^(0)
I $Y>(IOSL-3) D NPG^LRARCU Q:LREND W @LRLAB
S LRCCNT=+$P(LRX,U),LRICNT=+$P(LRX,U,2),LROCNT=+$P(LRX,U,3)
S LRNCNT=+$P(LRX,U,4),LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,14),?31,"NUMBER :"
W ?43,$J(LRACNT,7)
W !,?31,"PERCENT :"
W ?43,$J($S(LRAGT:LRACNT/LRAGT,1:0)*100,7,1)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCMA3 1053 printed Oct 16, 2024@18:09:53 Page 2
LRARCMA3 ;DALISC/CKA - ARCHIVED WKLD REPORT BY MAJOR SECTION; 6/1/95
+1 ;;5.2;LAB SERVICE;**59**;Aug 31,1995
+2 ;same as LRCAPMA3 except archived wkld file
EN ;
SUM ;
+1 KILL LRHDR3
+2 SET LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" TOTAL"",!"
+3 DO HDR^LRARCU
WRITE @LRLAB
+4 SET LRMAA=""
+5 FOR
SET LRMAA=$ORDER(^TMP("LRAR-WL",$JOB,"AA",LRMAA))
if (LRMAA="")!(LREND)
QUIT
Begin DoDot:1
+6 SET LRLSSA=""
+7 FOR
SET LRLSSA=$ORDER(^TMP("LRAR-WL",$JOB,"AA",LRMAA,LRLSSA))
if (LRLSSA="")!(LREND)
QUIT
DO PSUM
End DoDot:1
+8 IF $Y>(IOSL-4)
DO NPG^LRARCU
if LREND
QUIT
WRITE @LRLAB
+9 WRITE !!,"GRAND TOTAL",?43,$JUSTIFY(LRAGT,7)
+10 if ($EXTRACT(IOST,1,2)="C-")&('LREND)
DO PAUSE^LRARCU
WRITE @IOF
+11 QUIT
PSUM ;
+1 if LREND
QUIT
+2 if '$DATA(^TMP("LRAR-WL",$JOB,"AA",LRMAA,LRLSSA,0))#2
QUIT
SET LRX=^(0)
+3 IF $Y>(IOSL-3)
DO NPG^LRARCU
if LREND
QUIT
WRITE @LRLAB
+4 SET LRCCNT=+$PIECE(LRX,U)
SET LRICNT=+$PIECE(LRX,U,2)
SET LROCNT=+$PIECE(LRX,U,3)
+5 SET LRNCNT=+$PIECE(LRX,U,4)
SET LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
+6 WRITE !,$EXTRACT(LRMAN(LRMAA),1,14),?15,$EXTRACT(LRLSSN(LRLSSA),1,14),?31,"NUMBER :"
+7 WRITE ?43,$JUSTIFY(LRACNT,7)
+8 WRITE !,?31,"PERCENT :"
+9 WRITE ?43,$JUSTIFY($SELECT(LRAGT:LRACNT/LRAGT,1:0)*100,7,1)
+10 WRITE !
+11 QUIT
