SUBROUTINE LSTLOG(IER) C C***************************************************************************** C C PURPOSE: TO LIST THE CURRENT CONTENTS OF THE LOG FILE. C C***************************************************************************** C LOGICAL*1 LD(32),DATTIM(18),YN LOGICAL FULL INTEGER LI(4),LO(4) REAL MON(0:12) INCLUDE 'LOGHDR.ADM' INCLUDE 'LOGVBL.ADM' INCLUDE 'LOGPR1.ADM' INCLUDE 'LOGPR2.ADM' C DATA MON/'***-','JAN-','FEB-','MAR-','APR-','MAY-','JUN-','JUL-', $'AUG-','SEP-','OCT-','NOV-','DEC-'/ C C C***************************************************************************** C C PRESET ERROR CODE ANS ASK FOR FULL LIST AND LIST DEVICE. C C***************************************************************************** C IER=-1 WRITE(6,5) 5 FORMAT(/'$FULL LIST? [Y/N]: ') READ(5,6,END=1000) YN 6 FORMAT(A1) FULL=.FALSE. IF(YN.EQ.'Y') FULL=.TRUE. WRITE(6,10) 10 FORMAT('$ENTER LIST DEVICE: ') READ(5,20,END=1000) NLD,(LD(I),I=1,NLD) 20 FORMAT(Q,32A1) CALL CLOSE(2) CALL ASSIGN(2,LD,NLD) C C***************************************************************************** C C GET DATE AND TIME AND WRITE THEM TO LIST DEVICE C C***************************************************************************** C CALL DATE(DATTIM) DATTIM(10)=' ' CALL TIME(DATTIM(11)) IF(.NOT.FULL) GO TO 27 C C***************************************************************************** C C PRINT ALL TERMINALS WHICH ARE LOGGED IN AND THEIR PROJECTS. C C***************************************************************************** C WRITE(2,21) DATTIM 21 FORMAT(1H1//1X,40('=')/' = PROCESSING DATE: ',18A1,' ='/ $1X,40('=')//) DO 25 I=1,10 IF(TTLGIN(I).EQ.0) GO TO 25 READ(1'TTLGIN(I)) IBFPR1 WRITE(2,23) I-1,(UIC(J),J=1,9),PRONAM 23 FORMAT(' TT',I1,': LOGGED IN AT ',9A1,' FOR PROJECT: ',32A1) 25 CONTINUE C C C***************************************************************************** C C MAIN DO LOOP. C C***************************************************************************** C C C 27 DO 100 I=1,30 C C***************************************************************************** C C FIND NEXT NON-EMPTY UIC RECORD. C C***************************************************************************** C IF(LRCHDR(1,I).NE.'[') GO TO 100 C C***************************************************************************** C C READ PROPER "VBN" BLOCK C C***************************************************************************** C IVBN=(I-1)/8+2 MUIC=MOD(I-1,8)+1 IF(MUIC.EQ.1) READ(1'IVBN,ERR=1000) IBFVBL C C***************************************************************************** C C PRINT ACCOUNT AND THE NUMBER OF PROJECTS C C***************************************************************************** C WRITE(2,21) DATTIM WRITE(2,30) (LRCHDR(J,I),J=1,9),IRCHDR(8,I) 30 FORMAT(//' ACCOUNT ',9A1,' HAS ',I2,' PROJECTS:') C C***************************************************************************** C C READ BOTH PROJECT BLOCKS AND PRINT THE CONTENTS OF THE FIRST ONE. C C***************************************************************************** C NJ=0 DO 100 J=1,32 IVBL=IRCVBL(J,MUIC) IF(IVBL.EQ.0) GO TO 100 NJ=NJ+1 READ(1'IVBL,ERR=1000) IBFPR1 READ(1'IVBL+1,ERR=1000) IBFPR2 WRITE(2,40) NJ,PRONAM 40 FORMAT(/1X,I2,'. PROJECT NAME: ',32A1) WRITE(2,45) 45 FORMAT(/1X,72('*')) RM=MON(GRANTS(2)) WRITE(2,50) GRANTL,GRANTS(3),RM,GRANTS(1),(GRANTS(K),K=4,8) 50 FORMAT(' *** GRAND TOTAL : ',I5,':',I2,':',I2,' SINCE ', $I2,'-',A4,I2,2X,I2,':',I2,':',I2,' ''',I2,'"',I2,' ***') RM=MON(TOTSNC(2)) WRITE(2,51) TOTLOG,TOTSNC(3),RM,TOTSNC(1),(TOTSNC(K),K=4,8) 51 FORMAT(' *** TOTAL CONNECT TIME: ',I5,':',I2,':',I2,' SINCE ', $I2,'-',A4,I2,2X,I2,':',I2,':',I2,' ''',I2,'"',I2,' ***') IP=ICURPN WRITE(2,52) 52 FORMAT(1X,72('*')) IF(.NOT.FULL) GO TO 100 C C***************************************************************************** C C PRINT THE OLD TOTALS OUT OF 2ND PROJECT BLOCK STARTING WITH THE MOST C RECENT ONE. C C***************************************************************************** C WRITE(2,522) 522 FORMAT(/6X,62('*')) DO 54 K=1,31 IP=IP-1 IF(IP.LE.0) IP=32 IF(IRCPR2(4,IP).LE.0) GO TO 54 RM=MON(IRCPR2(5,IP)) WRITE(2,53) (IRCPR2(JJ,IP),JJ=1,3),IRCPR2(6,IP),RM,IRCPR2(4,IP), $(IRCPR2(JJ,IP),JJ=7,8) 53 FORMAT(6X,'*** TOTAL CONNECT TIME: ',I5,':',I2,':',I2,' SINCE ', $I2,'-',A4,I2,2X,I2,':',I2,' ***') 54 CONTINUE WRITE(2,55) 55 FORMAT(6X,62('*')/) C C***************************************************************************** C C PRINT LAST LOGIN AND LAST LOGOUT FOR EVERY TERMINAL (0-9). C C***************************************************************************** C DO 70 K=1,10 RI=MON(LLGIN(2,K)) RO=MON(LLGOUT(2,K)) LI(1)=LLGIN(1,K) LO(1)=LLGOUT(1,K) DO 57 M=2,4 LI(M)=LLGIN(M+2,K) 57 LO(M)=LLGOUT(M+2,K) WRITE(2,60) K-1,LLGIN(3,K),RI,LI,LLGOUT(3,K),RO,LO 60 FORMAT(' TT',I1,': LAST LOGIN: ',I3,'-',A4,I2,I3,':',I2,':',I2,5X, $'LAST LOGOUT: ',I3,'-',A4,I2,I3,':',I2,':',I2) 70 CONTINUE C C C C***************************************************************************** C C END OF MAIN DO LOOP. C C***************************************************************************** C 100 CONTINUE C C IER=1 C C 1000 RETURN END