LRRP8C ;DALISC/TNN/J0 - WKLD STATS REPORT BY SHIFT ; 4/9/93
;;5.2;LAB SERVICE;;Sep 27, 1994
W !!,"ENTRY POINT IS AT EN^LRRP8." H 3 QUIT
;
PRINT ;
W:$E(IOST,1,2)="C-" @IOF
S LRGCNT=+$G(^TMP("LR",$J,0))
I 'LRGCNT W !," *** NO DATA FOR THIS REPORT ***",! Q
D:LRRPT=1 DET Q:LREND
D SUM Q:LREND
D PRNTMAN^LRCAPMR1 Q:LREND
D COMM^LRCAPMR2 Q:LREND
Q
DET ;
S LRA=0
F S LRA=$O(^TMP("LR",$J,"AA",LRA)) Q:('LRA)!(LREND) D
. S LRANAM=$P($G(^LRO(68,LRA,0)),U)
. D HDR^LRCAPU
. W !,"Accession Area: ",LRANAM,!
. S LRACNT=+$G(^TMP("LR",$J,"AA",LRA,0))
. I 'LRACNT W !," *** NO DATA FOR THIS ACCESSION AREA ***",! Q
. S LRSHFT=0
. F S LRSHFT=$O(LRST(LRSHFT)) Q:('LRSHFT)!(LREND) D
. . S LRCONT=0 D SHFTHDR S LRCONT=1
. . S LRSCNT=+$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,0))
. . I 'LRSCNT W !," *** NO DATA FOR THIS SHIFT ***",! Q
. . S LRCAPNAM=""
. . F S LRCAPNAM=$O(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
. . . S LRREC=$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM,0))
. . . S LRCCNT=+LRREC,LRCAPNUM=$P(LRREC,U,2)
. . . S LRPCT=(LRCCNT/LRSCNT)*100
. . . I $Y+7>IOSL D
. . . . D NPG^LRCAPU Q:LREND
. . . . W !,"Accession Area: ",LRANAM," (cont.)",!
. . . . D SHFTHDR
. . . Q:LREND
. . . W $J(LRCCNT,7),?10,$E(LRCAPNAM,1,30),?42,LRCAPNUM
. . . W ?53,$J(LRPCT,6,2),"%",!
. . Q:LREND
. . W "Shift subtotal: ",$J(LRSCNT,8),!
. Q:LREND
. D AASUM
. Q:LREND
. D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
Q
AASUM ;*** Accession Area summary ***
D NPG^LRCAPU Q:LREND W !,"Accession Area: ",LRANAM," (cont.)",!
I LRSTFLG=1 D
. W !
. S LRSHFT=0
. F S LRSHFT=$O(LRST(LRSHFT)) Q:('LRSHFT)!(LREND) D
. . S LRSCNT=+$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,0))
. . S LRPCT=(LRSCNT/LRACNT)*100
. . W "Shift#",LRSHFT,": ",$J(LRPCT,6,2)
. . W "% of ",LRANAM," total.",!
. W !
S LRCONT=0 D ACCHDR S LRCONT=1
S LRCAPNAM=""
F S LRCAPNAM=$O(^TMP("LR",$J,"AA",LRA,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
. S LRREC=$G(^TMP("LR",$J,"AA",LRA,"CCN",LRCAPNAM,0))
. S LRCCNT=+LRREC,LRCAPNUM=$P(LRREC,U,2)
. S LRPCT=(LRCCNT/LRACNT)*100
. I $Y+5>IOSL D
. . D NPG^LRCAPU Q:LREND
. . W !,"Accession Area: ",LRANAM," (cont.)",!
. . D ACCHDR
. Q:LREND
. W $J(LRCCNT,7),?10,$E(LRCAPNAM,1,30),?42,LRCAPNUM
. W ?53,$J(LRPCT,6,2),"%",!
Q:LREND
W !,LRANAM," subtotal: ",$J(LRACNT,8),!
Q
SUM ;
D HDR^LRCAPU
S LRCONT=0 D SUMHDR S LRCONT=1
S LRA=0
F S LRA=$O(^TMP("LR",$J,"AA",LRA)) Q:('LRA)!(LREND) D
. S LRANAM=$P($G(^LRO(68,LRA,0)),U)
. S LRACNT=+$G(^TMP("LR",$J,"AA",LRA,0))
. S LRPCT=(LRACNT/LRGCNT)*100
. I $Y+7>IOSL D
. . D NPG^LRCAPU Q:LREND
. . D SUMHDR
. Q:LREND
. W $J(LRACNT,8),?10,LRANAM,?42,$J(LRPCT,6,2),"% of grand total.",!
Q:LREND
W !,"Grand Total: ",$J(LRGCNT,8),!
D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
Q
SHFTHDR ;
I LRSTFLG=1 D
. W !!,"SHIFT#",LRSHFT," FROM: ",$P(LRST(LRSHFT),"^")," Hours TO: "
. W $P(LRST(LRSHFT),"^",2)," Hours." W:LRCONT " (cont.)" W !
E D
. W !!,"TIME RANGE FROM: ",$P(LRST(LRSHFT),"^")," Hours TO: "
. W $P(LRST(LRSHFT),"^",2)," Hours." W:LRCONT " (cont.)" W !
W !," Count Procedure Name Code "
W "Percent of shift subtotal",!
W $E(LRDSHS,1,80),!
Q
ACCHDR ;
W !,"Total count for each type of WKLD code:" W:LRCONT " (cont.)" W !
W !," Count Procedure Name Code "
W "Pct of Acc. area subtotal",!
W $E(LRDSHS,1,80),!
Q
SUMHDR ;
W !,"Summary by Accession Area:" W:LRCONT " (cont.)" W !
W !," Count Accession Area "
W "Percent of grand total",!
W $E(LRDSHS,1,80),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRP8C 3732 printed Sep 23, 2025@19:55:46 Page 2
LRRP8C ;DALISC/TNN/J0 - WKLD STATS REPORT BY SHIFT ; 4/9/93
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 WRITE !!,"ENTRY POINT IS AT EN^LRRP8."
HANG 3
QUIT
+3 ;
PRINT ;
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+2 SET LRGCNT=+$GET(^TMP("LR",$JOB,0))
+3 IF 'LRGCNT
WRITE !," *** NO DATA FOR THIS REPORT ***",!
QUIT
+4 if LRRPT=1
DO DET
if LREND
QUIT
+5 DO SUM
if LREND
QUIT
+6 DO PRNTMAN^LRCAPMR1
if LREND
QUIT
+7 DO COMM^LRCAPMR2
if LREND
QUIT
+8 QUIT
DET ;
+1 SET LRA=0
+2 FOR
SET LRA=$ORDER(^TMP("LR",$JOB,"AA",LRA))
if ('LRA)!(LREND)
QUIT
Begin DoDot:1
+3 SET LRANAM=$PIECE($GET(^LRO(68,LRA,0)),U)
+4 DO HDR^LRCAPU
+5 WRITE !,"Accession Area: ",LRANAM,!
+6 SET LRACNT=+$GET(^TMP("LR",$JOB,"AA",LRA,0))
+7 IF 'LRACNT
WRITE !," *** NO DATA FOR THIS ACCESSION AREA ***",!
QUIT
+8 SET LRSHFT=0
+9 FOR
SET LRSHFT=$ORDER(LRST(LRSHFT))
if ('LRSHFT)!(LREND)
QUIT
Begin DoDot:2
+10 SET LRCONT=0
DO SHFTHDR
SET LRCONT=1
+11 SET LRSCNT=+$GET(^TMP("LR",$JOB,"AA",LRA,"SHFT",LRSHFT,0))
+12 IF 'LRSCNT
WRITE !," *** NO DATA FOR THIS SHIFT ***",!
QUIT
+13 SET LRCAPNAM=""
+14 FOR
SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM))
if (LRCAPNAM="")!(LREND)
QUIT
Begin DoDot:3
+15 SET LRREC=$GET(^TMP("LR",$JOB,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM,0))
+16 SET LRCCNT=+LRREC
SET LRCAPNUM=$PIECE(LRREC,U,2)
+17 SET LRPCT=(LRCCNT/LRSCNT)*100
+18 IF $Y+7>IOSL
Begin DoDot:4
+19 DO NPG^LRCAPU
if LREND
QUIT
+20 WRITE !,"Accession Area: ",LRANAM," (cont.)",!
+21 DO SHFTHDR
End DoDot:4
+22 if LREND
QUIT
+23 WRITE $JUSTIFY(LRCCNT,7),?10,$EXTRACT(LRCAPNAM,1,30),?42,LRCAPNUM
+24 WRITE ?53,$JUSTIFY(LRPCT,6,2),"%",!
End DoDot:3
+25 if LREND
QUIT
+26 WRITE "Shift subtotal: ",$JUSTIFY(LRSCNT,8),!
End DoDot:2
+27 if LREND
QUIT
+28 DO AASUM
+29 if LREND
QUIT
+30 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE^LRCAPU
if LREND
QUIT
WRITE @IOF
End DoDot:1
+31 QUIT
AASUM ;*** Accession Area summary ***
+1 DO NPG^LRCAPU
if LREND
QUIT
WRITE !,"Accession Area: ",LRANAM," (cont.)",!
+2 IF LRSTFLG=1
Begin DoDot:1
+3 WRITE !
+4 SET LRSHFT=0
+5 FOR
SET LRSHFT=$ORDER(LRST(LRSHFT))
if ('LRSHFT)!(LREND)
QUIT
Begin DoDot:2
+6 SET LRSCNT=+$GET(^TMP("LR",$JOB,"AA",LRA,"SHFT",LRSHFT,0))
+7 SET LRPCT=(LRSCNT/LRACNT)*100
+8 WRITE "Shift#",LRSHFT,": ",$JUSTIFY(LRPCT,6,2)
+9 WRITE "% of ",LRANAM," total.",!
End DoDot:2
+10 WRITE !
End DoDot:1
+11 SET LRCONT=0
DO ACCHDR
SET LRCONT=1
+12 SET LRCAPNAM=""
+13 FOR
SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"AA",LRA,"CCN",LRCAPNAM))
if (LRCAPNAM="")!(LREND)
QUIT
Begin DoDot:1
+14 SET LRREC=$GET(^TMP("LR",$JOB,"AA",LRA,"CCN",LRCAPNAM,0))
+15 SET LRCCNT=+LRREC
SET LRCAPNUM=$PIECE(LRREC,U,2)
+16 SET LRPCT=(LRCCNT/LRACNT)*100
+17 IF $Y+5>IOSL
Begin DoDot:2
+18 DO NPG^LRCAPU
if LREND
QUIT
+19 WRITE !,"Accession Area: ",LRANAM," (cont.)",!
+20 DO ACCHDR
End DoDot:2
+21 if LREND
QUIT
+22 WRITE $JUSTIFY(LRCCNT,7),?10,$EXTRACT(LRCAPNAM,1,30),?42,LRCAPNUM
+23 WRITE ?53,$JUSTIFY(LRPCT,6,2),"%",!
End DoDot:1
+24 if LREND
QUIT
+25 WRITE !,LRANAM," subtotal: ",$JUSTIFY(LRACNT,8),!
+26 QUIT
SUM ;
+1 DO HDR^LRCAPU
+2 SET LRCONT=0
DO SUMHDR
SET LRCONT=1
+3 SET LRA=0
+4 FOR
SET LRA=$ORDER(^TMP("LR",$JOB,"AA",LRA))
if ('LRA)!(LREND)
QUIT
Begin DoDot:1
+5 SET LRANAM=$PIECE($GET(^LRO(68,LRA,0)),U)
+6 SET LRACNT=+$GET(^TMP("LR",$JOB,"AA",LRA,0))
+7 SET LRPCT=(LRACNT/LRGCNT)*100
+8 IF $Y+7>IOSL
Begin DoDot:2
+9 DO NPG^LRCAPU
if LREND
QUIT
+10 DO SUMHDR
End DoDot:2
+11 if LREND
QUIT
+12 WRITE $JUSTIFY(LRACNT,8),?10,LRANAM,?42,$JUSTIFY(LRPCT,6,2),"% of grand total.",!
End DoDot:1
+13 if LREND
QUIT
+14 WRITE !,"Grand Total: ",$JUSTIFY(LRGCNT,8),!
+15 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE^LRCAPU
if LREND
QUIT
WRITE @IOF
+16 QUIT
SHFTHDR ;
+1 IF LRSTFLG=1
Begin DoDot:1
+2 WRITE !!,"SHIFT#",LRSHFT," FROM: ",$PIECE(LRST(LRSHFT),"^")," Hours TO: "
+3 WRITE $PIECE(LRST(LRSHFT),"^",2)," Hours."
if LRCONT
WRITE " (cont.)"
WRITE !
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 WRITE !!,"TIME RANGE FROM: ",$PIECE(LRST(LRSHFT),"^")," Hours TO: "
+6 WRITE $PIECE(LRST(LRSHFT),"^",2)," Hours."
if LRCONT
WRITE " (cont.)"
WRITE !
End DoDot:1
+7 WRITE !," Count Procedure Name Code "
+8 WRITE "Percent of shift subtotal",!
+9 WRITE $EXTRACT(LRDSHS,1,80),!
+10 QUIT
ACCHDR ;
+1 WRITE !,"Total count for each type of WKLD code:"
if LRCONT
WRITE " (cont.)"
WRITE !
+2 WRITE !," Count Procedure Name Code "
+3 WRITE "Pct of Acc. area subtotal",!
+4 WRITE $EXTRACT(LRDSHS,1,80),!
+5 QUIT
SUMHDR ;
+1 WRITE !,"Summary by Accession Area:"
if LRCONT
WRITE " (cont.)"
WRITE !
+2 WRITE !," Count Accession Area "
+3 WRITE "Percent of grand total",!
+4 WRITE $EXTRACT(LRDSHS,1,80),!
+5 QUIT
