source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPML3.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 973 bytes
RevLine 
[613]1LRCAPML3 ;SLC/AM/DALISC/FHS - WKLD COST REP BY MAJ SCTN; 2/6/91@16:04
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3EN ;
4SUM ;
5 K LRHDR3
6 S LRLAB="!!,?32,""COMBINED SUMMARY"",!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
7 D HDR^LRCAPU W @LRLAB
8 S LRMAA=""
9 F S LRMAA=$O(^TMP("LR-WL",$J,"AA",LRMAA)) Q:(LRMAA="")!(LREND) D
10 . S LRLSSA=""
11 . F S LRLSSA=$O(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
12 I $Y>(IOSL-4) D NPG^LRCAPU Q:LREND W @LRLAB
13 W !!,"COMBINED GRAND TOTAL",?31,$J(LRGTU,7),?55,$J(LRGT,9,2)
14 D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
15 Q
16PSUM ;
17 Q:LREND
18 S LRX=$G(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0))
19 Q:'$L(LRX)
20 I $Y>(IOSL-3) D NPG^LRCAPU Q:LREND W @LRLAB
21 W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,15)
22 W ?31,$J($P(LRX,"^",2),7),?45,$J($S(LRGTU:$P(LRX,"^",2)/LRGTU,1:0)*100,5,1)
23 W ?55,$J($P(LRX,"^",1),9,2)
24 W ?70,$J($P(LRX,U)/$S(LRGT=0:1,1:LRGT)*100,5,1),!
25 Q
Note: See TracBrowser for help on using the repository browser.