| 1 | LRCAPTS1 ;SLC/AM/DALISC/FHS - PRINT TREATING SPECIALTY WKLD REPORT; 2/6/91@16:04
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | EN ; called by LRCAPTS
|
|---|
| 4 | TOP ;
|
|---|
| 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
|
|---|
| 10 | PRN ; 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
|
|---|
| 21 | SUMM ;
|
|---|
| 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
|
|---|
| 32 | PSUM ;
|
|---|
| 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
|
|---|
| 39 | TS ;
|
|---|
| 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
|
|---|
| 48 | PCC ;
|
|---|
| 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
|
|---|
| 54 | PG ;
|
|---|
| 55 | I $E(IOST)="C" D WAIT Q:LREND
|
|---|
| 56 | W @IOF D HDR W @LRLAB
|
|---|
| 57 | Q
|
|---|
| 58 | WAIT ;
|
|---|
| 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
|
|---|
| 63 | HDR ;
|
|---|
| 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
|
|---|
