       PROGRAM QUEUE_DISPLAY
C
C Program QUEUE_DISPLAY
C This program will display the status of each print queue and the estimated
C time to clear the queue.  It will also display the time to print each job
C taking into account the number of blocks already printed.  This program 
C runs under VMS 4.3 and was inspired by a similiar program, QDisplay by 
C John Chong and the example in the VMS System Services manual, 
C p. SYS-269 SYS-270 (VMS 4.3 documentation set)
C
C Michael Eklund
C University of Washington Physics Department
C Physics Hall, FM-15
C Seattle, WA 98195
C (206) 545-8695
C 
C BITNET:  MIKE@UWAPHAST
C UUCP:    inhp4!uw-beaver!uw-june!phastvax!mike
C
       IMPLICIT NONE

       PARAMETER	MAX_QUEUES = 10

C
C DEC failed to include job pending in $QUIDEF module of FORSYSDEF.TLB
C
       PARAMETER        QUI$M_JOB_PENDING = 0

       INTEGER*4	SYS$GETQUIW
       INTEGER*4	STATUS_Q
       INTEGER*4	STATUS_J
       INTEGER*4	NOACCESS
       INTEGER*4	I
       INTEGER*4	SPEED_CPS(MAX_QUEUES)
       CHARACTER*31	DEV_Q_NAMES(MAX_QUEUES)
       CHARACTER*6      JOB_STATE
       REAL		CLEAR_TIME
       REAL             TOTAL_CLEAR_TIME
       INTEGER*2        FIRST_JOB, FOUND, HEADER_PRINT

       INCLUDE		'($QUIDEF)'
c
c   2)  Specify for each Device Queue:
c		o  Queue name;
c		o  Queued device's output (print) speed in CPS.
 
       DATA DEV_Q_NAMES(1), SPEED_CPS(1) /'LVA0', 960/ ! Versatec
       DATA DEV_Q_NAMES(2), SPEED_CPS(2) /'SYS$PRINT',150/ ! Printronix again
       DATA DEV_Q_NAMES(3), SPEED_CPS(3) /'TTA5', 120/ ! Exp. College
       DATA DEV_Q_NAMES(4), SPEED_CPS(4) /'TTD2', 035/ ! NEC  r. 304d
       DATA DEV_Q_NAMES(5), SPEED_CPS(5) /'TTF5', 120/ ! LA100 Lewis
       DATA DEV_Q_NAMES(6), SPEED_CPS(6) /'TTM5', 035/	! NEC  r. 252
       DATA DEV_Q_NAMES(7), SPEED_CPS(7) /'TXA2', 120/ ! TTY40 JOHNSON 215-3
       DATA DEV_Q_NAMES(8), SPEED_CPS(8) /'TXA5', 035/	! NEC  r. 215a
       DATA DEV_Q_NAMES(9), SPEED_CPS(9) /'TXA6', 150/	! Printronix 300 LPM
       DATA DEV_Q_NAMES(10), SPEED_CPS(10) /'TXA7', 480/	! Laser Printer
 
       ! Define item list structure
       STRUCTURE	/ITMLST/
          UNION
             MAP
                INTEGER*2	BUFLEN, ITMCOD
                INTEGER*4 BUFADR, RETADR
             END MAP
             MAP
                INTEGER*4	END_LIST
             END MAP
          END UNION
       END STRUCTURE

C      Define I/O status block structure
       STRUCTURE	/IOSBLK/
          INTEGER*4	STS,ZEROED
       END STRUCTURE

C      Declare $GETQUIW item lists and I/O status block
       RECORD /ITMLST/	QUEUE_LIST(4)
       RECORD /ITMLST/ JOB_LIST(8)
       RECORD /IOSBLK/	IOSB
	
C      Declare variables used in $GETQUIW item lists
       CHARACTER*31	SEARCH_NAME
       CHARACTER*31	QUEUE_NAME
       CHARACTER*27	JOB_NAME
       CHARACTER*12	USERNAME
       INTEGER*2	SEARCH_NAME_LEN
       INTEGER*2        QUEUE_NAME_LEN
       INTEGER*2	JOB_NAME_LEN
       INTEGER*2	USERNAME_LEN
       INTEGER*4	SEARCH_FLAGS
       INTEGER*4	JOB_SIZE
       INTEGER*4	JOB_STATUS
       INTEGER*4	ENTRY_NUMBER
       INTEGER*4        COMPLETED_BLOCKS

C      Solicit queue name to search; it may be a wildcard name
       SEARCH_NAME='*'
       SEARCH_NAME_LEN=1

C      Initialize item list for the display operation
       QUEUE_LIST(1).BUFLEN = SEARCH_NAME_LEN
       QUEUE_LIST(1).ITMCOD = QUI$_SEARCH_NAME
       QUEUE_LIST(1).BUFADR = %LOC(SEARCH_NAME)
       QUEUE_LIST(1).RETADR = 0
       QUEUE_LIST(2).BUFLEN = 4
       QUEUE_LIST(2).ITMCOD = QUI$_SEARCH_FLAGS
       QUEUE_LIST(2).BUFADR = %LOC(SEARCH_FLAGS)
       QUEUE_LIST(2).RETADR = 0
       QUEUE_LIST(3).BUFLEN = 31
       QUEUE_LIST(3).ITMCOD = QUI$_QUEUE_NAME
       QUEUE_LIST(3).BUFADR = %LOC(QUEUE_NAME)
       QUEUE_LIST(3).RETADR = %LOC(QUEUE_NAME_LEN)
       QUEUE_LIST(4).END_LIST = 0

C      Initialize item list for the display job operation
       JOB_LIST(1).BUFLEN = 4
       JOB_LIST(1).ITMCOD = QUI$_SEARCH_FLAGS
       JOB_LIST(1).BUFADR = %LOC(SEARCH_FLAGS)
       JOB_LIST(1).RETADR = 0
       JOB_LIST(2).BUFLEN = 4
       JOB_LIST(2).ITMCOD = QUI$_JOB_SIZE
       JOB_LIST(2).BUFADR = %LOC(JOB_SIZE)
       JOB_LIST(2).RETADR = 0
       JOB_LIST(3).BUFLEN = 39
       JOB_LIST(3).ITMCOD = QUI$_JOB_NAME
       JOB_LIST(3).BUFADR = %LOC(JOB_NAME)
       JOB_LIST(3).RETADR = %LOC(JOB_NAME_LEN)
       JOB_LIST(4).BUFLEN = 12
       JOB_LIST(4).ITMCOD = QUI$_USERNAME
       JOB_LIST(4).BUFADR = %LOC(USERNAME)
       JOB_LIST(4).RETADR = %LOC(USERNAME_LEN)
       JOB_LIST(5).BUFLEN = 4
       JOB_LIST(5).ITMCOD = QUI$_JOB_STATUS
       JOB_LIST(5).BUFADR = %LOC(JOB_STATUS)
       JOB_LIST(5).RETADR = 0
       JOB_LIST(6).BUFLEN = 4
       JOB_LIST(6).ITMCOD = QUI$_ENTRY_NUMBER
       JOB_LIST(6).BUFADR = %LOC(ENTRY_NUMBER)
       JOB_LIST(6).RETADR = 0
       JOB_LIST(7).BUFLEN = 4
       JOB_LIST(7).ITMCOD = QUI$_COMPLETED_BLOCKS
       JOB_LIST(7).BUFADR = %LOC(COMPLETED_BLOCKS)
       JOB_LIST(7).RETADR = 0
       JOB_LIST(8).END_LIST= 0

C      Request search of all jobs present in output queues; also force
C      wildcard mode to maintain the internal search context block after
C      the first call when a non-wild queue name is entered--this preserves
C      queue context for the subsequent display job operation
      SEARCH_FLAGS = (QUI$M_SEARCH_WILDCARD .OR.
     1                QUI$M_SEARCH_SYMBIONT .OR.
     2                QUI$M_SEARCH_ALL_JOBS)

C     Dissolve any internal search context block for the process
      STATUS_Q = SYS$GETQUIW (,%VAL(QUI$_CANCEL_OPERATION),,,,,)
      IF (.NOT. STATUS_Q) CALL EXIT(STATUS_Q)

      HEADER_PRINT = .TRUE.
C     Locate next output queue; loop until an error status is returned
      DO WHILE (STATUS_Q)
         STATUS_Q = SYS$GETQUIW(,
     1                           %VAL(QUI$_DISPLAY_QUEUE),,
     2                           QUEUE_LIST,
     3                           IOSB,,)
         IF (.NOT. STATUS_Q) CALL EXIT(STATUS_Q)
   
         IF (STATUS_Q) STATUS_Q = IOSB.STS
         STATUS_J = 1
         FIRST_JOB = .TRUE.

C     Get information on next job in queue; loop until error return
         DO WHILE (STATUS_Q .AND. STATUS_J)
            STATUS_J = SYS$GETQUIW (,
     1                               %VAL(QUI$_DISPLAY_JOB),,
     2                               JOB_LIST,
     3                               IOSB,,)
            IF (.NOT. STATUS_J) CALL EXIT(STATUS_J)
            IF (STATUS_J) STATUS_J = IOSB.STS
            IF (STATUS_J) THEN
               IF (JOB_STATUS.EQ.QUI$M_JOB_EXECUTING) THEN
                  JOB_STATE = 'Curr'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_HOLDING) THEN
                  JOB_STATE = 'Hold'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_TIMED) THEN
                  JOB_STATE = 'Time'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_ABORTING) THEN
                  JOB_STATE = 'Abort'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_REFUSED) THEN
                  JOB_STATE = 'Refuse'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_RETAINED) THEN
                  JOB_STATE = 'Retain'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_STARTING) THEN
                  JOB_STATE = 'Start'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_INACCESSIBLE) THEN
                  JOB_STATE = 'Inacc'
               ELSEIF (JOB_STATUS.EQ.QUI$M_JOB_PENDING) THEN
                  JOB_STATE = 'Pend'
               ELSE
                  JOB_STATE = 'ERROR'
                  CALL EXIT (1)
               ENDIF
C
C              strip off trailing NUL's
C
               QUEUE_NAME = QUEUE_NAME(1:INDEX(QUEUE_NAME,CHAR(0))-1)

               IF (FIRST_JOB) THEN
                  I = 0
                  FOUND = .FALSE.
                  DO WHILE ((I.LT.MAX_QUEUES).AND.(.NOT.FOUND))
                     I = I + 1
                     IF (QUEUE_NAME.EQ.DEV_Q_NAMES(I))
     1                  FOUND = .TRUE.
                  ENDDO
               ENDIF
               IF (JOB_SIZE .GT. 0) THEN
                  CLEAR_TIME = FLOAT(JOB_SIZE-COMPLETED_BLOCKS) * 
     1                         512.0 /
     2                         FLOAT(SPEED_CPS(I)) /
     3                         60.0
               ENDIF
               IF (HEADER_PRINT) WRITE (6,1000)
               HEADER_PRINT = .FALSE. 
               IF (FIRST_JOB) THEN
                  WRITE (6,1010) QUEUE_NAME,
     1                           USERNAME(1:USERNAME_LEN),
     2                           JOB_SIZE, JOB_STATE, ENTRY_NUMBER,
     3                           CLEAR_TIME,
     4                           JOB_NAME(1:JOB_NAME_LEN) 
               ELSE
                  WRITE (6,1015) USERNAME(1:USERNAME_LEN),
     1                           JOB_SIZE, JOB_STATE, ENTRY_NUMBER,
     2                           CLEAR_TIME,
     3                           JOB_NAME(1:JOB_NAME_LEN) 
               ENDIF
            ENDIF
            JOB_SIZE=0
            TOTAL_CLEAR_TIME = TOTAL_CLEAR_TIME + CLEAR_TIME
            CLEAR_TIME = 0.0
            FIRST_JOB = .FALSE.
         ENDDO
         IF (TOTAL_CLEAR_TIME.GT.0) THEN
            WRITE (6,1020) TOTAL_CLEAR_TIME
         ENDIF
         TOTAL_CLEAR_TIME = 0
         FIRST_JOB = .TRUE.
      ENDDO

 1010 FORMAT (1X,A,T17,A,T30,I4,T35,A,T41,I4,T46,F5.1,T52,A)
 1015 FORMAT (1X,T17,A,T30,I4,T35,A,T41,I4,T46,F5.1,T52,A)
 1000 FORMAT (1X,'Queue name',T17,'Username',T30,'Size',T35,'State',
     1           T41,'Entry',T47,'Time',T52,'Job name')
 1020 FORMAT (5X,F5.1,' minutes')

      CALL EXIT
      END
