Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRCAPMA3

LRCAPMA3.m

Go to the documentation of this file.
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