source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPTS1.m@ 1093

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1LRCAPTS1 ;SLC/AM/DALISC/FHS - PRINT TREATING SPECIALTY WKLD REPORT; 2/6/91@16:04
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3EN ; called by LRCAPTS
4TOP ;
5 S LRPAGE=0
6 W:$E(IOST)="C" @IOF ;Clear the 'WORKING' dots
7 D:'LRSUMM PRN
8 D:('LREND)&(LRGTU) SUMM
9 Q
10PRN ; PRINT THE REPORT
11 S LRLAB="!!!,""TREATING SPECIALTY"_$S($D(LRPTF):" (PTF)",1:"")_" : "",LRTS,!!,""CODE"",?11,""PROCEDURE"",?42,""UNIT COST"",?53,""UNIT COUNT"",?65,""TOTAL COST"""
12 D HDR
13 I LRGTU=0 D:$Y>(IOSL-6) PG Q:LREND W !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!! D:$E(IOST)="C" WAIT Q:LREND W @IOF Q
14 S LRTS=0
15 F S LRTS=$O(^TMP($J,"LR-WL",LRTS)) Q:(LRTS="")!(LREND) D TS
16 Q:LREND
17 D:$Y>(IOSL-6) PG Q:LREND
18 W !!,"GRAND TOTAL",?52,$J(LRGTU,7),?65,$J(LRGT,9,2)
19 D:$E(IOST)="C" WAIT Q:LREND W @IOF
20 Q
21SUMM ;
22 S LRLAB="!!,?"_(IOM-7\2)_",""SUMMARY"",!!!,""TREATING SPECIALTY"","_$S($D(LRPTF):""" (PTF) """,1:""" """)_",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
23 D HDR
24 W @LRLAB
25 S LRTS=""
26 F S LRTS=$O(^TMP($J,"LR-WL",LRTS)) Q:LRTS=""!(LREND) D PSUM
27 Q:LREND
28 D:$Y>(IOSL-6) PG Q:LREND
29 W !!,"GRAND TOTAL",?31,$J(LRGTU,7),?55,$J(LRGT,9,2)
30 D:$E(IOST)="C" WAIT Q:LREND W @IOF
31 Q
32PSUM ;
33 Q:'$D(^TMP($J,"LR-WL",LRTS,0))#2 S LRX=^(0)
34 D:$Y>(IOSL-6) PG Q:LREND
35 W !,$E(LRTS,1,30),?31,$J($P(LRX,U,2),7)
36 W ?45,$J($S(LRGTU:$P(LRX,U,2)/LRGTU,1:0)*100,5,1),?55,$J($P(LRX,U,1),9,2)
37 W ?70,$J($P(LRX,U)/$S(LRGT=0:1,1:LRGT)*100,5,1)
38 Q
39TS ;
40 D:$Y>(IOSL-6) PG Q:LREND W @LRLAB
41 S (LRSTU,LRST,LRCC)=0
42 F S LRCC=$O(^TMP($J,"LR-WL",LRTS,LRCC)) Q:(LRCC="")!(LREND) D PCC
43 Q:LREND
44 S:$D(^TMP($J,"LR-WL",LRTS,0))#2 LRST=$P(^(0),"^"),LRSTU=$P(^(0),"^",2)
45 D:$Y>(IOSL-6) PG Q:LREND
46 W !!,?40,"SUB TOTAL",?52,$J(LRSTU,7),?65,$J(LRST,9,2)
47 Q
48PCC ;
49 S LRX="" S:$D(^TMP($J,"LR-WL",LRTS,LRCC))#2 LRX=^(LRCC)
50 D:$Y>(IOSL-6) PG Q:LREND
51 W !,$P(LRX,U,4),?11,$E(LRCC,1,30),?44,$J(+$P(LRX,U,3),5,2)
52 W ?52,$J(+$P(LRX,U),7),?65,$J(+$P(LRX,U,2),9,2)
53 Q
54PG ;
55 I $E(IOST)="C" D WAIT Q:LREND
56 W @IOF D HDR W @LRLAB
57 Q
58WAIT ;
59 R !,"PRESS RETURN TO CONTINUE, ""^"" TO QUIT. ",LRANS:DTIME
60 I ('$T)!(LRANS["^") S LREND=1 Q
61 G:LRANS["?" WAIT W @IOF
62 Q
63HDR ;
64 S LRPAGE=LRPAGE+1
65 W !!,?((IOM-34)\2),"TREATING SPECIALTY WORKLOAD REPORT"
66 W !!,?((IOM-$L(LRINN))\2),LRINN,?(IOM-10),"PAGE ",LRPAGE
67 W !!,?((IOM-(23+$L(LRDT1)+$L(LRDT2)))\2),"REPORT DATE RANGE: "
68 W LRDT1," - ",LRDT2
69 Q
Note: See TracBrowser for help on using the repository browser.