- 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 Mar 13, 2025@21:17:39 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
