- 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 Jan 18, 2025@03:10:04 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