C       This program was written by PAUL KLISSNER for BEST DATA SYSTEMS.
C       Date written:   November 3, 1980
C
        PARAMETER       PAGE_SIZE=12  !(12, OR 24 WITH AVO)
	INTEGER*4	SYS$GETJPI,ISTAT,ADDRESS,LENGTH,PID
	INTEGER*4	GRP,MEM,LOGTIM(2),PRIORITY,RETURN_MODE
	INTEGER*4	LENGTH2,ADDRESS2,NAME_LEN,PIDADR
	INTEGER*4	ADDRESS3,ADDRESS4,LENGTH3,LENGTH4,CPUTIM
	INTEGER*2	GETLIST(70) ,CHANNEL,IPAGE
	INTEGER*4	ADDRESS5,ADDRESS6,ADDRESS7,ADDRESS8,ADDRESS9
	INTEGER*4	ADDRESS10,LENGTH10,ITIME(4),READ
	INTEGER*4	LENGTH5,LENGTH6,LENGTH7,LENGTH8,LENGTH9
	CHARACTER	NAME*30,ERRMSG*256,VAR*4,BLANK*80,INTRANS*63
	CHARACTER	CR*1,ESC*1,TABCHAR*6,LOGTIMCHAR*63,BUFF*40
	CHARACTER	TERM*7,IMAGE*63,UNAME*12,DATE*63
	CHARACTER	NULL_IMAGE*63,PRIBUFF*1000,MODNAME*15,SPACES*15
        CHARACTER       CLEAR_REGION*9,DUMMY*1, CYCLE*2, DELT_TIME*13
	DATA		SPACES/'                '/
        DATA            DELT_TIME/'0 00:00:04.00'/,IPAGE/1/
	DATA		CR/13/,ESC/27/,RETURN_MODE/0/,CYCLE/'  '/
        COMMON          RETURN_MODE,ITIME,IPAGE
	EQUIVALENCE	(ADDRESS,GETLIST(3))
	EQUIVALENCE	(LENGTH, GETLIST(5))
!
	EQUIVALENCE	(ADDRESS2,GETLIST(9))
	EQUIVALENCE	(LENGTH2,GETLIST(11))
!
	EQUIVALENCE	(ADDRESS3,GETLIST(15))
	EQUIVALENCE	(LENGTH3,GETLIST(17))
!
	EQUIVALENCE	(ADDRESS4,GETLIST(21))
	EQUIVALENCE	(LENGTH4,GETLIST(23))
!
	EQUIVALENCE	(ADDRESS5,GETLIST(27))
	EQUIVALENCE	(LENGTH5,GETLIST(29))
!
	EQUIVALENCE	(ADDRESS6,GETLIST(33))
	EQUIVALENCE     (LENGTH6,GETLIST(35))
!
	EQUIVALENCE	(ADDRESS7,GETLIST(39))
	EQUIVALENCE	(LENGTH7,GETLIST(41))
!
	EQUIVALENCE	(ADDRESS8,GETLIST(45))
	EQUIVALENCE	(LENGTH8,GETLIST(47))
!
	EQUIVALENCE	(ADDRESS9,GETLIST(51))
	EQUIVALENCE	(LENGTH9,GETLIST(53))
!
	EQUIVALENCE	(ADDRESS10,GETLIST(57))
	EQUIVALENCE	(LENGTH10,GETLIST(59))
	DATA	BLANK/'                                        '/
	EXTERNAL JPI$_PRCNAM,JPI$_PID,SS$_NOMOREPROC,JPI$_GRP
	EXTERNAL JPI$_MEM,JPI$_TERMINAL,JPI$_LOGINTIM,JPI$_PRIB
	EXTERNAL JPI$_IMAGNAME,JPI$_USERNAME,JPI$_CPUTIM,EXITROUTE
118     FORMAT(' ',A,$)
119     FORMAT(A)
444     FORMAT(I2)
1010	TYPE 118,ESC//'[H'//ESC//'[J'//'Cycle time: '      
        READ(5,119)CYCLE
        IF (CYCLE.EQ.'  ') GOTO 5555
        IF (CYCLE(2:2).EQ.' ')THEN
            CYCLE(2:2)=CYCLE(1:1)
            CYCLE(1:1)='0'
        ENDIF
        DECODE(2,444,CYCLE,ERR=1010) ILOOP
        DELT_TIME='0 00:00:'//CYCLE//'.00'
        IF (ILOOP.EQ.0) RETURN_MODE=1
5555	CALL SYS$BINTIM(DELT_TIME,ITIME)
	OPEN(UNIT=1,FILE='SYS$COMMAND',TYPE='OLD',RECORDSIZE=132)
!

	GETLIST(2)=%LOC(JPI$_PID)
	GETLIST(1)=4
	ADDRESS=%LOC(PID)
	LENGTH=0
!
	GETLIST(8)=%LOC(JPI$_PRCNAM)
	GETLIST(7)=15
	ADDRESS2=%LOC(NAME)
	LENGTH2=%LOC(NAME_LEN)
!
	GETLIST(14)=%LOC(JPI$_GRP)
	GETLIST(13)=4
	ADDRESS3=%LOC(GRP)
	LENGTH3=0
!
	GETLIST(20)=%LOC(JPI$_MEM)
	GETLIST(19)=4
	ADDRESS4=%LOC(MEM)
	LENGTH4=0
!

	GETLIST(26)=%LOC(JPI$_LOGINTIM)
	GETLIST(25)=8
	ADDRESS5=%LOC(LOGTIM)
	LENGTH5=0
!
	GETLIST(32)=%LOC(JPI$_TERMINAL)
	GETLIST(31)=7
	ADDRESS6=%LOC(TERM)
	LENGTH6=0
!
	GETLIST(38)=%LOC(JPI$_USERNAME)
	GETLIST(37)=12
	ADDRESS7=%LOC(UNAME)
	LENGTH7=0
!
	GETLIST(44)=%LOC(JPI$_IMAGNAME)
	GETLIST(43)=63
	ADDRESS8=%LOC(IMAGE)
	LENGTH8=0
!
	GETLIST(50)=%LOC(JPI$_CPUTIM)
	GETLIST(49)=4
	ADDRESS9=%LOC(CPUTIM)
	LENGTH9=0
!
	GETLIST(56)=%LOC(JPI$_PRIB)
	GETLIST(55)=4
	ADDRESS10=%LOC(PRIORITY)
	LENGTH10=0
!
	GETLIST(61)=0
!
4567	TYPE *,ESC//'<'//ESC//'[H'//ESC//'[J'//ESC//'[?3h'//ESC//'[4w'
	TABCHAR=CR//ESC//'[8C'
        CALL HEADER
	PIDADR=-1
	IPRI=1
777	ISTAT=SYS$GETJPI(%VAL(2),PIDADR,,GETLIST,,,)
	CALL SYS$WAITFR(%VAL(2))
78	FORMAT(A)
17	FORMAT(' ',A132,$)
18	FORMAT('+',A,$)
	IF (ISTAT.EQ.%LOC(SS$_NOMOREPROC)) THEN
                CALL WAIT_FOR_PAGE
                IPAGE=1
		GOTO 4567
	ENDIF
	CALL SYS$ASCTIM(,LOGTIMCHAR,LOGTIM,%VAL(1))
!	IF ((NAME(:6).EQ.'ERRFMT').OR.(NAME(:5).EQ.'OPCOM')
!     -.OR.(NAME(:11).EQ.'JOB_CONTROL').OR.
!     -(INDEX(NAME,'ACP').GT.0).OR.
!     -(INDEX(NAME,'PRTSYMB').GT.0)) GOTO 777
!      IF (INDEX(IMAGE,'PRIDISP').GT.0) GOTO 777
	IF (INDEX(IMAGE,'.').EQ.0) THEN
		IMAGE=NULL_IMAGE
		IMAGE(:25)='---- No active image ----'
	ENDIF
104     FORMAT(A)
105     FORMAT(' ',A,$)
	IF (TERM(5:5).NE.':') TERM(:5)='-----'
        IF (IPRI.GT.PAGE_SIZE-5) THEN
           CALL WAIT_FOR_PAGE
           CALL HEADER
           IPAGE=IPAGE+1
           IPRI=1
        ENDIF
106 	WRITE(1,2)PID,TERM(:5),GRP,MEM
        WRITE(1,3)LOGTIMCHAR(:5),CPUTIM,PRIORITY,UNAME,IMAGE
	WRITE(1,4)CR,NAME
        IPRI=IPRI+1
	GOTO 777
2	FORMAT(' ',12X,Z8,3X,A5,3X,'[',O3.3,',',O3.3,'] ',$)
3	FORMAT('+',6X,A5,3X,I8,5X,I2,6X,A12,2X,A63)
4       FORMAT('+',A1,A15)
	END
        SUBROUTINE WAIT_FOR_PAGE
        INTEGER*4  RETURN_MODE,ITIME(4)
        INTEGER*2  IPAGE
        CHARACTER*63  TIME,ESC*1
        DATA ESC/27/
        COMMON RETURN_MODE,ITIME,IPAGE
	CALL SYS$ASCTIM(,TIME,,%VAL(0))
104     FORMAT(A)
105     FORMAT('+',80X,A,$)
106     FORMAT(' ',A,'Page ',I2,$)
        TYPE *,' '
        TYPE 106,ESC//'[12;1H',IPAGE
        IF (RETURN_MODE.EQ.1) THEN
                  TYPE 105,'   Press RETURN for next page - '
                  READ(1,104)DUMMY
        ELSE
                  CALL SYS$SETIMR(%VAL(1),ITIME,,)
                  CALL SYS$WAITFR(%VAL(1))
        ENDIF
        RETURN
        END
        SUBROUTINE HEADER
        CHARACTER*63  DATE,ESC*1
        DATA ESC/27/
	CALL SYS$ASCTIM(,DATE,,%VAL(0))
        WRITE(1,10)ESC//'[H'//ESC//'[J'
	WRITE(1,10)'Process name   PID   Terminal    UIC        '
        WRITE(1,10)'Login time    CPU time  Pri    '
        WRITE(1,11)' Username      Image         ',DATE(:20)
	WRITE(1,*)' '
10	FORMAT('+',A,$)
11	FORMAT('+',A,2X,A24,A,I2)
        RETURN
        END
