- 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 Feb 18, 2025@23:38:58 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