C SUBROUTINE TO RETURN LIST OF LOGGED-IN USER NAMES AND TERMINALS. C C CALL GETUSR(IBUF,LBUF,IER) C C IBUF: BUFFER TO RECEIVE NAMES AND TERMINALS C LBUF: NUMBER OF WORDS IN LBUF C IER: RETURNS 0 = SUCCESS C -1 = BUFFER NOT LONG ENOUGH C C EACH USER NAME REQUIRES 8. WORDS: NAME (12. BYTES, 6. WORDS), C TERMINAL TYPE (2 BYTES, 1 WORD), TERMINAL NUMBER (1 WORD) C C TASK MUST BE LINKED WITH SGA=HELBYE C SUBROUTINE GETUSR(IBUF,LBUF,IER) DIMENSION IBUF(320) DIMENSION JBUF(32) INTEGER*2 HELBYE COMMON /DATA/HELBYE(10,40) DATA ITT/'TT'/ C Set number of terminals on system NTERM=36 C Open may fail if someone is logging in c continue after error, don't count error, do ERR= contin c don't do message CALL ERRSET(30,.TRUE.,.FALSE.,.TRUE.,.FALSE.) IPOINT=1 OPEN (UNIT=4, ACCESS='DIRECT', RECORDSIZE=16, TYPE='OLD', 1 ERR=900, NAME='SD:[1,100]PDSUPF.DAT',READONLY) DO 1000 NN=1,NTERM JJ=HELBYE(9,NN) D WRITE(5,990) (HELBYE(M,NN),M=1,10) D990 FORMAT(' ',10(O6,' ')) IF (JJ.LT.1) GOTO 1000 READ(UNIT=4,REC=JJ) JBUF D WRITE(5,991) (JBUF(M),M=1,4) D991 FORMAT(' ',4(O6,' ')) CALL R50ASC(12,JBUF(1),IBUF(IPOINT)) IPOINT=IPOINT+6 IBUF(IPOINT)=ITT IPOINT=IPOINT+1 IBUF(IPOINT)=NN-1 IPOINT=IPOINT+1 IF(IPOINT.LE.LBUF) GOTO 1000 CLOSE (UNIT=4) 900 IER=-1 RETURN 1000 CONTINUE IER=0 C LBUF=IPOINT CLOSE (UNIT=4) RETURN END