LRARCR3B ;DALISC/CKA - ARCHIVEDWKLD REP GENERATOR-PRINT 2 ;
;;5.2;LAB SERVICE;**59**;Aug 31, 1995
EN ;CALLED FROM LRARCR3A
STAT ;
Q:'$D(^TMP("LRAR",$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^LRARCR4 Q:LREND W @IOF D HDR1^LRARCR4
W !!!?((80-$L(LRSUBH1))/2),LRSUBH1
W !?((80-$L(LRSUBH1))/2),$E(LRDSH,1,$L(LRSUBH1))
I '$D(^TMP("LRAR",$J,"TST/URG",LRPTYP)) W !!,?30,"NONE FOUND" Q
S LRURG=""
F S LRURG=$O(^TMP("LRAR",$J,"TST/URG",LRPTYP,LRURG)) Q:(LRURG="")!(LREND) S LRURGCNT=^(LRURG) D
. I $Y+6>IOSL D UP1^LRARCR4 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("LRAR",$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("LRAR",$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^LRARCR4 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^LRARCR4 Q:LREND W @IOF D HDR1^LRARCR4
. W !!!?((80-$L(LRSUBH1))/2),LRSUBH1
. W !?((80-$L(LRSUBH1))/2),$E(LRDSH,1,$L(LRSUBH1))
. I '$D(^TMP("LRAR",$J,"TST/URG",LRPTYP)) W !!,?30,"NONE FOUND" Q
. S LRURG=""
. F S LRURG=$O(^TMP("LRAR",$J,"TST/URG",LRPTYP,LRURG)) Q:(LRURG="")!(LREND) S LRURGCNT=^(LRURG) D
. . I $Y+6>IOSL D UP1^LRARCR4 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("LRAR",$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("LRAR",$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^LRARCR4 Q:LREND
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCR3B 2336 printed Dec 13, 2024@02:09:21 Page 2
LRARCR3B ;DALISC/CKA - ARCHIVEDWKLD REP GENERATOR-PRINT 2 ;
+1 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
EN ;CALLED FROM LRARCR3A
STAT ;
+1 if '$DATA(^TMP("LRAR",$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^LRARCR4
if LREND
QUIT
WRITE @IOF
DO HDR1^LRARCR4
+4 WRITE !!!?((80-$LENGTH(LRSUBH1))/2),LRSUBH1
+5 WRITE !?((80-$LENGTH(LRSUBH1))/2),$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
+6 IF '$DATA(^TMP("LRAR",$JOB,"TST/URG",LRPTYP))
WRITE !!,?30,"NONE FOUND"
QUIT
+7 SET LRURG=""
+8 FOR
SET LRURG=$ORDER(^TMP("LRAR",$JOB,"TST/URG",LRPTYP,LRURG))
if (LRURG="")!(LREND)
QUIT
SET LRURGCNT=^(LRURG)
Begin DoDot:1
+9 IF $Y+6>IOSL
DO UP1^LRARCR4
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("LRAR",$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("LRAR",$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^LRARCR4
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^LRARCR4
if LREND
QUIT
WRITE @IOF
DO HDR1^LRARCR4
+4 WRITE !!!?((80-$LENGTH(LRSUBH1))/2),LRSUBH1
+5 WRITE !?((80-$LENGTH(LRSUBH1))/2),$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
+6 IF '$DATA(^TMP("LRAR",$JOB,"TST/URG",LRPTYP))
WRITE !!,?30,"NONE FOUND"
QUIT
+7 SET LRURG=""
+8 FOR
SET LRURG=$ORDER(^TMP("LRAR",$JOB,"TST/URG",LRPTYP,LRURG))
if (LRURG="")!(LREND)
QUIT
SET LRURGCNT=^(LRURG)
Begin DoDot:2
+9 IF $Y+6>IOSL
DO UP1^LRARCR4
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("LRAR",$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("LRAR",$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^LRARCR4
if LREND
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
