source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARCMR1.m@ 1681

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1LRARCMR1 ;DALISC/CKA - ARCHIVED WKLD STATS REPORT - STD/QC/RPT/MAN PRINT ; 5/22/95
2 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
3 ;same as LRCAPMR1 except archived wkld file
4 ;
5INITMAN ;Called by: LRARCMA1,LRARCML1,LRRP8B
6 K ^TMP("LRAR",$J,"GCOM")
7 K ^TMP("LRAR",$J,"CCOM")
8 K ^TMP("LRAR",$J,"DCOM")
9 K ^TMP("LRAR",$J,"CCN")
10 S (LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN)=0
11 Q
12CLNMAN ;Called by: LRARCMA,LRARCML,LRRP8
13 K ^TMP("LRAR",$J,"GCOM")
14 K ^TMP("LRAR",$J,"CCOM")
15 K ^TMP("LRAR",$J,"DCOM")
16 K ^TMP("LRAR",$J,"CCN")
17 K LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN
18 Q
19PRNTMAN ;Called from LRARCMA2,LRARCML2,LRRP8C
20 N LRSKIP,LRSTND,LRQC,LRRPT,LRMANL,LRCAPNUM,LRHDR,LRHDR3,LRCLHDR
21 S LRHDR="ARCHIVED WORKLOAD INPUT MANUALLY"
22 S LRHDR3="[Includes all manual archived workload data for date range]"
23 S LRCLHDR="Workload Procedure Code STANDARD QC REPEAT MANUAL "
24 D HDR^LRARCU
25 I '((LRGSTND)!(LRGQC)!(LRGRPT)!(LRGMANL)) D
26 . W !!," *** NO SQRM DATA FOR THIS REPORT ***",!!
27 . D:$E(IOST,1,2)="C-" PAUSE^LRARCU Q:LREND W @IOF
28 . S LRSKIP=1
29 Q:$G(LRSKIP)!(LREND)
30 S LRCAPNAM=""
31 F S LRCAPNAM=$O(^TMP("LRAR",$J,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
32 . S LRSQRM=$G(^TMP("LRAR",$J,"CCN",LRCAPNAM,"SQRM",0))
33 . S LRSTND=+$P(LRSQRM,U),LRQC=+$P(LRSQRM,U,2),LRRPT=+$P(LRSQRM,U,3)
34 . S LRMANL=+$P(LRSQRM,U,4),LRCAPNUM=$P(LRSQRM,U,5)
35 . Q:'(LRSTND+LRQC+LRRPT+LRMANL)
36 . I $Y+6'<IOSL D NPG^LRARCU Q:LREND
37 . W $E(LRCAPNAM,1,30),?32,LRCAPNUM,?43,$J(LRSTND,7)
38 . W ?52,$J(LRQC,7),?61,$J(LRRPT,7),?70,$J(LRMANL,7),!
39 Q:LREND
40 W !!,"Grand SQRM Totals: ",?43,$J(LRGSTND,7),?52,$J(LRGQC,7)
41 W ?61,$J(LRGRPT,7),?70,$J(LRGMANL,7),!
42 D:$E(IOST,1,2)="C-" PAUSE^LRARCU Q:LREND W @IOF
43 Q
44BMPMANL ;Count WKLD entered manually
45 ;Called by: LRARCMA1,LRARCML1,LRRP8B
46 S $P(^TMP("LRAR",$J,"CCN",LRCAPNAM,"SQRM",0),U,5)=LRCAPNUM
47 S LRMNODE=$G(^LAR(64.19999,LRIN,1,LRCDTN,1,LRCCN,"S"))
48 ;Grand totals for manual stuff
49 S LRGSTND=LRGSTND+$P(LRMNODE,U)
50 S LRGQC=LRGQC+$P(LRMNODE,U,2)
51 S LRGRPT=LRGRPT+$P(LRMNODE,U,3)
52 S LRGMANL=LRGMANL+$P(LRMNODE,U,4)
53 ;WKLD code totals for manual stuff
54 S LRSQRM=$G(^TMP("LRAR",$J,"CCN",LRCAPNAM,"SQRM",0))
55 S $P(LRSQRM,U)=$P(LRSQRM,U)+$P(LRMNODE,U)
56 S $P(LRSQRM,U,2)=$P(LRSQRM,U,2)+$P(LRMNODE,U,2)
57 S $P(LRSQRM,U,3)=$P(LRSQRM,U,3)+$P(LRMNODE,U,3)
58 S $P(LRSQRM,U,4)=$P(LRSQRM,U,4)+$P(LRMNODE,U,4)
59 S ^TMP("LRAR",$J,"CCN",LRCAPNAM,"SQRM",0)=LRSQRM
60 Q
61GENCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
62 S LRCOM=0
63 F S LRCOM=$O(^LAR(64.19999,LRIN,2,LRCOM)) Q:'LRCOM D
64 . S LRGCN=LRGCN+1
65 . S ^TMP("LRAR",$J,"GCOM",LRGCN)=$G(^LAR(64.19999,LRIN,2,LRCOM,0))
66 Q
67CAPCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
68 S LRCC=0
69 F S LRCC=$O(^LAR(64.19999,LRIN,3,LRCC)) Q:'LRCC D
70 . I $G(LRCAPS) Q:'$D(LRCAPS(LRCC))
71 . S LRCAPNAM=$$WKLDNAME^LRARCU(LRCC)
72 . S ^TMP("LRAR",$J,"CCOM",LRCAPNAM,0)=LRCAPNUM
73 . S LRCOM=0
74 . F S LRCOM=$O(^LAR(64.19999,LRIN,3,LRCC,1,LRCOM)) Q:'LRCOM D
75 . . S LRCCN=LRCCN+1
76 . . S ^TMP("LRAR",$J,"CCOM",LRCAPNAM,LRCCN)=$G(^LAR(64.19999,LRIN,3,LRCC,1,LRCOM,0))
77 Q
78DATCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
79 S LRCOM=0
80 F S LRCOM=$O(^LAR(64.19999,LRIN,1,LRCDTN,2,LRCOM)) Q:'LRCOM D
81 . S LRDCN=LRDCN+1
82 . S ^TMP("LRAR",$J,"DCOM",LRCDT,LRDCN)=$G(^LAR(64.19999,LRIN,1,LRCDTN,2,LRCOM,0))
83 Q
84GETA ;Get pointer value for file 68
85 K DIC S DIC=68,DIC(0)="XMZ"
86 D ^DIC Q:Y=-1
87 Q
Note: See TracBrowser for help on using the repository browser.