FQAITMON IF  E                    DISK                           UC
     FCPUACTD CF  E                    WORKSTN
     F                                        SFLRRNKSFILE SFL
     ILDA        UDS
     I                                        1  10 LDAJOB
     I                                       11  20 LDAUSR
     I                                       21  26 LDANBR
     I              'SIGNOFF LOG(*LIST  )'C         SIGNOF
     I              'QPFR/QITMON'         C         QITMON
     I              '..1..2..3..4..5..6..-C         RULER
     I              '7..8..9..0'
     C           *NAMVAR   DEFN *LDA      LDA
B01  C           *INLR     DOUEQ*ON
     C                     CLOSEQAITMON                99
     C                     CALL QITMON                 LR
     C                     PARM '*FILE'   QITOUT 32        OUTPUT
     C                     PARM 30        QITITV 155       INTERVAL
     C                     PARM '*CPU'    QITSEQ 32        TYPE
     C                     PARM '*ALL'    QITTYP 32        JOBS/TASKS
     C                     PARM 1         QITNBR 155       HOW MANY
     C                     PARM 'QAITMON' QITMBR 32        MEMBER
     C                     PARM 'QGPL'    QITLIB 32        LIBRARY
B02  C           *INLR     IFEQ *ON
     C                     LEAVE
E02  C                     ENDIF
     C                     OPEN QAITMON
     C                     MOVE *OFF      *IN90
     C                     MOVE *OFF      *IN91
     C                     MOVE *ON       *IN92
     C                     WRITESFLCTL
     C                     MOVE *ON       *IN91
     C                     MOVE *OFF      *IN92
     C                     MOVE *OFF      *IN50
     C                     MOVE *OFF      *IN52
     C                     MOVE *OFF      *IN60
     C                     MOVE *OFF      *IN61
     C                     MOVE *OFF      *IN62
B02  C           1         DO   14        SFLRRN  40
     C                     READ QAITMON                939393=EOF
B03  C           *IN93     IFEQ *ON
     C                     LEAVE
E03  C                     ENDIF
B03  C           SFLRRN    IFEQ 1
     C                     MOVE *ON       *IN90
     C           ITVTIM    MULT .004096   ELPSEC    H
     C           CPUTOT    MULT .004096   CPUSEC    H
     C           CPUTOT    DIV  ITVTIM    WK0155 155H
     C           WK0155    MULT 100       CPUPCT    H
     C           WK0155    MULT 30        X       20H
     C           X         IFGT 30
     C                     Z-ADD30        X
     C                     ENDIF
B04  C           X         IFGT 0
     C           X         SUBSTRULER     CPUGPH    P
     C           CPUGPH    CAT  X'20':0   CPUGPH    P
X04  C                     ELSE
     C                     MOVELX'20'     CPUGPH    P
E04  C                     ENDIF
B04  C                     SELEC
     C           CPUPCT    WHLT 60
     C                     MOVE *ON       *IN60
     C           CPUPCT    WHLT 80
     C                     MOVE *ON       *IN61
     C                     OTHER
     C                     MOVE *ON       *IN62
E04  C                     ENDSL
     C                     MOVE NAME      LDAJOB
     C                     MOVE JOBUSR    LDAUSR
     C                     MOVE JOBNBR    LDANBR
     C                     OUT  LDA
E03  C                     ENDIF
     C                     MOVE NAME      JOBNAM
     C                     Z-ADDIOTOT     JOBIOT
     C                     MOVE PTY       JOBPTY
     C           CPUDLT    MULT .004096   JOBSEC    H
     C           CPUDLT    DIV  CPUTOT    WK0155    H
     C           WK0155    MULT 30        X         H
     C           X         IFGT 30
     C                     Z-ADD30        X
     C                     ENDIF
     C           WK0155    MULT CPUPCT    WK0155    H
B03  C           X         IFGT 0
     C           X         SUBSTRULER     JOBGPH    P
     C           JOBGPH    CAT  X'20':0   JOBGPH    P
X03  C                     ELSE
     C                     MOVELX'20'     JOBGPH    P
E03  C                     ENDIF
B03  C           WK0155    IFLT 50
     C                     MOVE *OFF      *IN51
X03  C                     ELSE
     C                     MOVE *ON       *IN51
     C                     MOVE *ON       *IN52
E03  C                     ENDIF
B03  C           *IN50     IFEQ *ON
     C                     MOVE *OFF      *IN50
X03  C                     ELSE
     C                     MOVE *ON       *IN50
E03  C                     ENDIF
     C                     WRITESFL
E02  C                     ENDDO
     C                     WRITEFOOT
     C                     WRITESFLCTL
     C                     SHTDN                     LR
E01  C                     ENDDO
     C                     CLOSEQAITMON                99
     C                     CALL 'QCMDEXC'              99
     C                     PARM SIGNOF    CMDSTR 20
     C                     PARM 20        CMDLEN 155
     C   LRNLR             EXFMTSFLCTL