71 lines
2.4 KiB
Mathematica
71 lines
2.4 KiB
Mathematica
LRARCTS1 ;DALISC/CKA - PRINT TREATING SPECIALTY ARCHIVED WKLD REPORT; 6/1/95
|
|
;;5.2;LAB SERVICE;**59**;Aug 31, 1995
|
|
;same as LRCAPTS1 except archived wkld file
|
|
EN ; called by LRARCPTS
|
|
TOP ;
|
|
S LRPAGE=0
|
|
W:$E(IOST)="C" @IOF ;Clear the 'WORKING' dots
|
|
D:'LRSUMM PRN
|
|
D:('LREND)&(LRGTU) SUMM
|
|
Q
|
|
PRN ; PRINT THE REPORT
|
|
S LRLAB="!!!,""TREATING SPECIALTY"_$S($D(LRPTF):" (PTF)",1:"")_" : "",LRTS,!!,""CODE"",?11,""PROCEDURE"",?42,""UNIT COST"",?53,""UNIT COUNT"",?65,""TOTAL COST"""
|
|
D HDR
|
|
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
|
|
S LRTS=0
|
|
F S LRTS=$O(^TMP($J,"LRAR-WL",LRTS)) Q:(LRTS="")!(LREND) D TS
|
|
Q:LREND
|
|
D:$Y>(IOSL-6) PG Q:LREND
|
|
W !!,"GRAND TOTAL",?52,$J(LRGTU,7),?65,$J(LRGT,9,2)
|
|
D:$E(IOST)="C" WAIT Q:LREND W @IOF
|
|
Q
|
|
SUMM ;
|
|
S LRLAB="!!,?"_(IOM-7\2)_",""SUMMARY"",!!!,""TREATING SPECIALTY"","_$S($D(LRPTF):""" (PTF) """,1:""" """)_",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
|
|
D HDR
|
|
W @LRLAB
|
|
S LRTS=""
|
|
F S LRTS=$O(^TMP($J,"LRAR-WL",LRTS)) Q:LRTS=""!(LREND) D PSUM
|
|
Q:LREND
|
|
D:$Y>(IOSL-6) PG Q:LREND
|
|
W !!,"GRAND TOTAL",?31,$J(LRGTU,7),?55,$J(LRGT,9,2)
|
|
D:$E(IOST)="C" WAIT Q:LREND W @IOF
|
|
Q
|
|
PSUM ;
|
|
Q:'$D(^TMP($J,"LRAR-WL",LRTS,0))#2 S LRX=^(0)
|
|
D:$Y>(IOSL-6) PG Q:LREND
|
|
W !,$E(LRTS,1,30),?31,$J($P(LRX,U,2),7)
|
|
W ?45,$J($S(LRGTU:$P(LRX,U,2)/LRGTU,1:0)*100,5,1),?55,$J($P(LRX,U,1),9,2)
|
|
W ?70,$J($P(LRX,U)/$S(LRGT=0:1,1:LRGT)*100,5,1)
|
|
Q
|
|
TS ;
|
|
D:$Y>(IOSL-6) PG Q:LREND W @LRLAB
|
|
S (LRSTU,LRST,LRCC)=0
|
|
F S LRCC=$O(^TMP($J,"LRAR-WL",LRTS,LRCC)) Q:(LRCC="")!(LREND) D PCC
|
|
Q:LREND
|
|
S:$D(^TMP($J,"LRAR-WL",LRTS,0))#2 LRST=$P(^(0),"^"),LRSTU=$P(^(0),"^",2)
|
|
D:$Y>(IOSL-6) PG Q:LREND
|
|
W !!,?40,"SUB TOTAL",?52,$J(LRSTU,7),?65,$J(LRST,9,2)
|
|
Q
|
|
PCC ;
|
|
S LRX="" S:$D(^TMP($J,"LRAR-WL",LRTS,LRCC))#2 LRX=^(LRCC)
|
|
D:$Y>(IOSL-6) PG Q:LREND
|
|
W !,$P(LRX,U,4),?11,$E(LRCC,1,30),?44,$J(+$P(LRX,U,3),5,2)
|
|
W ?52,$J(+$P(LRX,U),7),?65,$J(+$P(LRX,U,2),9,2)
|
|
Q
|
|
PG ;
|
|
I $E(IOST)="C" D WAIT Q:LREND
|
|
W @IOF D HDR W @LRLAB
|
|
Q
|
|
WAIT ;
|
|
R !,"PRESS RETURN TO CONTINUE, ""^"" TO QUIT. ",LRANS:DTIME
|
|
I ('$T)!(LRANS["^") S LREND=1 Q
|
|
G:LRANS["?" WAIT W @IOF
|
|
Q
|
|
HDR ;
|
|
S LRPAGE=LRPAGE+1
|
|
W !!,?((IOM-34)\2),"TREATING SPECIALTY ARCHIVED WORKLOAD REPORT"
|
|
W !!,?((IOM-$L(LRINN))\2),LRINN,?(IOM-10),"PAGE ",LRPAGE
|
|
W !!,?((IOM-(23+$L(LRDT1)+$L(LRDT2)))\2),"REPORT DATE RANGE: "
|
|
W LRDT1," - ",LRDT2
|
|
Q
|