LRCAPMA3 ;SLC/AM/DALISC/FHS/J0 - WKLD REPORT BY MAJOR SECTION; 2/6/91
;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
SUM ;
K LRHDR3
S LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" CTRL"",?50,""INPAT"",?56,""OUTPAT"",?64,""OTHERS"",?73,"" TOTAL"",!"
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 !!,"GRAND TOTAL",?43,$J(LRCGT,5),?50,$J(LRIGT,5),?57,$J(LROGT,5)
W ?65,$J(LRNGT,5),?73,$J(LRAGT,7)
D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
Q
PSUM ;
Q:LREND
Q:'$D(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0))#2 S LRX=^(0)
I $Y>(IOSL-3) D NPG^LRCAPU 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(LRCCNT,5),?50,$J(LRICNT,5),?57,$J(LROCNT,5)
W ?65,$J(LRNCNT,5),?73,$J(LRACNT,7)
W !,?31,"PERCENT :"
W ?43,$J($S(LRAGT:LRCCNT/LRAGT,1:0)*100,5,1),?50,$J($S(LRAGT:LRICNT/LRAGT,1:0)*100,5,1)
W ?57,$J($S(LRAGT:LROCNT/LRAGT,1:0)*100,5,1),?65,$J($S(LRAGT:LRNCNT/LRAGT,1:0)*100,5,1)
W ?73,$J($S(LRAGT:LRACNT/LRAGT,1:0)*100,7,1)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPMA3 1375 printed Sep 23, 2025@19:48:41 Page 2
LRCAPMA3 ;SLC/AM/DALISC/FHS/J0 - WKLD REPORT BY MAJOR SECTION; 2/6/91
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
SUM ;
+1 KILL LRHDR3
+2 SET LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" CTRL"",?50,""INPAT"",?56,""OUTPAT"",?64,""OTHERS"",?73,"" TOTAL"",!"
+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 !!,"GRAND TOTAL",?43,$JUSTIFY(LRCGT,5),?50,$JUSTIFY(LRIGT,5),?57,$JUSTIFY(LROGT,5)
+10 WRITE ?65,$JUSTIFY(LRNGT,5),?73,$JUSTIFY(LRAGT,7)
+11 if ($EXTRACT(IOST,1,2)="C-")&('LREND)
DO PAUSE^LRCAPU
WRITE @IOF
+12 QUIT
PSUM ;
+1 if LREND
QUIT
+2 if '$DATA(^TMP("LR-WL",$JOB,"AA",LRMAA,LRLSSA,0))#2
QUIT
SET LRX=^(0)
+3 IF $Y>(IOSL-3)
DO NPG^LRCAPU
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(LRCCNT,5),?50,$JUSTIFY(LRICNT,5),?57,$JUSTIFY(LROCNT,5)
+8 WRITE ?65,$JUSTIFY(LRNCNT,5),?73,$JUSTIFY(LRACNT,7)
+9 WRITE !,?31,"PERCENT :"
+10 WRITE ?43,$JUSTIFY($SELECT(LRAGT:LRCCNT/LRAGT,1:0)*100,5,1),?50,$JUSTIFY($SELECT(LRAGT:LRICNT/LRAGT,1:0)*100,5,1)
+11 WRITE ?57,$JUSTIFY($SELECT(LRAGT:LROCNT/LRAGT,1:0)*100,5,1),?65,$JUSTIFY($SELECT(LRAGT:LRNCNT/LRAGT,1:0)*100,5,1)
+12 WRITE ?73,$JUSTIFY($SELECT(LRAGT:LRACNT/LRAGT,1:0)*100,7,1)
+13 WRITE !
+14 QUIT
