LRCAPR3 ;DALISC/PAC/FHS/JBM - WKLD REP GENERATOR-PRINT 1 ;10/16/92 16:49
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
D INIT1
D:('LREND)&(LRANS="D") DET
D:('LREND)&(LRANS="D") INIT2
D:'LREND COND^LRCAPR3A
D:'LREND TOTAL
D CLEAN^LRCAPR4
Q
INIT1 ;
W:$E(IOST,1,2)="C-" @IOF
S (LREND,LRCONT)=0,(LRPG,LRFL)=1
K LRSTR,LRDSH
S LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
S $P(LRSTR,"*",80)="*",$P(LRDSH,"-",80)="-"
D BLDHDR^LRCAPR4 I 'LRHDRFIT D REPHDR^LRCAPR4 Q:LREND
I '$D(^TMP("LR",$J,"TST/TOT")) D
. W !!,"*** NO DATA TO REPORT ***"
. D PAUSE^LRCAPR4 Q:LREND
. S LREND=1
Q:LREND
S LRSUM=^TMP("LR",$J,"TST/TOT")
S LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
K %H,%I,X
Q
INIT2 ;
S LRANS="C" ; condense rpt
I $E(IOST,1,2)="C-" D
. S DY=IOSL-3,DX=0
. X:$D(IOXY) IOXY
. W $C(7),!?60,"*** new heading ***"
. D PAUSE^LRCAPR4 Q:LREND
W @IOF
Q
DET ;
S LRTST="",K=0
F S LRTST=$O(^TMP("LR",$J,"TST",LRTST)) Q:(LRTST="")!(LREND) D
. S LRLC="",LRSUBH=1
. F S LRLC=$O(^TMP("LR",$J,"TST",LRTST,LRLC)) Q:(LRLC="")!(LREND) D
. . S LRSUBH=1
. . S LRCAP=""
. . F S LRCAP=$O(^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP)) Q:(LRCAP="")!(LREND) S LRCPT=^(LRCAP) D
. . . S LRAA="",J=0,LRSUBH=1
. . . F S LRAA=$O(^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP,LRAA)) Q:(LRAA="")!(LREND) D
. . . . S LRCNT=""
. . . . F S LRCNT=$O(^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP,LRAA,LRCNT)) Q:(LRCNT="")!(LREND) D
. . . . . S J=J+1
. . . . . I LRFL D HDR^LRCAPR4 S LRFL=0
. . . . . S X=^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP,LRAA,LRCNT)
. . . . . S LRCODE=$P(X,U,2),LRURGNAM=$S($P(X,U,3)="":"",1:"**")
. . . . . S Y=$P(X,U,1) D DD^%DT S LRVD=Y
. . . . . I LRSUBH D SUBH^LRCAPR4 S LRSUBH=0
. . . . . W !,LRURGNAM,?3,LRAA,?36,LRVD
. . . . . S K=K+1 Q:K=LRSUM
. . . . . I $Y+6>IOSL D
. . . . . . D UP^LRCAPR4 Q:LREND
. . . . . . W @IOF D HDR^LRCAPR4
. . . . . . I J<LRCPT D SUBH^LRCAPR4
Q:LREND
I $E(IOST,1,2)="C-" D
. S DY=IOSL-2,DX=0
. X:$D(IOXY) IOXY
. W $C(7),!?56,"*** new sub-heading ***"
. D PAUSE^LRCAPR4
Q:LREND
W @IOF D HDR1^LRCAPR4
D DATE
Q
DATE ;
S LRSUBH1="TOTAL TESTS by METHODOLOGY by DAY"_" ( "_LRSUM_" )"
W:$D(^TMP("LR",$J,"DAY")) !!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
S LRDAT=0
F S LRDAT=$O(^TMP("LR",$J,"DAY",LRDAT)) Q:('LRDAT)!(LREND) D
. S LRDATX=^TMP("LR",$J,"DAY",LRDAT)
. I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
. S Y=LRDAT D DD^%DT S LRDATD=Y W !!,">>>",?15,LRDATD," = ",LRDATX
. W ?35,$J($FN($S(LRSUM:LRDATX/LRSUM,1:0)*100,"",2),5),"% of Grand Total"
. S LRMAC=""
. F S LRMAC=$O(^TMP("LR",$J,"DAY",LRDAT,LRMAC)) Q:(LRMAC="")!(LREND) S LRMCT=^(LRMAC) D
. . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
. . W !?1,"by ",LRMAC," = ",LRMCT," "
. . W $J($FN($S(LRDATX:LRMCT/LRDATX,1:0)*100,"",2),5)_"% of days workload"
. . S LRTEST=""
. . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"DAY",LRDAT,LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) S LRTMTOT=^(LRTEST) D
. . . S X=I#2 W:'X ! W ?X*40+1,LRTEST," = "
. . . W $J(LRTMTOT,4)_" "_$J($FN($S(LRMCT:LRTMTOT/LRMCT,1:0)*100,"",2),5)_"%"
. . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
Q
TOTAL ;
I $Y+6>IOSL D
. W $C(7)
. D PAUSE^LRCAPR4 Q:LREND
. W @IOF D HDR1^LRCAPR4
Q:LREND
W !!!?10,"GRAND TOTAL of TESTS DONE = "_LRSUM_" 100.00%"
W !!,?25," ***** end of report *****"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPR3 3334 printed Sep 23, 2025@19:48:58 Page 2
LRCAPR3 ;DALISC/PAC/FHS/JBM - WKLD REP GENERATOR-PRINT 1 ;10/16/92 16:49
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
+1 DO INIT1
+2 if ('LREND)&(LRANS="D")
DO DET
+3 if ('LREND)&(LRANS="D")
DO INIT2
+4 if 'LREND
DO COND^LRCAPR3A
+5 if 'LREND
DO TOTAL
+6 DO CLEAN^LRCAPR4
+7 QUIT
INIT1 ;
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+2 SET (LREND,LRCONT)=0
SET (LRPG,LRFL)=1
+3 KILL LRSTR,LRDSH
+4 SET LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
+5 SET $PIECE(LRSTR,"*",80)="*"
SET $PIECE(LRDSH,"-",80)="-"
+6 DO BLDHDR^LRCAPR4
IF 'LRHDRFIT
DO REPHDR^LRCAPR4
if LREND
QUIT
+7 IF '$DATA(^TMP("LR",$JOB,"TST/TOT"))
Begin DoDot:1
+8 WRITE !!,"*** NO DATA TO REPORT ***"
+9 DO PAUSE^LRCAPR4
if LREND
QUIT
+10 SET LREND=1
End DoDot:1
+11 if LREND
QUIT
+12 SET LRSUM=^TMP("LR",$JOB,"TST/TOT")
+13 SET LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
+14 KILL %H,%I,X
+15 QUIT
INIT2 ;
+1 ; condense rpt
SET LRANS="C"
+2 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 SET DY=IOSL-3
SET DX=0
+4 if $DATA(IOXY)
XECUTE IOXY
+5 WRITE $CHAR(7),!?60,"*** new heading ***"
+6 DO PAUSE^LRCAPR4
if LREND
QUIT
End DoDot:1
+7 WRITE @IOF
+8 QUIT
DET ;
+1 SET LRTST=""
SET K=0
+2 FOR
SET LRTST=$ORDER(^TMP("LR",$JOB,"TST",LRTST))
if (LRTST="")!(LREND)
QUIT
Begin DoDot:1
+3 SET LRLC=""
SET LRSUBH=1
+4 FOR
SET LRLC=$ORDER(^TMP("LR",$JOB,"TST",LRTST,LRLC))
if (LRLC="")!(LREND)
QUIT
Begin DoDot:2
+5 SET LRSUBH=1
+6 SET LRCAP=""
+7 FOR
SET LRCAP=$ORDER(^TMP("LR",$JOB,"TST",LRTST,LRLC,LRCAP))
if (LRCAP="")!(LREND)
QUIT
SET LRCPT=^(LRCAP)
Begin DoDot:3
+8 SET LRAA=""
SET J=0
SET LRSUBH=1
+9 FOR
SET LRAA=$ORDER(^TMP("LR",$JOB,"TST",LRTST,LRLC,LRCAP,LRAA))
if (LRAA="")!(LREND)
QUIT
Begin DoDot:4
+10 SET LRCNT=""
+11 FOR
SET LRCNT=$ORDER(^TMP("LR",$JOB,"TST",LRTST,LRLC,LRCAP,LRAA,LRCNT))
if (LRCNT="")!(LREND)
QUIT
Begin DoDot:5
+12 SET J=J+1
+13 IF LRFL
DO HDR^LRCAPR4
SET LRFL=0
+14 SET X=^TMP("LR",$JOB,"TST",LRTST,LRLC,LRCAP,LRAA,LRCNT)
+15 SET LRCODE=$PIECE(X,U,2)
SET LRURGNAM=$SELECT($PIECE(X,U,3)="":"",1:"**")
+16 SET Y=$PIECE(X,U,1)
DO DD^%DT
SET LRVD=Y
+17 IF LRSUBH
DO SUBH^LRCAPR4
SET LRSUBH=0
+18 WRITE !,LRURGNAM,?3,LRAA,?36,LRVD
+19 SET K=K+1
if K=LRSUM
QUIT
+20 IF $Y+6>IOSL
Begin DoDot:6
+21 DO UP^LRCAPR4
if LREND
QUIT
+22 WRITE @IOF
DO HDR^LRCAPR4
+23 IF J<LRCPT
DO SUBH^LRCAPR4
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 if LREND
QUIT
+25 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+26 SET DY=IOSL-2
SET DX=0
+27 if $DATA(IOXY)
XECUTE IOXY
+28 WRITE $CHAR(7),!?56,"*** new sub-heading ***"
+29 DO PAUSE^LRCAPR4
End DoDot:1
+30 if LREND
QUIT
+31 WRITE @IOF
DO HDR1^LRCAPR4
+32 DO DATE
+33 QUIT
DATE ;
+1 SET LRSUBH1="TOTAL TESTS by METHODOLOGY by DAY"_" ( "_LRSUM_" )"
+2 if $DATA(^TMP("LR",$JOB,"DAY"))
WRITE !!?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
+3 SET LRDAT=0
+4 FOR
SET LRDAT=$ORDER(^TMP("LR",$JOB,"DAY",LRDAT))
if ('LRDAT)!(LREND)
QUIT
Begin DoDot:1
+5 SET LRDATX=^TMP("LR",$JOB,"DAY",LRDAT)
+6 IF $Y+6>IOSL
DO UP1^LRCAPR4
if LREND
QUIT
+7 SET Y=LRDAT
DO DD^%DT
SET LRDATD=Y
WRITE !!,">>>",?15,LRDATD," = ",LRDATX
+8 WRITE ?35,$JUSTIFY($FNUMBER($SELECT(LRSUM:LRDATX/LRSUM,1:0)*100,"",2),5),"% of Grand Total"
+9 SET LRMAC=""
+10 FOR
SET LRMAC=$ORDER(^TMP("LR",$JOB,"DAY",LRDAT,LRMAC))
if (LRMAC="")!(LREND)
QUIT
SET LRMCT=^(LRMAC)
Begin DoDot:2
+11 IF $Y+6>IOSL
DO UP1^LRCAPR4
if LREND
QUIT
+12 WRITE !?1,"by ",LRMAC," = ",LRMCT," "
+13 WRITE $JUSTIFY($FNUMBER($SELECT(LRDATX:LRMCT/LRDATX,1:0)*100,"",2),5)_"% of days workload"
+14 SET LRTEST=""
+15 FOR I=0:1
SET LRTEST=$ORDER(^TMP("LR",$JOB,"DAY",LRDAT,LRMAC,LRTEST))
if (LRTEST="")!(LREND)
QUIT
SET LRTMTOT=^(LRTEST)
Begin DoDot:3
+16 SET X=I#2
if 'X
WRITE !
WRITE ?X*40+1,LRTEST," = "
+17 WRITE $JUSTIFY(LRTMTOT,4)_" "_$JUSTIFY($FNUMBER($SELECT(LRMCT:LRTMTOT/LRMCT,1:0)*100,"",2),5)_"%"
+18 IF X
IF $Y+6>IOSL
DO UP1^LRCAPR4
if LREND
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
TOTAL ;
+1 IF $Y+6>IOSL
Begin DoDot:1
+2 WRITE $CHAR(7)
+3 DO PAUSE^LRCAPR4
if LREND
QUIT
+4 WRITE @IOF
DO HDR1^LRCAPR4
End DoDot:1
+5 if LREND
QUIT
+6 WRITE !!!?10,"GRAND TOTAL of TESTS DONE = "_LRSUM_" 100.00%"
+7 WRITE !!,?25," ***** end of report *****"
+8 QUIT
