LRCAPMA3.m

LRCAPMA3 ; IHS/DIR/FJE - WKLD REPORT BY MAJOR SECTION ; [ 2/6/91 ]

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;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

LRCAPMA3  ; IHS/DIR/FJE - WKLD REPORT BY MAJOR SECTION ; [ 2/6/91 ]

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;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