LRRP6A2 ;DALISC/J0/DRH - LAB TEST SUMMARY REPORT-CONDENSED ;11/27/92
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
COND ;
N LRLINE
S $P(LRLINE,"-",IOM)="-"
D TEST Q:LREND
D WKLD
Q
TEST ;
S LRSUBH="Lab Test/WKLD Code Summary"
D HDR
W !!,LRSUBH,!,$E(LRDASH,1,IOM)
S LRTNAM=""
F S LRTNAM=$O(^TMP("LR",$J,"TST",LRTNAM)) Q:(LREND)!(LRTNAM="") D
. I $Y+7>IOSL D
. . D:$E(IOST,1,2)="C-" PAUSE Q:LREND
. . W @IOF D HDR W !!,LRSUBH_" ** cont. **",!,$E(LRDASH,1,IOM)
. Q:LREND
. W !,$E(LRTNAM,1,12)
. S LRFIRST=1 D CAP
I '$D(^TMP("LR",$J,"TST")) S LRTIC=" Test " D NODATA S LREND=1 QUIT
Q:LREND
W LRDASH
W !!,"TOTAL",?74,$J(^TMP("LR",$J,"TST"),6)
D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF
Q
CAP ;
S LRCAPNAM=""
F S LRCAPNAM=$O(^TMP("LR",$J,"TST",LRTNAM,LRCAPNAM)) Q:(LREND)!(LRCAPNAM="") D
. I $Y+6>IOSL D
. . D:$E(IOST,1,2)="C-" PAUSE Q:LREND
. . W @IOF D HDR W !!,LRSUBH_" ** cont. **",!,$E(LRDASH,1,IOM)
. . W !,LRTNAM
. . S LRFIRST=1
. Q:LREND
. W:'LRFIRST !
. S:LRFIRST LRFIRST=0
. W ?9,$E(LRCAPNAM,1,50),?62,$J(LRCC(LRCAPNAM),12,4)
. W ?74,$J(^TMP("LR",$J,"TST",LRTNAM,LRCAPNAM),6)
Q:LREND
W !,LRLINE
W !,"SUBTOTAL",?74,$J(^TMP("LR",$J,"TST",LRTNAM),6),!
Q
WKLD ;
S LRSUBH="WKLD Code Summary"
D HDR
W !!,LRSUBH,!,$E(LRDASH,1,IOM)
S LRCAPNAM=""
F S LRCAPNAM=$O(^TMP("LR",$J,"WKLD",LRCAPNAM)) Q:(LREND)!(LRCAPNAM="") D
. I $Y+6>IOSL D
. . D:$E(IOST,1,2)="C-" PAUSE Q:LREND
. . W @IOF D HDR W !!,LRSUBH_" ** cont. **",!,$E(LRDASH,1,IOM)
. Q:LREND
. W !,LRCAPNAM,?55,$J(LRCC(LRCAPNAM),12,4)
. W ?70,$J(^TMP("LR",$J,"WKLD",LRCAPNAM),6)
Q:LREND
I '$D(^TMP("LR",$J,"WKLD")) S LRTIC=" Workload " D NODATA QUIT
W !,$E(LRDASH,1,IOM)
W !!,"TOTAL",?70,$J(^TMP("LR",$J),6)
Q
HDR ;
S LRPAG=LRPAG+1
W !!,"Detailed AUDIT REPORT (by Test) for ",LRDATRNG
W ?(62),LRDAT,?(72)," PAGE ",LRPAG
W !,"Accession Area: ",LRX
W !!,$E(LRSTAR,1,34)," CONDENSED ",$E(LRSTAR,1,33)
Q
NODATA ;
W !!,"No",LRTIC,"data for this date range.",!!!
D PAUSE
Q
PAUSE ;
K DIR S DIR(0)="E" D ^DIR
S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRP6A2 2165 printed Sep 23, 2025@19:55:38 Page 2
LRRP6A2 ;DALISC/J0/DRH - LAB TEST SUMMARY REPORT-CONDENSED ;11/27/92
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
COND ;
+1 NEW LRLINE
+2 SET $PIECE(LRLINE,"-",IOM)="-"
+3 DO TEST
if LREND
QUIT
+4 DO WKLD
+5 QUIT
TEST ;
+1 SET LRSUBH="Lab Test/WKLD Code Summary"
+2 DO HDR
+3 WRITE !!,LRSUBH,!,$EXTRACT(LRDASH,1,IOM)
+4 SET LRTNAM=""
+5 FOR
SET LRTNAM=$ORDER(^TMP("LR",$JOB,"TST",LRTNAM))
if (LREND)!(LRTNAM="")
QUIT
Begin DoDot:1
+6 IF $Y+7>IOSL
Begin DoDot:2
+7 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
+8 WRITE @IOF
DO HDR
WRITE !!,LRSUBH_" ** cont. **",!,$EXTRACT(LRDASH,1,IOM)
End DoDot:2
+9 if LREND
QUIT
+10 WRITE !,$EXTRACT(LRTNAM,1,12)
+11 SET LRFIRST=1
DO CAP
End DoDot:1
+12 IF '$DATA(^TMP("LR",$JOB,"TST"))
SET LRTIC=" Test "
DO NODATA
SET LREND=1
QUIT
+13 if LREND
QUIT
+14 WRITE LRDASH
+15 WRITE !!,"TOTAL",?74,$JUSTIFY(^TMP("LR",$JOB,"TST"),6)
+16 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
WRITE @IOF
+17 QUIT
CAP ;
+1 SET LRCAPNAM=""
+2 FOR
SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"TST",LRTNAM,LRCAPNAM))
if (LREND)!(LRCAPNAM="")
QUIT
Begin DoDot:1
+3 IF $Y+6>IOSL
Begin DoDot:2
+4 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
+5 WRITE @IOF
DO HDR
WRITE !!,LRSUBH_" ** cont. **",!,$EXTRACT(LRDASH,1,IOM)
+6 WRITE !,LRTNAM
+7 SET LRFIRST=1
End DoDot:2
+8 if LREND
QUIT
+9 if 'LRFIRST
WRITE !
+10 if LRFIRST
SET LRFIRST=0
+11 WRITE ?9,$EXTRACT(LRCAPNAM,1,50),?62,$JUSTIFY(LRCC(LRCAPNAM),12,4)
+12 WRITE ?74,$JUSTIFY(^TMP("LR",$JOB,"TST",LRTNAM,LRCAPNAM),6)
End DoDot:1
+13 if LREND
QUIT
+14 WRITE !,LRLINE
+15 WRITE !,"SUBTOTAL",?74,$JUSTIFY(^TMP("LR",$JOB,"TST",LRTNAM),6),!
+16 QUIT
WKLD ;
+1 SET LRSUBH="WKLD Code Summary"
+2 DO HDR
+3 WRITE !!,LRSUBH,!,$EXTRACT(LRDASH,1,IOM)
+4 SET LRCAPNAM=""
+5 FOR
SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"WKLD",LRCAPNAM))
if (LREND)!(LRCAPNAM="")
QUIT
Begin DoDot:1
+6 IF $Y+6>IOSL
Begin DoDot:2
+7 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
+8 WRITE @IOF
DO HDR
WRITE !!,LRSUBH_" ** cont. **",!,$EXTRACT(LRDASH,1,IOM)
End DoDot:2
+9 if LREND
QUIT
+10 WRITE !,LRCAPNAM,?55,$JUSTIFY(LRCC(LRCAPNAM),12,4)
+11 WRITE ?70,$JUSTIFY(^TMP("LR",$JOB,"WKLD",LRCAPNAM),6)
End DoDot:1
+12 if LREND
QUIT
+13 IF '$DATA(^TMP("LR",$JOB,"WKLD"))
SET LRTIC=" Workload "
DO NODATA
QUIT
+14 WRITE !,$EXTRACT(LRDASH,1,IOM)
+15 WRITE !!,"TOTAL",?70,$JUSTIFY(^TMP("LR",$JOB),6)
+16 QUIT
HDR ;
+1 SET LRPAG=LRPAG+1
+2 WRITE !!,"Detailed AUDIT REPORT (by Test) for ",LRDATRNG
+3 WRITE ?(62),LRDAT,?(72)," PAGE ",LRPAG
+4 WRITE !,"Accession Area: ",LRX
+5 WRITE !!,$EXTRACT(LRSTAR,1,34)," CONDENSED ",$EXTRACT(LRSTAR,1,33)
+6 QUIT
NODATA ;
+1 WRITE !!,"No",LRTIC,"data for this date range.",!!!
+2 DO PAUSE
+3 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
+2 if ($DATA(DTOUT)#2)!($DATA(DUOUT)#2)!($DATA(DIRUT)#2)
SET LREND=1
+3 QUIT
