LRCAPMR1 ;DALISC/J0 - WKLD STATS REPORT - STD/QC/RPT/MAN PRINT ; 4/9/93
;;5.2;LAB SERVICE;;Sep 27, 1994
;
INITMAN ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
K ^TMP("LR",$J,"GCOM")
K ^TMP("LR",$J,"CCOM")
K ^TMP("LR",$J,"DCOM")
K ^TMP("LR",$J,"CCN")
S (LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN)=0
Q
CLNMAN ;Called by: LRCAPMA,LRCAPML,LRRP8
K ^TMP("LR",$J,"GCOM")
K ^TMP("LR",$J,"CCOM")
K ^TMP("LR",$J,"DCOM")
K ^TMP("LR",$J,"CCN")
K LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN
Q
PRNTMAN ;Called from LRCAPMA2,LRCAPML2,LRRP8C
N LRSKIP,LRSTND,LRQC,LRRPT,LRMANL,LRCAPNUM,LRHDR,LRHDR3,LRCLHDR
S LRHDR="WORKLOAD INPUT MANUALLY"
S LRHDR3="[Includes all manual workload data for date range]"
S LRCLHDR="Workload Procedure Code STANDARD QC REPEAT MANUAL "
D HDR^LRCAPU
I '((LRGSTND)!(LRGQC)!(LRGRPT)!(LRGMANL)) D
. W !!," *** NO SQRM DATA FOR THIS REPORT ***",!!
. D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
. S LRSKIP=1
Q:$G(LRSKIP)!(LREND)
S LRCAPNAM=""
F S LRCAPNAM=$O(^TMP("LR",$J,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
. S LRSQRM=$G(^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0))
. S LRSTND=+$P(LRSQRM,U),LRQC=+$P(LRSQRM,U,2),LRRPT=+$P(LRSQRM,U,3)
. S LRMANL=+$P(LRSQRM,U,4),LRCAPNUM=$P(LRSQRM,U,5)
. Q:'(LRSTND+LRQC+LRRPT+LRMANL)
. I $Y+6'<IOSL D NPG^LRCAPU Q:LREND
. W $E(LRCAPNAM,1,30),?32,LRCAPNUM,?43,$J(LRSTND,7)
. W ?52,$J(LRQC,7),?61,$J(LRRPT,7),?70,$J(LRMANL,7),!
Q:LREND
W !!,"Grand SQRM Totals: ",?43,$J(LRGSTND,7),?52,$J(LRGQC,7)
W ?61,$J(LRGRPT,7),?70,$J(LRGMANL,7),!
D:$E(IOST,1,2)="C-" PAUSE^LRCAPU Q:LREND W @IOF
Q
BMPMANL ;Count WKLD entered manually
;Called by: LRCAPMA1,LRCAPML1,LRRP8B
S $P(^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0),U,5)=LRCAPNUM
S LRMNODE=$G(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S"))
;Grand totals for manual stuff
S LRGSTND=LRGSTND+$P(LRMNODE,U)
S LRGQC=LRGQC+$P(LRMNODE,U,2)
S LRGRPT=LRGRPT+$P(LRMNODE,U,3)
S LRGMANL=LRGMANL+$P(LRMNODE,U,4)
;WKLD code totals for manual stuff
S LRSQRM=$G(^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0))
S $P(LRSQRM,U)=$P(LRSQRM,U)+$P(LRMNODE,U)
S $P(LRSQRM,U,2)=$P(LRSQRM,U,2)+$P(LRMNODE,U,2)
S $P(LRSQRM,U,3)=$P(LRSQRM,U,3)+$P(LRMNODE,U,3)
S $P(LRSQRM,U,4)=$P(LRSQRM,U,4)+$P(LRMNODE,U,4)
S ^TMP("LR",$J,"CCN",LRCAPNAM,"SQRM",0)=LRSQRM
Q
GENCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
S LRCOM=0
F S LRCOM=$O(^LRO(64.1,LRIN,2,LRCOM)) Q:'LRCOM D
. S LRGCN=LRGCN+1
. S ^TMP("LR",$J,"GCOM",LRGCN)=$G(^LRO(64.1,LRIN,2,LRCOM,0))
Q
CAPCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
S LRCC=0
F S LRCC=$O(^LRO(64.1,LRIN,3,LRCC)) Q:'LRCC D
. I $G(LRCAPS) Q:'$D(LRCAPS(LRCC))
. S LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
. S ^TMP("LR",$J,"CCOM",LRCAPNAM,0)=LRCAPNUM
. S LRCOM=0
. F S LRCOM=$O(^LRO(64.1,LRIN,3,LRCC,1,LRCOM)) Q:'LRCOM D
. . S LRCCN=LRCCN+1
. . S ^TMP("LR",$J,"CCOM",LRCAPNAM,LRCCN)=$G(^LRO(64.1,LRIN,3,LRCC,1,LRCOM,0))
Q
DATCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
S LRCOM=0
F S LRCOM=$O(^LRO(64.1,LRIN,1,LRCDT,2,LRCOM)) Q:'LRCOM D
. S LRDCN=LRDCN+1
. S ^TMP("LR",$J,"DCOM",LRCDT,LRDCN)=$G(^LRO(64.1,LRIN,1,LRCDT,2,LRCOM,0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPMR1 3165 printed Apr 09, 2024@21:23:19 Page 2
LRCAPMR1 ;DALISC/J0 - WKLD STATS REPORT - STD/QC/RPT/MAN PRINT ; 4/9/93
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 ;
INITMAN ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
+1 KILL ^TMP("LR",$JOB,"GCOM")
+2 KILL ^TMP("LR",$JOB,"CCOM")
+3 KILL ^TMP("LR",$JOB,"DCOM")
+4 KILL ^TMP("LR",$JOB,"CCN")
+5 SET (LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN)=0
+6 QUIT
CLNMAN ;Called by: LRCAPMA,LRCAPML,LRRP8
+1 KILL ^TMP("LR",$JOB,"GCOM")
+2 KILL ^TMP("LR",$JOB,"CCOM")
+3 KILL ^TMP("LR",$JOB,"DCOM")
+4 KILL ^TMP("LR",$JOB,"CCN")
+5 KILL LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN
+6 QUIT
PRNTMAN ;Called from LRCAPMA2,LRCAPML2,LRRP8C
+1 NEW LRSKIP,LRSTND,LRQC,LRRPT,LRMANL,LRCAPNUM,LRHDR,LRHDR3,LRCLHDR
+2 SET LRHDR="WORKLOAD INPUT MANUALLY"
+3 SET LRHDR3="[Includes all manual workload data for date range]"
+4 SET LRCLHDR="Workload Procedure Code STANDARD QC REPEAT MANUAL "
+5 DO HDR^LRCAPU
+6 IF '((LRGSTND)!(LRGQC)!(LRGRPT)!(LRGMANL))
Begin DoDot:1
+7 WRITE !!," *** NO SQRM DATA FOR THIS REPORT ***",!!
+8 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE^LRCAPU
if LREND
QUIT
WRITE @IOF
+9 SET LRSKIP=1
End DoDot:1
+10 if $GET(LRSKIP)!(LREND)
QUIT
+11 SET LRCAPNAM=""
+12 FOR
SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"CCN",LRCAPNAM))
if (LRCAPNAM="")!(LREND)
QUIT
Begin DoDot:1
+13 SET LRSQRM=$GET(^TMP("LR",$JOB,"CCN",LRCAPNAM,"SQRM",0))
+14 SET LRSTND=+$PIECE(LRSQRM,U)
SET LRQC=+$PIECE(LRSQRM,U,2)
SET LRRPT=+$PIECE(LRSQRM,U,3)
+15 SET LRMANL=+$PIECE(LRSQRM,U,4)
SET LRCAPNUM=$PIECE(LRSQRM,U,5)
+16 if '(LRSTND+LRQC+LRRPT+LRMANL)
QUIT
+17 IF $Y+6'<IOSL
DO NPG^LRCAPU
if LREND
QUIT
+18 WRITE $EXTRACT(LRCAPNAM,1,30),?32,LRCAPNUM,?43,$JUSTIFY(LRSTND,7)
+19 WRITE ?52,$JUSTIFY(LRQC,7),?61,$JUSTIFY(LRRPT,7),?70,$JUSTIFY(LRMANL,7),!
End DoDot:1
+20 if LREND
QUIT
+21 WRITE !!,"Grand SQRM Totals: ",?43,$JUSTIFY(LRGSTND,7),?52,$JUSTIFY(LRGQC,7)
+22 WRITE ?61,$JUSTIFY(LRGRPT,7),?70,$JUSTIFY(LRGMANL,7),!
+23 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE^LRCAPU
if LREND
QUIT
WRITE @IOF
+24 QUIT
BMPMANL ;Count WKLD entered manually
+1 ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
+2 SET $PIECE(^TMP("LR",$JOB,"CCN",LRCAPNAM,"SQRM",0),U,5)=LRCAPNUM
+3 SET LRMNODE=$GET(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S"))
+4 ;Grand totals for manual stuff
+5 SET LRGSTND=LRGSTND+$PIECE(LRMNODE,U)
+6 SET LRGQC=LRGQC+$PIECE(LRMNODE,U,2)
+7 SET LRGRPT=LRGRPT+$PIECE(LRMNODE,U,3)
+8 SET LRGMANL=LRGMANL+$PIECE(LRMNODE,U,4)
+9 ;WKLD code totals for manual stuff
+10 SET LRSQRM=$GET(^TMP("LR",$JOB,"CCN",LRCAPNAM,"SQRM",0))
+11 SET $PIECE(LRSQRM,U)=$PIECE(LRSQRM,U)+$PIECE(LRMNODE,U)
+12 SET $PIECE(LRSQRM,U,2)=$PIECE(LRSQRM,U,2)+$PIECE(LRMNODE,U,2)
+13 SET $PIECE(LRSQRM,U,3)=$PIECE(LRSQRM,U,3)+$PIECE(LRMNODE,U,3)
+14 SET $PIECE(LRSQRM,U,4)=$PIECE(LRSQRM,U,4)+$PIECE(LRMNODE,U,4)
+15 SET ^TMP("LR",$JOB,"CCN",LRCAPNAM,"SQRM",0)=LRSQRM
+16 QUIT
GENCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
+1 SET LRCOM=0
+2 FOR
SET LRCOM=$ORDER(^LRO(64.1,LRIN,2,LRCOM))
if 'LRCOM
QUIT
Begin DoDot:1
+3 SET LRGCN=LRGCN+1
+4 SET ^TMP("LR",$JOB,"GCOM",LRGCN)=$GET(^LRO(64.1,LRIN,2,LRCOM,0))
End DoDot:1
+5 QUIT
CAPCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
+1 SET LRCC=0
+2 FOR
SET LRCC=$ORDER(^LRO(64.1,LRIN,3,LRCC))
if 'LRCC
QUIT
Begin DoDot:1
+3 IF $GET(LRCAPS)
if '$DATA(LRCAPS(LRCC))
QUIT
+4 SET LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
+5 SET ^TMP("LR",$JOB,"CCOM",LRCAPNAM,0)=LRCAPNUM
+6 SET LRCOM=0
+7 FOR
SET LRCOM=$ORDER(^LRO(64.1,LRIN,3,LRCC,1,LRCOM))
if 'LRCOM
QUIT
Begin DoDot:2
+8 SET LRCCN=LRCCN+1
+9 SET ^TMP("LR",$JOB,"CCOM",LRCAPNAM,LRCCN)=$GET(^LRO(64.1,LRIN,3,LRCC,1,LRCOM,0))
End DoDot:2
End DoDot:1
+10 QUIT
DATCOM ;Called by: LRCAPMA1,LRCAPML1,LRRP8B
+1 SET LRCOM=0
+2 FOR
SET LRCOM=$ORDER(^LRO(64.1,LRIN,1,LRCDT,2,LRCOM))
if 'LRCOM
QUIT
Begin DoDot:1
+3 SET LRDCN=LRDCN+1
+4 SET ^TMP("LR",$JOB,"DCOM",LRCDT,LRDCN)=$GET(^LRO(64.1,LRIN,1,LRCDT,2,LRCOM,0))
End DoDot:1
+5 QUIT
