LRARCML3.m

LRARCML3 ; IHS/DIR/AAB - ARCHIVED WKLD COST REP BY MAJ SCTN ; [ 5/22/95 ]

 ;;5.2;LR;**1002**;JUN 01, 1998

 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995

 ;same as LRCAPML3 except archived wkld data file

EN ;

SUM ;

 K LRHDR3

 S LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?31,""UNIT COUNT"",?45,""  %"",?55,""TOTAL COST"",?70,""  %"",!"

 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 !!,"COMBINED GRAND TOTAL",?31,$J(LRGTU,7),?55,$J(LRGT,9,2)

 D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRARCU W @IOF

 Q

PSUM ;

 Q:LREND

 S LRX=$G(^TMP("LRAR-WL",$J,"AA",LRMAA,LRLSSA,0))

 Q:'$L(LRX)

 I $Y>(IOSL-3) D NPG^LRARCU 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

LRARCML3  ; IHS/DIR/AAB - ARCHIVED WKLD COST REP BY MAJ SCTN ; [ 5/22/95 ]

 +1       ;;5.2;LR;**1002**;JUN 01, 1998

 +2       ;;5.2;LAB SERVICE;**59**;Aug 31, 1995

 +3       ;same as LRCAPML3 except archived wkld data file

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^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 !!,"COMBINED GRAND TOTAL",?31,$JUSTIFY(LRGTU,7),?55,$JUSTIFY(LRGT,9,2)

 +10       IF ($EXTRACT(IOST,1,2)="C-")&('LREND)

               DO PAUSE^LRARCU

           WRITE @IOF

 +11       QUIT 

PSUM      ;

 +1        IF LREND

               QUIT 

 +2        SET LRX=$GET(^TMP("LRAR-WL",$JOB,"AA",LRMAA,LRLSSA,0))

 +3        IF '$LENGTH(LRX)

               QUIT 

 +4        IF $Y>(IOSL-3)

               DO NPG^LRARCU

               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