source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPMR1.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.0 KB
RevLine 
[613]1LRCAPMR1 ;DALISC/J0 - WKLD STATS REPORT - STD/QC/RPT/MAN PRINT ; 4/9/93
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;
4INITMAN ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
5 K ^TMP("LR",$J,"GCOM")
6 K ^TMP("LR",$J,"CCOM")
7 K ^TMP("LR",$J,"DCOM")
8 K ^TMP("LR",$J,"CCN")
9 S (LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN)=0
10 Q
11CLNMAN ;Called by: LRCAPMA,LRCAPML,LRRP8
12 K ^TMP("LR",$J,"GCOM")
13 K ^TMP("LR",$J,"CCOM")
14 K ^TMP("LR",$J,"DCOM")
15 K ^TMP("LR",$J,"CCN")
16 K LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN
17 Q
18PRNTMAN ;Called from LRCAPMA2,LRCAPML2,LRRP8C
19 N LRSKIP,LRSTND,LRQC,LRRPT,LRMANL,LRCAPNUM,LRHDR,LRHDR3,LRCLHDR
20 S LRHDR="WORKLOAD INPUT MANUALLY"
21 S LRHDR3="[Includes all manual workload data for date range]"
22 S LRCLHDR="Workload Procedure Code STANDARD QC REPEAT MANUAL "
23 D HDR^LRCAPU
24 I '((LRGSTND)!(LRGQC)!(LRGRPT)!(LRGMANL)) D
25 . W !!," *** NO SQRM DATA FOR THIS REPORT ***",!!
26 . D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
27 . S LRSKIP=1
28 Q:$G(LRSKIP)!(LREND)
29 S LRCAPNAM=""
30 F S LRCAPNAM=$O(^TMP("LR",$J,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
31 . S LRSQRM=$G(^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0))
32 . S LRSTND=+$P(LRSQRM,U),LRQC=+$P(LRSQRM,U,2),LRRPT=+$P(LRSQRM,U,3)
33 . S LRMANL=+$P(LRSQRM,U,4),LRCAPNUM=$P(LRSQRM,U,5)
34 . Q:'(LRSTND+LRQC+LRRPT+LRMANL)
35 . I $Y+6'<IOSL D NPG^LRCAPU Q:LREND
36 . W $E(LRCAPNAM,1,30),?32,LRCAPNUM,?43,$J(LRSTND,7)
37 . W ?52,$J(LRQC,7),?61,$J(LRRPT,7),?70,$J(LRMANL,7),!
38 Q:LREND
39 W !!,"Grand SQRM Totals: ",?43,$J(LRGSTND,7),?52,$J(LRGQC,7)
40 W ?61,$J(LRGRPT,7),?70,$J(LRGMANL,7),!
41 D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
42 Q
43BMPMANL ;Count WKLD entered manually
44 ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
45 S $P(^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0),U,5)=LRCAPNUM
46 S LRMNODE=$G(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S"))
47 ;Grand totals for manual stuff
48 S LRGSTND=LRGSTND+$P(LRMNODE,U)
49 S LRGQC=LRGQC+$P(LRMNODE,U,2)
50 S LRGRPT=LRGRPT+$P(LRMNODE,U,3)
51 S LRGMANL=LRGMANL+$P(LRMNODE,U,4)
52 ;WKLD code totals for manual stuff
53 S LRSQRM=$G(^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0))
54 S $P(LRSQRM,U)=$P(LRSQRM,U)+$P(LRMNODE,U)
55 S $P(LRSQRM,U,2)=$P(LRSQRM,U,2)+$P(LRMNODE,U,2)
56 S $P(LRSQRM,U,3)=$P(LRSQRM,U,3)+$P(LRMNODE,U,3)
57 S $P(LRSQRM,U,4)=$P(LRSQRM,U,4)+$P(LRMNODE,U,4)
58 S ^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0)=LRSQRM
59 Q
60GENCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
61 S LRCOM=0
62 F S LRCOM=$O(^LRO(64.1,LRIN,2,LRCOM)) Q:'LRCOM D
63 . S LRGCN=LRGCN+1
64 . S ^TMP("LR",$J,"GCOM",LRGCN)=$G(^LRO(64.1,LRIN,2,LRCOM,0))
65 Q
66CAPCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
67 S LRCC=0
68 F S LRCC=$O(^LRO(64.1,LRIN,3,LRCC)) Q:'LRCC D
69 . I $G(LRCAPS) Q:'$D(LRCAPS(LRCC))
70 . S LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
71 . S ^TMP("LR",$J,"CCOM",LRCAPNAM,0)=LRCAPNUM
72 . S LRCOM=0
73 . F S LRCOM=$O(^LRO(64.1,LRIN,3,LRCC,1,LRCOM)) Q:'LRCOM D
74 . . S LRCCN=LRCCN+1
75 . . S ^TMP("LR",$J,"CCOM",LRCAPNAM,LRCCN)=$G(^LRO(64.1,LRIN,3,LRCC,1,LRCOM,0))
76 Q
77DATCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
78 S LRCOM=0
79 F S LRCOM=$O(^LRO(64.1,LRIN,1,LRCDT,2,LRCOM)) Q:'LRCOM D
80 . S LRDCN=LRDCN+1
81 . S ^TMP("LR",$J,"DCOM",LRCDT,LRDCN)=$G(^LRO(64.1,LRIN,1,LRCDT,2,LRCOM,0))
82 Q
Note: See TracBrowser for help on using the repository browser.