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 Sep 23, 2025@19:48:59 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
