source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARCTS1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

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