source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRRP8C.m@ 1258

Last change on this file since 1258 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1LRRP8C ;DALISC/TNN/J0 - WKLD STATS REPORT BY SHIFT ; 4/9/93
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 W !!,"ENTRY POINT IS AT EN^LRRP8." H 3 QUIT
4 ;
5PRINT ;
6 W:$E(IOST,1,2)="C-" @IOF
7 S LRGCNT=+$G(^TMP("LR",$J,0))
8 I 'LRGCNT W !," *** NO DATA FOR THIS REPORT ***",! Q
9 D:LRRPT=1 DET Q:LREND
10 D SUM Q:LREND
11 D PRNTMAN^LRCAPMR1 Q:LREND
12 D COMM^LRCAPMR2 Q:LREND
13 Q
14DET ;
15 S LRA=0
16 F S LRA=$O(^TMP("LR",$J,"AA",LRA)) Q:('LRA)!(LREND) D
17 . S LRANAM=$P($G(^LRO(68,LRA,0)),U)
18 . D HDR^LRCAPU
19 . W !,"Accession Area: ",LRANAM,!
20 . S LRACNT=+$G(^TMP("LR",$J,"AA",LRA,0))
21 . I 'LRACNT W !," *** NO DATA FOR THIS ACCESSION AREA ***",! Q
22 . S LRSHFT=0
23 . F S LRSHFT=$O(LRST(LRSHFT)) Q:('LRSHFT)!(LREND) D
24 . . S LRCONT=0 D SHFTHDR S LRCONT=1
25 . . S LRSCNT=+$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,0))
26 . . I 'LRSCNT W !," *** NO DATA FOR THIS SHIFT ***",! Q
27 . . S LRCAPNAM=""
28 . . F S LRCAPNAM=$O(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
29 . . . S LRREC=$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,"CCN",LRCAPNAM,0))
30 . . . S LRCCNT=+LRREC,LRCAPNUM=$P(LRREC,U,2)
31 . . . S LRPCT=(LRCCNT/LRSCNT)*100
32 . . . I $Y+7>IOSL D
33 . . . . D NPG^LRCAPU Q:LREND
34 . . . . W !,"Accession Area: ",LRANAM," (cont.)",!
35 . . . . D SHFTHDR
36 . . . Q:LREND
37 . . . W $J(LRCCNT,7),?10,$E(LRCAPNAM,1,30),?42,LRCAPNUM
38 . . . W ?53,$J(LRPCT,6,2),"%",!
39 . . Q:LREND
40 . . W "Shift subtotal: ",$J(LRSCNT,8),!
41 . Q:LREND
42 . D AASUM
43 . Q:LREND
44 . D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
45 Q
46AASUM ;*** Accession Area summary ***
47 D NPG^LRCAPU Q:LREND W !,"Accession Area: ",LRANAM," (cont.)",!
48 I LRSTFLG=1 D
49 . W !
50 . S LRSHFT=0
51 . F S LRSHFT=$O(LRST(LRSHFT)) Q:('LRSHFT)!(LREND) D
52 . . S LRSCNT=+$G(^TMP("LR",$J,"AA",LRA,"SHFT",LRSHFT,0))
53 . . S LRPCT=(LRSCNT/LRACNT)*100
54 . . W "Shift#",LRSHFT,": ",$J(LRPCT,6,2)
55 . . W "% of ",LRANAM," total.",!
56 . W !
57 S LRCONT=0 D ACCHDR S LRCONT=1
58 S LRCAPNAM=""
59 F S LRCAPNAM=$O(^TMP("LR",$J,"AA",LRA,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
60 . S LRREC=$G(^TMP("LR",$J,"AA",LRA,"CCN",LRCAPNAM,0))
61 . S LRCCNT=+LRREC,LRCAPNUM=$P(LRREC,U,2)
62 . S LRPCT=(LRCCNT/LRACNT)*100
63 . I $Y+5>IOSL D
64 . . D NPG^LRCAPU Q:LREND
65 . . W !,"Accession Area: ",LRANAM," (cont.)",!
66 . . D ACCHDR
67 . Q:LREND
68 . W $J(LRCCNT,7),?10,$E(LRCAPNAM,1,30),?42,LRCAPNUM
69 . W ?53,$J(LRPCT,6,2),"%",!
70 Q:LREND
71 W !,LRANAM," subtotal: ",$J(LRACNT,8),!
72 Q
73SUM ;
74 D HDR^LRCAPU
75 S LRCONT=0 D SUMHDR S LRCONT=1
76 S LRA=0
77 F S LRA=$O(^TMP("LR",$J,"AA",LRA)) Q:('LRA)!(LREND) D
78 . S LRANAM=$P($G(^LRO(68,LRA,0)),U)
79 . S LRACNT=+$G(^TMP("LR",$J,"AA",LRA,0))
80 . S LRPCT=(LRACNT/LRGCNT)*100
81 . I $Y+7>IOSL D
82 . . D NPG^LRCAPU Q:LREND
83 . . D SUMHDR
84 . Q:LREND
85 . W $J(LRACNT,8),?10,LRANAM,?42,$J(LRPCT,6,2),"% of grand total.",!
86 Q:LREND
87 W !,"Grand Total: ",$J(LRGCNT,8),!
88 D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
89 Q
90SHFTHDR ;
91 I LRSTFLG=1 D
92 . W !!,"SHIFT#",LRSHFT," FROM: ",$P(LRST(LRSHFT),"^")," Hours TO: "
93 . W $P(LRST(LRSHFT),"^",2)," Hours." W:LRCONT " (cont.)" W !
94 E D
95 . W !!,"TIME RANGE FROM: ",$P(LRST(LRSHFT),"^")," Hours TO: "
96 . W $P(LRST(LRSHFT),"^",2)," Hours." W:LRCONT " (cont.)" W !
97 W !," Count Procedure Name Code "
98 W "Percent of shift subtotal",!
99 W $E(LRDSHS,1,80),!
100 Q
101ACCHDR ;
102 W !,"Total count for each type of WKLD code:" W:LRCONT " (cont.)" W !
103 W !," Count Procedure Name Code "
104 W "Pct of Acc. area subtotal",!
105 W $E(LRDSHS,1,80),!
106 Q
107SUMHDR ;
108 W !,"Summary by Accession Area:" W:LRCONT " (cont.)" W !
109 W !," Count Accession Area "
110 W "Percent of grand total",!
111 W $E(LRDSHS,1,80),!
112 Q
Note: See TracBrowser for help on using the repository browser.