| 1 | LRARCTS1 ;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
|
|---|
| 4 | EN ; called by LRARCPTS
|
|---|
| 5 | TOP ;
|
|---|
| 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
|
|---|
| 11 | PRN ; 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
|
|---|
| 22 | SUMM ;
|
|---|
| 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
|
|---|
| 33 | PSUM ;
|
|---|
| 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
|
|---|
| 40 | TS ;
|
|---|
| 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
|
|---|
| 49 | PCC ;
|
|---|
| 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
|
|---|
| 55 | PG ;
|
|---|
| 56 | I $E(IOST)="C" D WAIT Q:LREND
|
|---|
| 57 | W @IOF D HDR W @LRLAB
|
|---|
| 58 | Q
|
|---|
| 59 | WAIT ;
|
|---|
| 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
|
|---|
| 64 | HDR ;
|
|---|
| 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
|
|---|
