Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRRP8C

LRRP8C.m

Go to the documentation of this file.
  1. LRRP8C ;DALISC/TNN/J0 - WKLD STATS REPORT BY SHIFT ; 4/9/93
  1. ;;5.2;LAB SERVICE;;Sep 27, 1994
  1. W !!,"ENTRY POINT IS AT EN^LRRP8." H 3 QUIT
  1. ;
  1. PRINT ;
  1. W:$E(IOST,1,2)="C-" @IOF
  1. S LRGCNT=+$G(^TMP("LR",$J,0))
  1. I 'LRGCNT W !," *** NO DATA FOR THIS REPORT ***",! Q
  1. D:LRRPT=1 DET Q:LREND
  1. D SUM Q:LREND
  1. D PRNTMAN^LRCAPMR1 Q:LREND
  1. D COMM^LRCAPMR2 Q:LREND
  1. Q
  1. DET ;
  1. S LRA=0
  1. F S LRA=$O(^TMP("LR",$J,"AA",LRA)) Q:('LRA)!(LREND) D
  1. . S LRANAM=$P($G(^LRO(68,LRA,0)),U)
  1. . D HDR^LRCAPU
  1. . W !,"Accession Area: ",LRANAM,!
  1. . S LRACNT=+$G(^TMP("LR",$J,"AA",LRA,0))
  1. . I 'LRACNT W !," *** NO DATA FOR THIS ACCESSION AREA ***",! Q
  1. . S LRSHFT=0
  1. . F S LRSHFT=$O(LRST(LRSHFT)) Q:('LRSHFT)!(LREND) D
  1. . . S LRCONT=0 D SHFTHDR S LRCONT=1
  1. . . S LRSCNT=+$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,0))
  1. . . I 'LRSCNT W !," *** NO DATA FOR THIS SHIFT ***",! Q
  1. . . S LRCAPNAM=""
  1. . . F S LRCAPNAM=$O(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
  1. . . . S LRREC=$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM,0))
  1. . . . S LRCCNT=+LRREC,LRCAPNUM=$P(LRREC,U,2)
  1. . . . S LRPCT=(LRCCNT/LRSCNT)*100
  1. . . . I $Y+7>IOSL D
  1. . . . . D NPG^LRCAPU Q:LREND
  1. . . . . W !,"Accession Area: ",LRANAM," (cont.)",!
  1. . . . . D SHFTHDR
  1. . . . Q:LREND
  1. . . . W $J(LRCCNT,7),?10,$E(LRCAPNAM,1,30),?42,LRCAPNUM
  1. . . . W ?53,$J(LRPCT,6,2),"%",!
  1. . . Q:LREND
  1. . . W "Shift subtotal: ",$J(LRSCNT,8),!
  1. . Q:LREND
  1. . D AASUM
  1. . Q:LREND
  1. . D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
  1. Q
  1. AASUM ;*** Accession Area summary ***
  1. D NPG^LRCAPU Q:LREND W !,"Accession Area: ",LRANAM," (cont.)",!
  1. I LRSTFLG=1 D
  1. . W !
  1. . S LRSHFT=0
  1. . F S LRSHFT=$O(LRST(LRSHFT)) Q:('LRSHFT)!(LREND) D
  1. . . S LRSCNT=+$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,0))
  1. . . S LRPCT=(LRSCNT/LRACNT)*100
  1. . . W "Shift#",LRSHFT,": ",$J(LRPCT,6,2)
  1. . . W "% of ",LRANAM," total.",!
  1. . W !
  1. S LRCONT=0 D ACCHDR S LRCONT=1
  1. S LRCAPNAM=""
  1. F S LRCAPNAM=$O(^TMP("LR",$J,"AA",LRA,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
  1. . S LRREC=$G(^TMP("LR",$J,"AA",LRA,"CCN",LRCAPNAM,0))
  1. . S LRCCNT=+LRREC,LRCAPNUM=$P(LRREC,U,2)
  1. . S LRPCT=(LRCCNT/LRACNT)*100
  1. . I $Y+5>IOSL D
  1. . . D NPG^LRCAPU Q:LREND
  1. . . W !,"Accession Area: ",LRANAM," (cont.)",!
  1. . . D ACCHDR
  1. . Q:LREND
  1. . W $J(LRCCNT,7),?10,$E(LRCAPNAM,1,30),?42,LRCAPNUM
  1. . W ?53,$J(LRPCT,6,2),"%",!
  1. Q:LREND
  1. W !,LRANAM," subtotal: ",$J(LRACNT,8),!
  1. Q
  1. SUM ;
  1. D HDR^LRCAPU
  1. S LRCONT=0 D SUMHDR S LRCONT=1
  1. S LRA=0
  1. F S LRA=$O(^TMP("LR",$J,"AA",LRA)) Q:('LRA)!(LREND) D
  1. . S LRANAM=$P($G(^LRO(68,LRA,0)),U)
  1. . S LRACNT=+$G(^TMP("LR",$J,"AA",LRA,0))
  1. . S LRPCT=(LRACNT/LRGCNT)*100
  1. . I $Y+7>IOSL D
  1. . . D NPG^LRCAPU Q:LREND
  1. . . D SUMHDR
  1. . Q:LREND
  1. . W $J(LRACNT,8),?10,LRANAM,?42,$J(LRPCT,6,2),"% of grand total.",!
  1. Q:LREND
  1. W !,"Grand Total: ",$J(LRGCNT,8),!
  1. D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
  1. Q
  1. SHFTHDR ;
  1. I LRSTFLG=1 D
  1. . W !!,"SHIFT#",LRSHFT," FROM: ",$P(LRST(LRSHFT),"^")," Hours TO: "
  1. . W $P(LRST(LRSHFT),"^",2)," Hours." W:LRCONT " (cont.)" W !
  1. E D
  1. . W !!,"TIME RANGE FROM: ",$P(LRST(LRSHFT),"^")," Hours TO: "
  1. . W $P(LRST(LRSHFT),"^",2)," Hours." W:LRCONT " (cont.)" W !
  1. W !," Count Procedure Name Code "
  1. W "Percent of shift subtotal",!
  1. W $E(LRDSHS,1,80),!
  1. Q
  1. ACCHDR ;
  1. W !,"Total count for each type of WKLD code:" W:LRCONT " (cont.)" W !
  1. W !," Count Procedure Name Code "
  1. W "Pct of Acc. area subtotal",!
  1. W $E(LRDSHS,1,80),!
  1. Q
  1. SUMHDR ;
  1. W !,"Summary by Accession Area:" W:LRCONT " (cont.)" W !
  1. W !," Count Accession Area "
  1. W "Percent of grand total",!
  1. W $E(LRDSHS,1,80),!
  1. Q