- LRARCMR1 ;DALISC/CKA - ARCHIVED WKLD STATS REPORT - STD/QC/RPT/MAN PRINT ; 5/22/95
- ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
- ;same as LRCAPMR1 except archived wkld file
- ;
- INITMAN ;Called by: LRARCMA1,LRARCML1,LRRP8B
- K ^TMP("LRAR",$J,"GCOM")
- K ^TMP("LRAR",$J,"CCOM")
- K ^TMP("LRAR",$J,"DCOM")
- K ^TMP("LRAR",$J,"CCN")
- S (LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN)=0
- Q
- CLNMAN ;Called by: LRARCMA,LRARCML,LRRP8
- K ^TMP("LRAR",$J,"GCOM")
- K ^TMP("LRAR",$J,"CCOM")
- K ^TMP("LRAR",$J,"DCOM")
- K ^TMP("LRAR",$J,"CCN")
- K LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN
- Q
- PRNTMAN ;Called from LRARCMA2,LRARCML2,LRRP8C
- N LRSKIP,LRSTND,LRQC,LRRPT,LRMANL,LRCAPNUM,LRHDR,LRHDR3,LRCLHDR
- S LRHDR="ARCHIVED WORKLOAD INPUT MANUALLY"
- S LRHDR3="[Includes all manual archived workload data for date range]"
- S LRCLHDR="Workload Procedure Code STANDARD QC REPEAT MANUAL "
- D HDR^LRARCU
- I '((LRGSTND)!(LRGQC)!(LRGRPT)!(LRGMANL)) D
- . W !!," *** NO SQRM DATA FOR THIS REPORT ***",!!
- . D:$E(IOST,1,2)="C-" PAUSE^LRARCU Q:LREND W @IOF
- . S LRSKIP=1
- Q:$G(LRSKIP)!(LREND)
- S LRCAPNAM=""
- F S LRCAPNAM=$O(^TMP("LRAR",$J,"CCN",LRCAPNAM)) Q:(LRCAPNAM="")!(LREND) D
- . S LRSQRM=$G(^TMP("LRAR",$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^LRARCU 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^LRARCU Q:LREND W @IOF
- Q
- BMPMANL ;Count WKLD entered manually
- ;Called by: LRARCMA1,LRARCML1,LRRP8B
- S $P(^TMP("LRAR",$J,"CCN",LRCAPNAM,"SQRM",0),U,5)=LRCAPNUM
- S LRMNODE=$G(^LAR(64.19999,LRIN,1,LRCDTN,1,LRCCN,"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("LRAR",$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("LRAR",$J,"CCN",LRCAPNAM,"SQRM",0)=LRSQRM
- Q
- GENCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
- S LRCOM=0
- F S LRCOM=$O(^LAR(64.19999,LRIN,2,LRCOM)) Q:'LRCOM D
- . S LRGCN=LRGCN+1
- . S ^TMP("LRAR",$J,"GCOM",LRGCN)=$G(^LAR(64.19999,LRIN,2,LRCOM,0))
- Q
- CAPCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
- S LRCC=0
- F S LRCC=$O(^LAR(64.19999,LRIN,3,LRCC)) Q:'LRCC D
- . I $G(LRCAPS) Q:'$D(LRCAPS(LRCC))
- . S LRCAPNAM=$$WKLDNAME^LRARCU(LRCC)
- . S ^TMP("LRAR",$J,"CCOM",LRCAPNAM,0)=LRCAPNUM
- . S LRCOM=0
- . F S LRCOM=$O(^LAR(64.19999,LRIN,3,LRCC,1,LRCOM)) Q:'LRCOM D
- . . S LRCCN=LRCCN+1
- . . S ^TMP("LRAR",$J,"CCOM",LRCAPNAM,LRCCN)=$G(^LAR(64.19999,LRIN,3,LRCC,1,LRCOM,0))
- Q
- DATCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
- S LRCOM=0
- F S LRCOM=$O(^LAR(64.19999,LRIN,1,LRCDTN,2,LRCOM)) Q:'LRCOM D
- . S LRDCN=LRDCN+1
- . S ^TMP("LRAR",$J,"DCOM",LRCDT,LRDCN)=$G(^LAR(64.19999,LRIN,1,LRCDTN,2,LRCOM,0))
- Q
- GETA ;Get pointer value for file 68
- K DIC S DIC=68,DIC(0)="XMZ"
- D ^DIC Q:Y=-1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCMR1 3403 printed Jan 18, 2025@03:09:56 Page 2
- LRARCMR1 ;DALISC/CKA - ARCHIVED WKLD STATS REPORT - STD/QC/RPT/MAN PRINT ; 5/22/95
- +1 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
- +2 ;same as LRCAPMR1 except archived wkld file
- +3 ;
- INITMAN ;Called by: LRARCMA1,LRARCML1,LRRP8B
- +1 KILL ^TMP("LRAR",$JOB,"GCOM")
- +2 KILL ^TMP("LRAR",$JOB,"CCOM")
- +3 KILL ^TMP("LRAR",$JOB,"DCOM")
- +4 KILL ^TMP("LRAR",$JOB,"CCN")
- +5 SET (LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN)=0
- +6 QUIT
- CLNMAN ;Called by: LRARCMA,LRARCML,LRRP8
- +1 KILL ^TMP("LRAR",$JOB,"GCOM")
- +2 KILL ^TMP("LRAR",$JOB,"CCOM")
- +3 KILL ^TMP("LRAR",$JOB,"DCOM")
- +4 KILL ^TMP("LRAR",$JOB,"CCN")
- +5 KILL LRGSTND,LRGQC,LRGRPT,LRGMANL,LRGCN,LRCCN,LRDCN
- +6 QUIT
- PRNTMAN ;Called from LRARCMA2,LRARCML2,LRRP8C
- +1 NEW LRSKIP,LRSTND,LRQC,LRRPT,LRMANL,LRCAPNUM,LRHDR,LRHDR3,LRCLHDR
- +2 SET LRHDR="ARCHIVED WORKLOAD INPUT MANUALLY"
- +3 SET LRHDR3="[Includes all manual archived workload data for date range]"
- +4 SET LRCLHDR="Workload Procedure Code STANDARD QC REPEAT MANUAL "
- +5 DO HDR^LRARCU
- +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^LRARCU
- 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("LRAR",$JOB,"CCN",LRCAPNAM))
- if (LRCAPNAM="")!(LREND)
- QUIT
- Begin DoDot:1
- +13 SET LRSQRM=$GET(^TMP("LRAR",$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^LRARCU
- 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^LRARCU
- if LREND
- QUIT
- WRITE @IOF
- +24 QUIT
- BMPMANL ;Count WKLD entered manually
- +1 ;Called by: LRARCMA1,LRARCML1,LRRP8B
- +2 SET $PIECE(^TMP("LRAR",$JOB,"CCN",LRCAPNAM,"SQRM",0),U,5)=LRCAPNUM
- +3 SET LRMNODE=$GET(^LAR(64.19999,LRIN,1,LRCDTN,1,LRCCN,"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("LRAR",$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("LRAR",$JOB,"CCN",LRCAPNAM,"SQRM",0)=LRSQRM
- +16 QUIT
- GENCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
- +1 SET LRCOM=0
- +2 FOR
- SET LRCOM=$ORDER(^LAR(64.19999,LRIN,2,LRCOM))
- if 'LRCOM
- QUIT
- Begin DoDot:1
- +3 SET LRGCN=LRGCN+1
- +4 SET ^TMP("LRAR",$JOB,"GCOM",LRGCN)=$GET(^LAR(64.19999,LRIN,2,LRCOM,0))
- End DoDot:1
- +5 QUIT
- CAPCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
- +1 SET LRCC=0
- +2 FOR
- SET LRCC=$ORDER(^LAR(64.19999,LRIN,3,LRCC))
- if 'LRCC
- QUIT
- Begin DoDot:1
- +3 IF $GET(LRCAPS)
- if '$DATA(LRCAPS(LRCC))
- QUIT
- +4 SET LRCAPNAM=$$WKLDNAME^LRARCU(LRCC)
- +5 SET ^TMP("LRAR",$JOB,"CCOM",LRCAPNAM,0)=LRCAPNUM
- +6 SET LRCOM=0
- +7 FOR
- SET LRCOM=$ORDER(^LAR(64.19999,LRIN,3,LRCC,1,LRCOM))
- if 'LRCOM
- QUIT
- Begin DoDot:2
- +8 SET LRCCN=LRCCN+1
- +9 SET ^TMP("LRAR",$JOB,"CCOM",LRCAPNAM,LRCCN)=$GET(^LAR(64.19999,LRIN,3,LRCC,1,LRCOM,0))
- End DoDot:2
- End DoDot:1
- +10 QUIT
- DATCOM ;Called by: LRARCMA1,LRARCML1,LRRP8B
- +1 SET LRCOM=0
- +2 FOR
- SET LRCOM=$ORDER(^LAR(64.19999,LRIN,1,LRCDTN,2,LRCOM))
- if 'LRCOM
- QUIT
- Begin DoDot:1
- +3 SET LRDCN=LRDCN+1
- +4 SET ^TMP("LRAR",$JOB,"DCOM",LRCDT,LRDCN)=$GET(^LAR(64.19999,LRIN,1,LRCDTN,2,LRCOM,0))
- End DoDot:1
- +5 QUIT
- GETA ;Get pointer value for file 68
- +1 KILL DIC
- SET DIC=68
- SET DIC(0)="XMZ"
- +2 DO ^DIC
- if Y=-1
- QUIT
- +3 QUIT