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

LRCAPML3.m

Go to the documentation of this file.
  1. LRCAPML3 ;SLC/AM/DALISC/FHS - WKLD COST REP BY MAJ SCTN; 2/6/91@16:04
  1. ;;5.2;LAB SERVICE;;Sep 27, 1994
  1. EN ;
  1. SUM ;
  1. K LRHDR3
  1. S LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
  1. D HDR^LRCAPU W @LRLAB
  1. S LRMAA=""
  1. F S LRMAA=$O(^TMP("LR-WL",$J,"AA",LRMAA)) Q:(LRMAA="")!(LREND) D
  1. . S LRLSSA=""
  1. . F S LRLSSA=$O(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
  1. I $Y>(IOSL-4) D NPG^LRCAPU Q:LREND W @LRLAB
  1. W !!,"COMBINED GRAND TOTAL",?31,$J(LRGTU,7),?55,$J(LRGT,9,2)
  1. D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
  1. Q
  1. PSUM ;
  1. Q:LREND
  1. S LRX=$G(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0))
  1. Q:'$L(LRX)
  1. I $Y>(IOSL-3) D NPG^LRCAPU Q:LREND W @LRLAB
  1. W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,15)
  1. W ?31,$J($P(LRX,"^",2),7),?45,$J($S(LRGTU:$P(LRX,"^",2)/LRGTU,1:0)*100,5,1)
  1. W ?55,$J($P(LRX,"^",1),9,2)
  1. W ?70,$J($P(LRX,U)/$S(LRGT=0:1,1:LRGT)*100,5,1),!
  1. Q