- LRARCR3A ;DALISC/CKA - ARCHIVEDWKLD REP GENERATOR-PRINT 2 ;
- ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
- ;clone of LRCAPR3A
- COND ;
- D HDR1^LRARCR4
- D LOC Q:LREND
- D LRMAC Q:LREND
- D:LRCTL CONTROL Q:LREND
- D WKLD Q:LREND
- D STAT^LRARCR3B
- Q
- LOC ;
- Q:'$D(^TMP("LRAR",$J,"TST/LOC"))
- S LRSUBH1="TOTAL TESTS BY LOCATION: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1)),!
- S LRLOC=""
- F I=0:1 S LRLOC=$O(^TMP("LRAR",$J,"TST/LOC",LRLOC)) Q:(LRLOC="")!(LREND) D
- . S X=I#2 W:'X ! W ?X*40
- . W $E(LRLOC_" ",1,20),"="
- . W $J(^TMP("LRAR",$J,"TST/LOC",LRLOC),4)," "
- . W $J($FN($S(LRSUM:^(LRLOC)/LRSUM,1:0)*100,"",2),5),"%"
- . I X,$Y+6>IOSL D UP1^LRARCR4 Q:LREND
- Q
- LRMAC ;
- Q:'$D(^TMP("LRAR",$J,"TST/LRM"))
- S LRSUBH1="TOTAL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- I $Y+9>IOSL D PAUSE^LRARCR4 Q:LREND W @IOF D HDR1^LRARCR4
- W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
- S LRMAC=""
- F S LRMAC=$O(^TMP("LRAR",$J,"TST/LRM",LRMAC)) Q:(LRMAC="")!(LREND) S LRLMAC=^(LRMAC) D
- . I $Y+6>IOSL D UP1^LRARCR4 Q:LREND
- . W !!,LRMAC," =",$J(LRLMAC,5)," "
- . W $J($FN($S(LRSUM:LRLMAC/LRSUM,1:0)*100,"",2),5),"%"
- . S LRTEST=""
- . F I=0:1 S LRTEST=$O(^TMP("LRAR",$J,"TST/LRM",LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) D
- . . S X=I#2 W:'X ! W ?X*40+1
- . . W LRTEST," = ",$J(^TMP("LRAR",$J,"TST/LRM",LRMAC,LRTEST),5)
- . . W " ",$J($FN($S(LRLMAC:^(LRTEST)/LRLMAC,1:0)*100,"",2),5),"%"
- . . I X,$Y+6>IOSL D UP1^LRARCR4 Q:LREND
- Q
- CONTROL ;
- Q:'$D(^TMP("LRAR",$J,"TST/CTL"))
- S LRSUBH1="Total CONTROL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- I $Y+9>IOSL D PAUSE^LRARCR4 Q:LREND W @IOF D HDR1^LRARCR4
- W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
- S LRMAC=""
- F S LRMAC=$O(^TMP("LRAR",$J,"TST/CTL",LRMAC)) Q:(LRMAC="")!(LREND) S LRLMAC=^(LRMAC) D
- . I $Y+6>IOSL D UP1^LRARCR4 Q:LREND
- . W !!,LRMAC," =",$J(LRLMAC,5)," "
- . W $J($FN($S(LRSUM:LRLMAC/LRSUM,1:0)*100,"",2),5),"%"
- . S LRTEST=""
- . F I=0:1 S LRTEST=$O(^TMP("LRAR",$J,"TST/CTL",LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) D
- . . S X=I#2 W:'X ! W ?X*40+1
- . . W LRTEST," = ",$J(^TMP("LRAR",$J,"TST/CTL",LRMAC,LRTEST),5)
- . . W " ",$J($FN($S(LRLMAC:^(LRTEST)/LRLMAC,1:0)*100,"",2),5),"%"
- . . I X,$Y+6>IOSL D UP1^LRARCR4 Q:LREND
- Q
- WKLD ;
- Q:'$D(^TMP("LRAR",$J,"TST"))
- S LRSUBH1="TOTAL WKLD by TESTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- I $Y+9>IOSL D PAUSE^LRARCR4 Q:LREND W @IOF D HDR1^LRARCR4
- W !!!,?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1)),!
- S LRTEST=""
- F I=0:1 S LRTEST=$O(^TMP("LRAR",$J,"TST",LRTEST)) Q:(LRTEST="")!(LREND) D
- . I 'I#2,$Y+6>IOSL D UP1^LRARCR4 Q:LREND
- . S X=I#2 W:'X ! W ?X*40+1
- . W $E(LRTEST_" ",1,8)," = ",$J(^TMP("LRAR",$J,"TST",LRTEST),5)
- . W " ",$J($FN($S(LRSUM:^(LRTEST)/LRSUM,1:0)*100,"",2),5),"% "
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCR3A 2841 printed Feb 18, 2025@23:35:13 Page 2
- LRARCR3A ;DALISC/CKA - ARCHIVEDWKLD REP GENERATOR-PRINT 2 ;
- +1 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
- +2 ;clone of LRCAPR3A
- COND ;
- +1 DO HDR1^LRARCR4
- +2 DO LOC
- if LREND
- QUIT
- +3 DO LRMAC
- if LREND
- QUIT
- +4 if LRCTL
- DO CONTROL
- if LREND
- QUIT
- +5 DO WKLD
- if LREND
- QUIT
- +6 DO STAT^LRARCR3B
- +7 QUIT
- LOC ;
- +1 if '$DATA(^TMP("LRAR",$JOB,"TST/LOC"))
- QUIT
- +2 SET LRSUBH1="TOTAL TESTS BY LOCATION: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 WRITE !!!?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1)),!
- +4 SET LRLOC=""
- +5 FOR I=0:1
- SET LRLOC=$ORDER(^TMP("LRAR",$JOB,"TST/LOC",LRLOC))
- if (LRLOC="")!(LREND)
- QUIT
- Begin DoDot:1
- +6 SET X=I#2
- if 'X
- WRITE !
- WRITE ?X*40
- +7 WRITE $EXTRACT(LRLOC_" ",1,20),"="
- +8 WRITE $JUSTIFY(^TMP("LRAR",$JOB,"TST/LOC",LRLOC),4)," "
- +9 WRITE $JUSTIFY($FNUMBER($SELECT(LRSUM:^(LRLOC)/LRSUM,1:0)*100,"",2),5),"%"
- +10 IF X
- IF $Y+6>IOSL
- DO UP1^LRARCR4
- if LREND
- QUIT
- End DoDot:1
- +11 QUIT
- LRMAC ;
- +1 if '$DATA(^TMP("LRAR",$JOB,"TST/LRM"))
- QUIT
- +2 SET LRSUBH1="TOTAL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRARCR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRARCR4
- +4 WRITE !!!?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
- +5 SET LRMAC=""
- +6 FOR
- SET LRMAC=$ORDER(^TMP("LRAR",$JOB,"TST/LRM",LRMAC))
- if (LRMAC="")!(LREND)
- QUIT
- SET LRLMAC=^(LRMAC)
- Begin DoDot:1
- +7 IF $Y+6>IOSL
- DO UP1^LRARCR4
- if LREND
- QUIT
- +8 WRITE !!,LRMAC," =",$JUSTIFY(LRLMAC,5)," "
- +9 WRITE $JUSTIFY($FNUMBER($SELECT(LRSUM:LRLMAC/LRSUM,1:0)*100,"",2),5),"%"
- +10 SET LRTEST=""
- +11 FOR I=0:1
- SET LRTEST=$ORDER(^TMP("LRAR",$JOB,"TST/LRM",LRMAC,LRTEST))
- if (LRTEST="")!(LREND)
- QUIT
- Begin DoDot:2
- +12 SET X=I#2
- if 'X
- WRITE !
- WRITE ?X*40+1
- +13 WRITE LRTEST," = ",$JUSTIFY(^TMP("LRAR",$JOB,"TST/LRM",LRMAC,LRTEST),5)
- +14 WRITE " ",$JUSTIFY($FNUMBER($SELECT(LRLMAC:^(LRTEST)/LRLMAC,1:0)*100,"",2),5),"%"
- +15 IF X
- IF $Y+6>IOSL
- DO UP1^LRARCR4
- if LREND
- QUIT
- End DoDot:2
- End DoDot:1
- +16 QUIT
- CONTROL ;
- +1 if '$DATA(^TMP("LRAR",$JOB,"TST/CTL"))
- QUIT
- +2 SET LRSUBH1="Total CONTROL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRARCR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRARCR4
- +4 WRITE !!!?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
- +5 SET LRMAC=""
- +6 FOR
- SET LRMAC=$ORDER(^TMP("LRAR",$JOB,"TST/CTL",LRMAC))
- if (LRMAC="")!(LREND)
- QUIT
- SET LRLMAC=^(LRMAC)
- Begin DoDot:1
- +7 IF $Y+6>IOSL
- DO UP1^LRARCR4
- if LREND
- QUIT
- +8 WRITE !!,LRMAC," =",$JUSTIFY(LRLMAC,5)," "
- +9 WRITE $JUSTIFY($FNUMBER($SELECT(LRSUM:LRLMAC/LRSUM,1:0)*100,"",2),5),"%"
- +10 SET LRTEST=""
- +11 FOR I=0:1
- SET LRTEST=$ORDER(^TMP("LRAR",$JOB,"TST/CTL",LRMAC,LRTEST))
- if (LRTEST="")!(LREND)
- QUIT
- Begin DoDot:2
- +12 SET X=I#2
- if 'X
- WRITE !
- WRITE ?X*40+1
- +13 WRITE LRTEST," = ",$JUSTIFY(^TMP("LRAR",$JOB,"TST/CTL",LRMAC,LRTEST),5)
- +14 WRITE " ",$JUSTIFY($FNUMBER($SELECT(LRLMAC:^(LRTEST)/LRLMAC,1:0)*100,"",2),5),"%"
- +15 IF X
- IF $Y+6>IOSL
- DO UP1^LRARCR4
- if LREND
- QUIT
- End DoDot:2
- End DoDot:1
- +16 QUIT
- WKLD ;
- +1 if '$DATA(^TMP("LRAR",$JOB,"TST"))
- QUIT
- +2 SET LRSUBH1="TOTAL WKLD by TESTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRARCR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRARCR4
- +4 WRITE !!!,?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1)),!
- +5 SET LRTEST=""
- +6 FOR I=0:1
- SET LRTEST=$ORDER(^TMP("LRAR",$JOB,"TST",LRTEST))
- if (LRTEST="")!(LREND)
- QUIT
- Begin DoDot:1
- +7 IF 'I#2
- IF $Y+6>IOSL
- DO UP1^LRARCR4
- if LREND
- QUIT
- +8 SET X=I#2
- if 'X
- WRITE !
- WRITE ?X*40+1
- +9 WRITE $EXTRACT(LRTEST_" ",1,8)," = ",$JUSTIFY(^TMP("LRAR",$JOB,"TST",LRTEST),5)
- +10 WRITE " ",$JUSTIFY($FNUMBER($SELECT(LRSUM:^(LRTEST)/LRSUM,1:0)*100,"",2),5),"% "
- End DoDot:1
- +11 QUIT