LRCAPML3.m

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 ---LRCAPML3   998     printed  Apr 09, 2024@21:07:55                                                                                                                                                                                                     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