source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARCML3.m@ 1574

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

initial load of WorldVistAEHR

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