- LRCAPR3A ;DALISC/PAC/FHS/JBM - WKLD REP GENERATOR-PRINT 2 ;10/16/92 16:49
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- COND ;
- D HDR1^LRCAPR4
- D LOC Q:LREND
- D LRMAC Q:LREND
- D:LRCTL CONTROL Q:LREND
- D WKLD Q:LREND
- D STAT
- Q
- LOC ;
- Q:'$D(^TMP("LR",$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("LR",$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("LR",$J,"TST/LOC",LRLOC),4)," "
- . W $J($FN($S(LRSUM:^(LRLOC)/LRSUM,1:0)*100,"",2),5),"%"
- . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
- Q
- LRMAC ;
- Q:'$D(^TMP("LR",$J,"TST/LRM"))
- S LRSUBH1="TOTAL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
- W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
- S LRMAC=""
- F S LRMAC=$O(^TMP("LR",$J,"TST/LRM",LRMAC)) Q:(LRMAC="")!(LREND) S LRLMAC=^(LRMAC) D
- . I $Y+6>IOSL D UP1^LRCAPR4 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("LR",$J,"TST/LRM",LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) D
- . . S X=I#2 W:'X ! W ?X*40+1
- . . W LRTEST," = ",$J(^TMP("LR",$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^LRCAPR4 Q:LREND
- Q
- CONTROL ;
- Q:'$D(^TMP("LR",$J,"TST/CTL"))
- S LRSUBH1="Total CONTROL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
- W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
- S LRMAC=""
- F S LRMAC=$O(^TMP("LR",$J,"TST/CTL",LRMAC)) Q:(LRMAC="")!(LREND) S LRLMAC=^(LRMAC) D
- . I $Y+6>IOSL D UP1^LRCAPR4 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("LR",$J,"TST/CTL",LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) D
- . . S X=I#2 W:'X ! W ?X*40+1
- . . W LRTEST," = ",$J(^TMP("LR",$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^LRCAPR4 Q:LREND
- Q
- WKLD ;
- Q:'$D(^TMP("LR",$J,"TST"))
- S LRSUBH1="TOTAL WKLD by TESTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
- W !!!,?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1)),!
- S LRTEST=""
- F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST",LRTEST)) Q:(LRTEST="")!(LREND) D
- . I 'I#2,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
- . S X=I#2 W:'X ! W ?X*40+1
- . W $E(LRTEST_" ",1,8)," = ",$J(^TMP("LR",$J,"TST",LRTEST),5)
- . W " ",$J($FN($S(LRSUM:^(LRTEST)/LRSUM,1:0)*100,"",2),5),"% "
- Q
- STAT ;
- Q:'$D(^TMP("LR",$J,"TST/URG"))
- D:(LRIOPAT["A")!($L(LRIOPAT)>1) STAT1
- D:'LREND STAT2
- Q
- STAT1 ; Combined patient type totals
- S LRPTYP="A"
- S LRSUBH1="TOTAL TESTS by 'STAT' URGENCY for ALL PATIENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
- W !!!?((80-$L(LRSUBH1))/2),LRSUBH1
- W !?((80-$L(LRSUBH1))/2),$E(LRDSH,1,$L(LRSUBH1))
- I '$D(^TMP("LR",$J,"TST/URG",LRPTYP)) W !!,?30,"NONE FOUND" Q
- S LRURG=""
- F S LRURG=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG)) Q:(LRURG="")!(LREND) S LRURGCNT=^(LRURG) D
- . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
- . W !!,LRURG," =",$J(LRURGCNT,5)," "
- . W $J($FN($S(LRSUM:LRURGCNT/LRSUM,1:0)*100,"",2),5)_"%"
- . S LRTEST=""
- . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST)) Q:(LRTEST="")!(LREND) D
- . . S X=I#2 W:'X !
- . . W ?X*40+1,$E(LRTEST_" ",1,8)," = "
- . . W $J(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST),5)," "
- . . W $J($FN($S(LRURGCNT:^(LRTEST)/LRURGCNT,1:0)*100,"",2),5)_"%"
- . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
- Q
- STAT2 ; Individual patient type totals
- F LRPTYP="I","O","R" Q:LREND D
- . S LRSUBH1="TOTAL TESTS by 'STAT' URGENCY for "_$S(LRPTYP="I":"INPATIENTS",LRPTYP="O":"OUTPATIENTS",LRPTYP="R":"OTHER PATIENTS",1:"UNKNOWN PATIENTS")_": % of GRAND TOTAL"_" ( "_LRSUM_" )"
- . I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
- . W !!!?((80-$L(LRSUBH1))/2),LRSUBH1
- . W !?((80-$L(LRSUBH1))/2),$E(LRDSH,1,$L(LRSUBH1))
- . I '$D(^TMP("LR",$J,"TST/URG",LRPTYP)) W !!,?30,"NONE FOUND" Q
- . S LRURG=""
- . F S LRURG=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG)) Q:(LRURG="")!(LREND) S LRURGCNT=^(LRURG) D
- . . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
- . . W !!,LRURG," =",$J(LRURGCNT,5)," "
- . . W $J($FN($S(LRSUM:LRURGCNT/LRSUM,1:0)*100,"",2),5)_"%"
- . . S LRTEST=""
- . . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST)) Q:(LRTEST="")!(LREND) D
- . . . S X=I#2 W:'X !
- . . . W ?X*40+1,$E(LRTEST_" ",1,8)," = "
- . . . W $J(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST),5)," "
- . . . W $J($FN($S(LRURGCNT:^(LRTEST)/LRURGCNT,1:0)*100,"",2),5)_"%"
- . . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPR3A 4982 printed Apr 23, 2025@18:27:20 Page 2
- LRCAPR3A ;DALISC/PAC/FHS/JBM - WKLD REP GENERATOR-PRINT 2 ;10/16/92 16:49
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- COND ;
- +1 DO HDR1^LRCAPR4
- +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
- +7 QUIT
- LOC ;
- +1 if '$DATA(^TMP("LR",$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("LR",$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("LR",$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^LRCAPR4
- if LREND
- QUIT
- End DoDot:1
- +11 QUIT
- LRMAC ;
- +1 if '$DATA(^TMP("LR",$JOB,"TST/LRM"))
- QUIT
- +2 SET LRSUBH1="TOTAL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRCAPR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRCAPR4
- +4 WRITE !!!?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
- +5 SET LRMAC=""
- +6 FOR
- SET LRMAC=$ORDER(^TMP("LR",$JOB,"TST/LRM",LRMAC))
- if (LRMAC="")!(LREND)
- QUIT
- SET LRLMAC=^(LRMAC)
- Begin DoDot:1
- +7 IF $Y+6>IOSL
- DO UP1^LRCAPR4
- 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("LR",$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("LR",$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^LRCAPR4
- if LREND
- QUIT
- End DoDot:2
- End DoDot:1
- +16 QUIT
- CONTROL ;
- +1 if '$DATA(^TMP("LR",$JOB,"TST/CTL"))
- QUIT
- +2 SET LRSUBH1="Total CONTROL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRCAPR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRCAPR4
- +4 WRITE !!!?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
- +5 SET LRMAC=""
- +6 FOR
- SET LRMAC=$ORDER(^TMP("LR",$JOB,"TST/CTL",LRMAC))
- if (LRMAC="")!(LREND)
- QUIT
- SET LRLMAC=^(LRMAC)
- Begin DoDot:1
- +7 IF $Y+6>IOSL
- DO UP1^LRCAPR4
- 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("LR",$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("LR",$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^LRCAPR4
- if LREND
- QUIT
- End DoDot:2
- End DoDot:1
- +16 QUIT
- WKLD ;
- +1 if '$DATA(^TMP("LR",$JOB,"TST"))
- QUIT
- +2 SET LRSUBH1="TOTAL WKLD by TESTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRCAPR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRCAPR4
- +4 WRITE !!!,?15,LRSUBH1,!?15,$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1)),!
- +5 SET LRTEST=""
- +6 FOR I=0:1
- SET LRTEST=$ORDER(^TMP("LR",$JOB,"TST",LRTEST))
- if (LRTEST="")!(LREND)
- QUIT
- Begin DoDot:1
- +7 IF 'I#2
- IF $Y+6>IOSL
- DO UP1^LRCAPR4
- if LREND
- QUIT
- +8 SET X=I#2
- if 'X
- WRITE !
- WRITE ?X*40+1
- +9 WRITE $EXTRACT(LRTEST_" ",1,8)," = ",$JUSTIFY(^TMP("LR",$JOB,"TST",LRTEST),5)
- +10 WRITE " ",$JUSTIFY($FNUMBER($SELECT(LRSUM:^(LRTEST)/LRSUM,1:0)*100,"",2),5),"% "
- End DoDot:1
- +11 QUIT
- STAT ;
- +1 if '$DATA(^TMP("LR",$JOB,"TST/URG"))
- QUIT
- +2 if (LRIOPAT["A")!($LENGTH(LRIOPAT)>1)
- DO STAT1
- +3 if 'LREND
- DO STAT2
- +4 QUIT
- STAT1 ; Combined patient type totals
- +1 SET LRPTYP="A"
- +2 SET LRSUBH1="TOTAL TESTS by 'STAT' URGENCY for ALL PATIENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRCAPR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRCAPR4
- +4 WRITE !!!?((80-$LENGTH(LRSUBH1))/2),LRSUBH1
- +5 WRITE !?((80-$LENGTH(LRSUBH1))/2),$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
- +6 IF '$DATA(^TMP("LR",$JOB,"TST/URG",LRPTYP))
- WRITE !!,?30,"NONE FOUND"
- QUIT
- +7 SET LRURG=""
- +8 FOR
- SET LRURG=$ORDER(^TMP("LR",$JOB,"TST/URG",LRPTYP,LRURG))
- if (LRURG="")!(LREND)
- QUIT
- SET LRURGCNT=^(LRURG)
- Begin DoDot:1
- +9 IF $Y+6>IOSL
- DO UP1^LRCAPR4
- if LREND
- QUIT
- +10 WRITE !!,LRURG," =",$JUSTIFY(LRURGCNT,5)," "
- +11 WRITE $JUSTIFY($FNUMBER($SELECT(LRSUM:LRURGCNT/LRSUM,1:0)*100,"",2),5)_"%"
- +12 SET LRTEST=""
- +13 FOR I=0:1
- SET LRTEST=$ORDER(^TMP("LR",$JOB,"TST/URG",LRPTYP,LRURG,LRTEST))
- if (LRTEST="")!(LREND)
- QUIT
- Begin DoDot:2
- +14 SET X=I#2
- if 'X
- WRITE !
- +15 WRITE ?X*40+1,$EXTRACT(LRTEST_" ",1,8)," = "
- +16 WRITE $JUSTIFY(^TMP("LR",$JOB,"TST/URG",LRPTYP,LRURG,LRTEST),5)," "
- +17 WRITE $JUSTIFY($FNUMBER($SELECT(LRURGCNT:^(LRTEST)/LRURGCNT,1:0)*100,"",2),5)_"%"
- +18 IF X
- IF $Y+6>IOSL
- DO UP1^LRCAPR4
- if LREND
- QUIT
- End DoDot:2
- End DoDot:1
- +19 QUIT
- STAT2 ; Individual patient type totals
- +1 FOR LRPTYP="I","O","R"
- if LREND
- QUIT
- Begin DoDot:1
- +2 SET LRSUBH1="TOTAL TESTS by 'STAT' URGENCY for "_$SELECT(LRPTYP="I":"INPATIENTS",LRPTYP="O":"OUTPATIENTS",LRPTYP="R":"OTHER PATIENTS",1:"UNKNOWN PATIENTS")_": % of GRAND TOTAL"_" ( "_LRSUM_" )"
- +3 IF $Y+9>IOSL
- DO PAUSE^LRCAPR4
- if LREND
- QUIT
- WRITE @IOF
- DO HDR1^LRCAPR4
- +4 WRITE !!!?((80-$LENGTH(LRSUBH1))/2),LRSUBH1
- +5 WRITE !?((80-$LENGTH(LRSUBH1))/2),$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
- +6 IF '$DATA(^TMP("LR",$JOB,"TST/URG",LRPTYP))
- WRITE !!,?30,"NONE FOUND"
- QUIT
- +7 SET LRURG=""
- +8 FOR
- SET LRURG=$ORDER(^TMP("LR",$JOB,"TST/URG",LRPTYP,LRURG))
- if (LRURG="")!(LREND)
- QUIT
- SET LRURGCNT=^(LRURG)
- Begin DoDot:2
- +9 IF $Y+6>IOSL
- DO UP1^LRCAPR4
- if LREND
- QUIT
- +10 WRITE !!,LRURG," =",$JUSTIFY(LRURGCNT,5)," "
- +11 WRITE $JUSTIFY($FNUMBER($SELECT(LRSUM:LRURGCNT/LRSUM,1:0)*100,"",2),5)_"%"
- +12 SET LRTEST=""
- +13 FOR I=0:1
- SET LRTEST=$ORDER(^TMP("LR",$JOB,"TST/URG",LRPTYP,LRURG,LRTEST))
- if (LRTEST="")!(LREND)
- QUIT
- Begin DoDot:3
- +14 SET X=I#2
- if 'X
- WRITE !
- +15 WRITE ?X*40+1,$EXTRACT(LRTEST_" ",1,8)," = "
- +16 WRITE $JUSTIFY(^TMP("LR",$JOB,"TST/URG",LRPTYP,LRURG,LRTEST),5)," "
- +17 WRITE $JUSTIFY($FNUMBER($SELECT(LRURGCNT:^(LRTEST)/LRURGCNT,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
