From:	HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:46
To:	MHG <MHG%mitre-bedford.arpa@zermatt>, 
Subj:	BULLETIN6.FOR

C
C  BULLETIN6.FOR, Version 11/16/87
C  Purpose: Contains subroutines for the bulletin board utility program.
C  Environment: MIT PFC VAX-11/780, VMS
C  Programmer: Mark R. London
C
	SUBROUTINE UPDATE_LOGIN(ADD_BULL)
C
C  SUBROUTINE UPDATE_LOGIN
C
C  FUNCTION:  Updates the login file when a bulletin has been deleted
C	or added.
C
	IMPLICIT INTEGER (A - Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE '($BRKDEF)'

	INCLUDE '($SSDEF)'

	DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2)

	CHARACTER OUTPUT*160,TERMINAL*8
	CHARACTER*1 CR/13/,LF/10/,BELL/7/

C
C  We want to keep the last read date for comparison when selecting new
C  folders, so save it for later restoring.
C

	READ_BTIM_SAVE(1) = READ_BTIM(1)
	READ_BTIM_SAVE(2) = READ_BTIM(2)

	CALL OPEN_FILE_SHARED(4)

C
C  Newest date/time in user file only applies to general bulletins.
C  This was present before adding folder capability.
C  We set flags in user entry to show new folder added for folder bulletins.
C  However, the newest bulletin for each folder is not continually updated,
C  As it is only used when comparing to the last bulletin read time, and to
C  store this for each folder would be too expensive.
C

	DO WHILE (REC_LOCK(IER))
	   READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)
     &		TEMP_USER,TEMP_BTIM,BBOARD_BTIM,NEW_FLAG,
     &	        SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	END DO

	IF (IER.NE.0) THEN
	   CALL CLOSE_FILE(4)
	   RETURN
	ELSE IF (FOLDER_NUMBER.EQ.0) THEN
	   CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM)
	   REWRITE (4,FMT=USER_FMT) TEMP_USER,NEWEST_BTIM,BBOARD_BTIM,
     & 		NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	END IF

C
C  Set flags in all user entries that have SET READNEW on the particular
C  folder to indicate that a new bulletin is present for the particular folder.
C  Also send broadcast if notify flag set.
C
	OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '//
     &	 FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))//
     &   CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP))

	IF (ADD_BULL) THEN
	   IF (FOLDER_NUMBER.GT.0) THEN
	      CALL CHKACL
     &		(FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER)
	      IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
	         CHECK_ACL = 0
	      ELSE
	         CHECK_ACL = 1
	      END IF
	   ELSE
	       CHECK_ACL = 0
	   END IF
	END IF

	IF (ADD_BULL) THEN
	 IER = 1
	 DO WHILE (GETUSERS(TEMP_USER,TERMINAL))
	    DO WHILE (REC_LOCK(IER))
	      READ (4,FMT=USER_FMT,IOSTAT=IER,KEY=TEMP_USER) TEMP_USER,
     &		 LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,
     &		 NOTIFY_FLAG
	    END DO
	    IF (IER.EQ.0.AND.TEMP_USER.NE.FROM.AND.
     &	        TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN
	       IF (CHECK_ACL) THEN
	          CALL CHECK_ACCESS
     &			(FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',
     &			TEMP_USER,IER,WRITE_ACCESS)
	       ELSE
		  IER = 1
	       END IF
	       IF (IER) THEN
		  CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR,
     &		   TERMINAL(:TRIM(TERMINAL)),%VAL(BRK$C_DEVICE),,,,,,,)
	       ELSE
		  CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER)
	          REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &	            READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	       END IF
	    END IF
	 END DO
	END IF

	DO WHILE (REC_LOCK(IER))
	   READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,
     &	     LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,
     &	     NOTIFY_FLAG
		! Reobtain present values as calling programs still uses them
	END DO

	READ_BTIM(1) = READ_BTIM_SAVE(1)
	READ_BTIM(2) = READ_BTIM_SAVE(2)

	CALL CLOSE_FILE(4)

	RETURN

	END




 
	SUBROUTINE ADD_ENTRY
C
C  SUBROUTINE ADD_ENTRY
C
C  FUNCTION: Enters a new directory entry in the directory file.
C
	IMPLICIT INTEGER (A - Z)
	
	INCLUDE 'BULLDIR.INC'
	
	CHARACTER*23 TODAY_TIME

	CALL SYS$ASCTIM(,TODAY_TIME,,)
	DATE = TODAY_TIME(1:11)
	TIME = TODAY_TIME(13:20)

	CALL READDIR(0,IER)

	IF (IER.NE.1) THEN
	   NEWEST_EXDATE = '5-NOV-2000'
	   NEWEST_EXTIME = '00:00:00'
	   NBULL = 0
	   NBLOCK = 0
	   SHUTDOWN = 0
	   NEMPTY = 0
	END IF

	NEWEST_DATE = DATE
	NEWEST_TIME = TIME

	DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)
	IF (DIFF.GT.0) THEN
	   NEWEST_EXDATE = EXDATE
	   NEWEST_EXTIME = EXTIME
	ELSE IF (DIFF.EQ.0) THEN
	   DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)
	   IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME
	END IF

	NBULL = NBULL + 1
	BLOCK = NBLOCK + 1
	NBLOCK = NBLOCK + LENGTH

	IF ((SYSTEM.AND.4).EQ.4) THEN
	   SHUTDOWN = SHUTDOWN + 1
	   SHUTDOWN_DATE = DATE
	   SHUTDOWN_TIME = TIME
	END IF

	CALL UPDATE_LOGIN(.TRUE.)

	CALL WRITEDIR(NBULL,IER)

	CALL WRITEDIR(0,IER)

	RETURN
	END




	INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2)
C
C  FUNCTION COMPARE_BTIM
C
C  FUCTION: Compares times in binary format to see which is farther in future.
C
C  INPUTS:
C	BTIM1  -  First time in binary format
C	BTIM2  -  Second time in binary format
C  OUTPUT:
C	Returns +1 if first time is farther in future
C	Returns -1 if second time is farther in future
C	Returns 0 if equal time
C
	IMPLICIT INTEGER (A - Z)

	DIMENSION BTIM1(2),BTIM2(2),DIFF(2)

	CALL LIB$SUBX(BTIM1,BTIM2,DIFF)

	IF (DIFF(2).LT.0) THEN
	   COMPARE_BTIM = -1
	ELSE IF (DIFF(2).GE.0) THEN
	   COMPARE_BTIM = +1
	END IF

	RETURN
	END





	INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1)
C
C  FUNCTION MINUTE_DIFF
C
C  FUNCTION: Finds difference in minutes between 2 binary times.
C
C
	IMPLICIT INTEGER (A-Z)

	DIMENSION DATE1(2),DATE2(2)

	CALL LIB$DAY(DAYS1,DATE1,MSECS1)
	CALL LIB$DAY(DAYS2,DATE2,MSECS2)

	MINUTE_DIFF = (DAYS2-DAYS1)*3600 + (MSECS2-MSECS1)/6000

	RETURN
	END





 
	INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)
C
C  FUNCTION COMPARE_DATE
C
C  FUCTION: Compares dates to see which is farther in future.
C
C  INPUTS:
C	DATE1  -  First date  (dd-mm-yy)
C	DATE2  -  Second date (If is equal to ' ', then use present date)
C  OUTPUT:
C	Returns the difference in days between the two dates.
C	If the DATE1 is farther in the future, the output is positive,
C	else it is negative.
C
	IMPLICIT INTEGER (A - Z)

	CHARACTER*(*) DATE1,DATE2
	INTEGER USER_TIME(2)

	CALL SYS_BINTIM(DATE1,USER_TIME)
	CALL LIB$DAY(DAY1,USER_TIME)

	IF (DATE2.NE.' ') THEN
	   CALL SYS_BINTIM(DATE2,USER_TIME)
	ELSE
	   CALL SYS$GETTIM(USER_TIME)
	END IF

	CALL LIB$DAY(DAY2,USER_TIME)

	COMPARE_DATE = DAY1 - DAY2

	RETURN
	END




	INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2)
C
C  FUNCTION COMPARE_TIME
C
C  FUCTION: Compares times to see which is farther in future.
C
C  INPUTS:
C	TIME1  -  First time	(hh:mm:ss)
C	TIME2  -  Second time
C  OUTPUT:
C	Outputs (TIME1-TIME2) in seconds.  Thus, if TIME1 is further
C	in the future, outputs positive number, else negative.
C

	IMPLICIT INTEGER (A-Z)
	CHARACTER*(*) TIME1,TIME2
	CHARACTER*23 TODAY_TIME
	CHARACTER*8 TEMP2

	IF (TIME2.EQ.' ') THEN
	   CALL SYS$ASCTIM(,TODAY_TIME,,)
	   TEMP2 = TODAY_TIME(13:20)
	ELSE
	   TEMP2 = TIME2
	END IF

	COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1)))
     &		         +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2)))
     &		        +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4)))
     &		           +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5)))
     &		           +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7)))
     &		              +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8)))

	RETURN
	END

C-------------------------------------------------------------------------
C
C  The following are subroutines to create a linked-list queue for 
C  temporary buffer storage of data that is read from files to be
C  outputted to the terminal.  This is done so as to be able to closet
C  the file as soon as possible.
C.
C  Each record in the queue has the following format.  The first two
C  words are used for creating a character variable.  The first word
C  contains the length of the character variable, the second containsg
C  the address.  The address is simply the address of the 3rd word ofL
C  the record.  The last word in the record contains the address of theL
C  next record.  Every time a record is written, if that record has a 
C  zero link, it adds a new record for the next write operation. '
C  Therefore, there will always be an extra record in the queue.  To
C  check for the end of the queue, the last word (link to next record)
C  is checked to see if it is zero. 
CU
C-------------------------------------------------------------------------
	SUBROUTINE INIT_QUEUE(HEADER,DATA)w
	CHARACTER*(*) DATA 
	IF (HEADER.NE.0) RETURN		! Queue already initialized_
	LENGTH = LEN(DATA)T
	CALL LIB$GET_VM(LENGTH+12,HEADER)
	CALL MAKE_CHAR(%VAL(HEADER),LENGTH)
	RETURNN
	END


	SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA)b
	INTEGER RECORD(1)
	CHARACTER*(*) DATAd
	LENGTH = LEN(DATA).
	CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))r
	NEXT = RECORD((LENGTH+12)/4) 
	IF (NEXT.NE.0) RETURN
	CALL LIB$GET_VM(LENGTH+12,NEXT)
	CALL MAKE_CHAR(%VAL(NEXT),LENGTH)
	RECORD((LENGTH+12)/4) = NEXTb
	RETURNe
	END

	SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA)
	CHARACTER*(*) DATA
	INTEGER RECORD(1)
	LENGTH = LEN(DATA)E
	CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA) 
	NEXT = RECORD((LENGTH+12)/4)D
	RETURN_
	END

	SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR)
	CHARACTER*(*) INCHAR,OUTCHARE
	OUTCHAR = INCHAR(:LENGTH)
	RETURNN
	END

	SUBROUTINE MAKE_CHAR(IARRAY,LEN)A
	DIMENSION IARRAY(1)
	IARRAY(1) = LEN
	IARRAY(2) = %LOC(IARRAY(3))
	IARRAY(LEN/4+3) = 0
	RETURNS
	END



	SUBROUTINE DISABLE_PRIVS,
C_
C  SUBROUTINE DISABLE_PRIVS
CD
C  FUNCTION: Disable SYSPRV privileges.i
Ct

	IMPLICIT INTEGER (A-Z) 

	INCLUDE '($PRVDEF)'

	COMMON /PRIVS/ SETPRV
	DIMENSION SETPRV(2)

	SETPRV(1) = 0
	SETPRV(1) = IBSET(SETPRV(1),PRV$V_SYSPRV)
	SETPRV(1) = IBSET(SETPRV(1),PRV$V_WORLD)l
	SETPRV(1) = IBSET(SETPRV(1),PRV$V_OPER)

	CALL SYS$SETPRV(%VAL(0),SETPRV,,)	! Disable SYSPRV 

	RETURN/
	END



	SUBROUTINE ENABLE_PRIVS
C)
C  SUBROUTINE ENABLE_PRIVS
CF
C  FUNCTION: Enable SYSPRV privileges.
CA

	IMPLICIT INTEGER (A-Z)T

	COMMON /PRIVS/ SETPRV
	DIMENSION SETPRV(2)

	CALL SYS$SETPRV(%VAL(1),SETPRV,,)	! Enable SYSPRV C

	RETURN
	END



	SUBROUTINE CHECK_PRIV_IO(ERROR)
CD
C  SUBROUTINE CHECK_PRIV_IO_
C 
C  FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need
C	privileges to output to.
CR

	IMPLICIT INTEGER (A-Z)C

	CALL DISABLE_PRIVS			! Disable SYSPRV O

	OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW')
	CLOSE (UNIT=6,STATUS='DELETE')G

	OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW')
	IF (IER.NE.0.OR.IER1.NE.0) THEN
	   IF (IER1.EQ.0) WRITE (4,100)
	   IF (IER.EQ.0) WRITE (6,200)C
	   ERROR = 1 
	ELSEL
	   CLOSE (UNIT=4,STATUS='DELETE')
	   ERROR = 0_
	END IF.

	CALL ENABLE_PRIVS			! Enable SYSPRV A

100	FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.')
200	FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')I

	RETURN/
	END


	SUBROUTINE CHANGE_FLAG(CMD,FLAG)A
CR
C  SUBROUTINE CHANGE_FLAG 
CL
C  FUNCTION: Sets flags for specified folder. 
C 
C  INPUTS:
C	CMD    -   LOGICAL*4 value. If TRUE, set flag.  
C		   If FALSE, clear flag.E
C	FLAG	-  If 1, modify NEW_FLAG, if 2, modify SET_FLAG
C		   If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG
C 
	IMPLICIT INTEGER (A - Z)U

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'M

	INCLUDE 'BULLFOLDER.INC'B

	DIMENSION FLAGS(FLONG,4)Y
	EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))c

	LOGICAL CMD

	CHARACTER*23 TODAYD
	DIMENSION READ_BTIM_SAVE(2)

CE
C  Find user entry in BULLUSER.DAT to update information.E
C

	CALL OPEN_FILE_SHARED(4)		! Open user fileD

	READ_BTIM_SAVE(1) = READ_BTIM(1)
	READ_BTIM_SAVE(2) = READ_BTIM(2)e

	DO WHILE (REC_LOCK(IER))		! Read old entryI
	 READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,T
     &	  LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	END DOT

	IF (IER.GT.0) THEN 		! No entry (how did this happen??)
	   CALL SYS$ASCTIM(,TODAY,,) 
	   CALL SYS_BINTIM(TODAY,LOGIN_BTIM):
	   CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM)	! Fake new entry0
	   READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER
     &	     NEWEST_BTIM,BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,E
     &	     NOTIFY_FLAG 
	   IF (CMD) THENI
	      CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)A
	   ELSE
	      CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)_
	   END IF
	   NEW_FLAG(1) = 143L
	   NEW_FLAG(2) = 0=
	   WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,LOGIN_BTIM,
     &	    READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG 
	ELSE
	   IF (CMD) THEN 
	      CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)
	   ELSE
	      CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)R
	   END IF
	   NEW_FLAG(1) = 143T
	   REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,  ! Write modified entryN
     &	     LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,
     &	     NOTIFY_FLAGT
	   READ_BTIM(1) = READ_BTIM_SAVE(1)
	   READ_BTIM(2) = READ_BTIM_SAVE(2)
	END IFT

	CALL CLOSE_FILE (4)
	RETURNi

	END




	SUBROUTINE SET_VERSIONo
Ct
C  SUBROUTINE SET_VERSION	
Cu
C  FUNCTION: Sets version number. 
CE
	IMPLICIT INTEGER (A - Z)B

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'2

	INCLUDE 'BULLFOLDER.INC'T

	DIMENSION FLAGS(FLONG,4)
	EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))R

	LOGICAL CMD

	CHARACTER*23 TODAYD
	DIMENSION READ_BTIM_SAVE(2)

CE
C  Find user entry in BULLUSER.DAT to update information.N
CO

	CALL OPEN_FILE_SHARED(4)		! Open user file 

	READ_BTIM_SAVE(1) = READ_BTIM(1)Z
	READ_BTIM_SAVE(2) = READ_BTIM(2)

	DO WHILE (REC_LOCK(IER))		! Read old entry$
	 READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,0
     &	  LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	END DOR

	IF (IER.EQ.0) THEN
	   NEW_FLAG(1) = 143A
	   REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,  ! Write modified entry
     &	     LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,
     &	     NOTIFY_FLAG 
	   READ_BTIM(1) = READ_BTIM_SAVE(1)
	   READ_BTIM(2) = READ_BTIM_SAVE(2)
	END IFt

	CALL CLOSE_FILE (4)
	RETURNt

	END





	SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW)
Cv
C  SUBROUTINE CONFIRM_PRIV
CZ
C  FUNCTION: Confirms that given username has SETPRV.
C
C  INPUTS:
C	USERNAME  -  UsernameC
C  OUTPUTS:A
C  	ALLOW     -  Returns 1 if account has SETPRV.L
C		     returns 0 if account has no SETPRV.L
CS

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) USERNAME_

	INCLUDE '($PRVDEF)'

	PARAMETER UAF$Q_DEF_PRIV = '1A4'X

	LOGICAL*1 UAF(0:583)P
	EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV)I

	CALL OPEN_FILE_SHARED(8)t
	ALLOW = 0					! Set return falseu
	READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF		! Read Record
	IF (STATUS.EQ.0) THEN				! If username found 
	   IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR.	! SETPRV or CMRKNLt
     &	       BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN	! privileges?
	      ALLOW = 1					! Yep
	   END IF
	END IF2
	CALL CLOSE_FILE(8)T
	RETURN						! Return2
	END						! End 





	SUBROUTINE CHECK_DISMAIL(USERNAME,DISMAIL)E
C:
C  SUBROUTINE CHECK_DISMAILE
C
C  FUNCTION: Checks that given username has DISMAIL.
CH
C  INPUTS:
C	USERNAME  -  Username6
C  OUTPUTS:E
C  	DISMAIL     -  Returns 1 if account has DISMAIL.
C		       returns 0 if account has no DISMAIL.
C 

	IMPLICIT INTEGER (A-Z)C

	CHARACTER*(*) USERNAME 

	PARAMETER UAF$V_DISMAIL = '7'XA
	PARAMETER UAF$L_FLAGS = '1D4'X 

	LOGICAL*1 UAF(0:583)C
	EQUIVALENCE (UAF(UAF$L_FLAGS),UAF_L_FLAGS)-

	CALL OPEN_FILE_SHARED(8)-
	DISMAIL = 0					! Set return false
	READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF		! Read Recordi
	IF (STATUS.EQ.0) THEN				! If username foundd
	   IF (BTEST(UAF_L_FLAGS,UAF$V_DISMAIL)) THEN	! DISMAIL SET?l
	      DISMAIL = 1				! Yepb
	   END IF
	END IFf
	CALL CLOSE_FILE(8)l
	RETURN						! Returni
	END						! Endh



	INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT)

	IMPLICIT INTEGER (A-Z)r

	CHARACTER*(*) INPUT,OUTPUTc

        PARAMETER LNM$_STRING = '2'X

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT))
	CALL END_ITMLST(TRNLNM_ITMLST)	! Get address of itemliste

	SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),,
     &		%VAL(TRNLNM_ITMLST))

	RETURN 
	END



	INTEGER FUNCTION FILE_LOCK(IER,IER1)e

	IMPLICIT INTEGER (A-Z)a

	INCLUDE '($RMSDEF)'

	DATA INIT /.TRUE./t

	IF (INIT) THEN,
	   FILE_LOCK = 1k
	   INIT = .FALSE.
	ELSEc
	   IF (IER.GT.0) THEN
	      CALL ERRSNS(IDUMMY,IER1)-
	      IF (IER1.EQ.RMS$_FLK) THEN-
	         FILE_LOCK = 1 
	      ELSEA
	         FILE_LOCK = 0)
	         INIT = .TRUE. 
	      END IF 
	   ELSE
	      FILE_LOCK = 0
	      IER1 = 0 
	      INIT = .TRUE.
	   END IF
	END IFA

	RETURNE
	END



	SUBROUTINE ENABLE_CTRLO

	IMPLICIT INTEGER (A-Z)X

	COMMON /CTRLY/ CTRLY(

	COMMON /CTRL_LEVEL/ LEVEL

	QUIT = 1A

	ENTRY ENABLE_CTRL_EXITD

	QUIT = QUIT.AND.1		! If called via entry, QUIT = 0 
	LEVEL = LEVEL - 1

	IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN
	   WRITE (6,'('' ERROR: Error in CTRL.'')')
	END IF/

	IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN
	   CALL LIB$ENABLE_CTRL(CTRLY,)	! Enable CTRL-Y & -C
	END IFR

	IF (QUIT.EQ.0) THEN
	   CALL UPDATE_USERINFO
	   CALL EXITR
	END IFA
	QUIT = 0			! Reinitialize

	RETURNR
	END


	SUBROUTINE DISABLE_CTRL

	IMPLICIT INTEGER (A-Z)C

	COMMON /CTRLY/ CTRLYA

	COMMON /CTRL_LEVEL/ LEVEL
	DATA LEVEL /0/

	IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,)
	LEVEL = LEVEL + 1

	RETURNR
	END




	SUBROUTINE CLEANUP_BULLFILE
C
C  SUBROUTINE CLEANUP_BULLFILE
CI
C  FUNCTION:  Searches for empty space in bulletin file and deletes it.S
CR
	IMPLICIT INTEGER (A - Z)I

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'T

	CHARACTER FILENAME*132,INPUT*128=

	CALL OPEN_FILE_SHARED(2))

CT
C  NOTE: Can't use READDIR for reading header since it'll spawn a 
C  BULL/CLEANUP.  (Fooey).
CV

	DO WHILE (REC_LOCK(IER))S
	   READ (2'1,1000,IOSTAT=IER) S
     &		NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY
	END DOM

	FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL'

	IF (NEMPTY.EQ.0) THEN		! No cleanup necessary
	 CALL CLOSE_FILE(2)
	 RETURN
	ELSE IF (NEMPTY.GT.0) THENN

	 IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';2')
				! Rename old file name to version number 2

	 IF (.NOT.IER) RETURN

	 OPEN (UNIT=11,FILE=FILENAME(1:TRIM(FILENAME))//';1',
     1	      STATUS='UNKNOWN',IOSTAT=IER,N
     1	      RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED')
				! Compressed version is number 1

	 CALL OPEN_FILE_SHARED(1)		! Open bulletin file

	 NBLOCK = 0

	 DO I=1,NBULL				! Copy bulletins to new file
	   CALL READDIR(I,IER) 
	   ICOUNT = BLOCK
	   DO J=1,LENGTHP
	      NBLOCK = NBLOCK + 1
	      DO WHILE (REC_LOCK(IER1))
	         READ(1'ICOUNT,IOSTAT=IER1) INPUT
	      END DOb
	      IF (IER1.NE.0) THEN		! This file is corrupt
		 NBLOCK = NBLOCK - 1
		 NBULL = I - 1
	         GO TO 100T
	      END IF 
	      WRITE(11) INPUT
	      ICOUNT = ICOUNT + 1
	   END DO
	 END DO

100	 CALL CLOSE_FILE(1)F
	 CLOSE (UNIT=11)

	 NEMPTY = -1		! Copying done, but not directory updating.
	 DO WHILE (REC_LOCK(IER))
	    WRITE (2'1,1000,IOSTAT=IER)	! Write new directory header'
     &		NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY
	 END DO
	END IFG

	IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';2')
				! Can safely delete old file, since NEMPTY = -1e

	FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLDIR'

	OPEN (UNIT=12,FILE=FILENAME(1:TRIM(FILENAME)),_
     1	      STATUS='NEW',IOSTAT=IER,DISPOSE='DELETE',
     1	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',I
     1	      ORGANIZATION='RELATIVE',FORM='FORMATTED')

	WRITE (12'1,1000,IOSTAT=IER)	! Write directory header
     &		NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY

	NBLOCK = 0		! Update directory entry pointers
	DO I=1,NBULLE
	   CALL READDIR(I,IER)E
	   BLOCK = NBLOCK + 1
	   WRITE (12'I+1,1010,IOSTAT=IER)
     &	     DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK
	   NBLOCK = NBLOCK + LENGTH
	END DO1

	DO WHILE (REC_LOCK(IER))L
	   READ (2'1,1000,IOSTAT=IER)	! Read directory header
     &		NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY
	END DOW

	NEMPTY = 0B
	WRITE (12'1,1000,IOSTAT=IER)	! Write directory header
     &		NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY

	CLOSE (UNIT=12,STATUS='KEEP')
	CALL CLOSE_FILE(2)A

	IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';-1')M
					! Delete old directory file

	IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';')
			! Rename old file name to minimize version number

1000	FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4) 
1010	FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4)

	RETURNT
	END




	SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)B
C
C  SUBROUTINE CLEANUP_DIRFILEU
C'
C  FUNCTION:  Reorder directory file after deletions.I
C	      Is called either directly after a deletion, or is
C	      called if it is detected that a deletion was not fully
C	      completed due to the fact that the deleting processr
C	      was abnormally terminated.
C4
	IMPLICIT INTEGER (A - Z)A

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLDIR.INC'

	NBULL = -NBULL		! Negative # Bulls signals deletion in progress
	MOVE_TO = 0		! Moving directory entries starting here
	MOVE_FROM = 0		! Moving directory entries from here
	I = DELETE_ENTRY	! Start search point for first deleted entries
	DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)T
	   CALL READDIR(I,IER)m
	   IF (IER.NE.I+1) THEN	! Have we found a deleted entry?E
	      MOVE_TO = I	! If so, start moving entries to here
	      J=I+1		! Search for next entry in fileA
	      DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)
		 CALL READDIR(J,IER)
		 IF (IER.EQ.J+1) MOVE_FROM = J
		 J = J + 1
	      END DO 
	      IF (MOVE_FROM.EQ.0) THEN	! There are no more entriesa
		 NBULL = I - 1		! so just update number of bulletins
		 CALL WRITEDIR(0,IER) 
		 RETURN1
	      END IF 
	      LENGTH = -LENGTH		! Indicate starting point by writingI
	      CALL WRITEDIR(I,IER)	! next entry into deleted entryE
	      FIRST_DELETE = I		! with negative lengthX
	      MOVE_FROM = MOVE_FROM + 1	! Set up pointers to move rest of
	      MOVE_TO = MOVE_TO + 1	! the entries
	   ELSE IF (LENGTH.LT.0) THEN	! If negative length found, deletionU
	      FIRST_DELETE = I		! was previously in progressn
	      J = I			! Try to find where entry came from
	      DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)_
		 BLOCK_SAVE = BLOCK 
		 K = J + 1		! Search for duplicate entries
		 DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL)
		    CALL READDIR(K,IER)D
		    IF (IER.EQ.K+1) THEN
		       IF (BLOCK_SAVE.EQ.BLOCK) THEN
			  MOVE_TO=J+1
			  MOVE_FROM=K+1
		       ELSEC
			  K = K + 1
		       END IFM
		    END IF
		 END DOS
		 J = J + 1		! If no duplicate entry found for this
		 CALL READDIR(J,IER)	! entry, see if one exists for anya
	      END DO			! of the other entries
	   END IF
	   I = I + 1R
	END DON

	IF (I.LE.NBULL) THEN		! Move reset of entries if necessaryS
	   IF (MOVE_FROM.GT.0) THEN
	      DO J=MOVE_FROM,NBULL$
	         CALL READDIR(J,IER) 
		 IF (IER.EQ.J+1) THEN	! Skip any other deleted entries
		    CALL WRITEDIR(MOVE_TO,IER)
		    MOVE_TO = MOVE_TO + 1 
		 END IF0
	      END DOu
	   END IF
	   DO J=MOVE_TO,NBULL		! Delete empty records at end of fileT
	      DELETE(UNIT=2,REC=J+1,IOSTAT=IER)
	   END DO
	   NBULL = MOVE_TO - 1		! Update # bulletin count
	   CALL READDIR(FIRST_DELETE,IER)
	   LENGTH = -LENGTH		! Fix entry which has negative lengthA
	   CALL WRITEDIR(FIRST_DELETE,IER)A
	END IFN

	CALL WRITEDIR(0,IER) 

	RETURN	
	END


	SUBROUTINE SHOW_FLAGS
CT
C  SUBROUTINE SHOW_FLAGS
C%
C  FUNCTION: Show user flags.T
CN
	IMPLICIT INTEGER (A - Z)i

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'I

	INCLUDE 'BULLFOLDER.INC'	

CT
C  Find user entry in BULLUSER.DAT to obtain flags.T
C 

	CALL OPEN_FILE_SHARED(4)		! Open user filea

	DO WHILE (REC_LOCK(IER))		! Read old entryt
	 READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,.
     &	  LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	END DOR

	WRITE (6,'('' For the selected folder '',A)') FOLDER(1:TRIM(FOLDER))I
	L
	IF (TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEND
	   WRITE (6,'('' NOTIFY is set.'')') 
	END IF 

	IF (TEST2(SET_FLAG,FOLDER_NUMBER).AND.D
     &	   (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER))) THEN
	   WRITE (6,'('' READNEW is set.'')')
	ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.
     &	       TEST2(SET_FLAG,FOLDER_NUMBER)) THENT
	   WRITE (6,'('' BRIEF is set.'')')
	ELSE IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.
     &	       .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN
	   WRITE (6,'('' SHOWNEW is set.'')')
	ELSE IF (.NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN 
	   WRITE (6,'('' No flags are set.'')')
	END IF 

	CALL CLOSE_FILE(4) 

	RETURNR
	END


	SUBROUTINE SET2(FLAG,NUMBER)

	IMPLICIT INTEGER (A-Z)T

	INTEGER FLAG(2)

	F_POINT = NUMBER/32 + 1
	FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))E

	RETURN
	END


	SUBROUTINE CLR2(FLAG,NUMBER)R

	IMPLICIT INTEGER (A-Z)

	INTEGER FLAG(2)

	F_POINT = NUMBER/32 + 1
	FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))e

	RETURNe
	END



	LOGICAL FUNCTION TEST2(FLAG,NUMBER)

	IMPLICIT INTEGER (A-Z)

	INTEGER FLAG(2)

	F_POINT = NUMBER/32 + 1
	TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))N

	RETURNU
	END




	INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)e
CA
C  FUNCTION GETUSERS
Ci
C  FUNCTION:
C	To get names of all users that are logged in. 
CC

	IMPLICIT INTEGER (A-Z),

	INCLUDE '($JPIDEF)'

	CHARACTER*(*) USERNAME,TERMINAL

	DATA WILDCARD /-1/ 

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list
	CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))
	CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlistE

	IER = 1
	TERMINAL(1:1) = CHAR(0)
	DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0))
						! Get next interactive process
	   IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,)1
						! Get next process.K
	END DOT

	IF (.NOT.IER) WILDCARD = -1

	GETUSERS = IERE

	RETURN1
	END





	SUBROUTINE OPEN_USERINFOd
Cr
C  SUBROUTINE OPEN_USERINFOE
CI
C  FUNCTION:  Opens the file in SYS$LOGIN which contains user information.
Cb
	IMPLICIT INTEGER (A - Z)A

	INCLUDE 'BULLUSER.INC'U

	INTEGER NEW_BTIM(2)

	COMMON /USERINFO/ READ_IN
	DATA READ_IN /.FALSE./C

	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)I
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)h

	IF (.NOT.SETPRV_PRIV()) THEN		! If no SETPRV, remove SYSPRV
	   CALL DISABLE_PRIVS			! privileges when trying to
	END IF					! create new file.

	OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',U
     &	      RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2,SHARED,t
     &	      FORM='UNFORMATTED',IOSTAT=IER)(

	IF (IER.NE.0) THENW
	   CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM)E
	   IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	      OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',N
     &	         RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER)/
	      INQUIRE (UNIT=9,RECORDSIZE=RECL,IOSTAT=IER)
	      RECL = RECL/8
	      IF (IER.EQ.0) THEN_
	         READ (9,IOSTAT=IER) ((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)
	      END IFS
	      IF (IER.EQ.0) THENO
	         DO I=RECL+1,FOLDER_MAX
	            LAST_READ_BTIM(1,I) = NEW_BTIM(1)
	            LAST_READ_BTIM(2,I) = NEW_BTIM(2)
	         END DO
	         CLOSE (UNIT=9,STATUS='DELETE')
	         OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='NEW',
     &	            RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2,
     &	            FORM='UNFORMATTED',IOSTAT=IER)D
	      END IF 
	   END IF
	   IF (IER.NE.0) THEN
	      OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='NEW',I
     &	         RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2,K
     &	         FORM='UNFORMATTED',IOSTAT=IER)
	      CALL ENABLE_PRIVS			! Reset SYSPRV privileges
	      CALL OPEN_FILE_SHARED(4)		! Get BULLUSER.DAT file
	      DO WHILE (REC_LOCK(IER1))
	   	 READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER1) USERNAME,
     &  	  LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,d
     &		  NOTIFY_FLAG			! Find user's info
	      END DOT
	      CALL CLOSE_FILE(4)S
	      DO I=1,FOLDER_MAX
	         LAST_READ_BTIM(1,I) = READ_BTIM(1)
	         LAST_READ_BTIM(2,I) = READ_BTIM(2)
	      END DO(
	   END IF
	   IF (IER.EQ.0) THEN
	      WRITE (9) LAST_READ_BTIM=
	   ELSE
	      CALL ERRSNS(IDUMMY,IER)
	      WRITE (6,'(
     &		 '' ERROR: SYS$LOGIN:BULLETIN.INF cannot be opened.'')')
	      CALL SYS_GETMSG(IER),
	   END IF
	ELSE5
	   READ (9) LAST_READ_BTIM
	END IFR

	CLOSE (UNIT=9)S

	READ_IN = .TRUE.F

	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionN

	CALL ENABLE_PRIVS			! Reset SYSPRV privileges

	RETURNc
	END



	SUBROUTINE UPDATE_USERINFOr
C
C  SUBROUTINE UPDATE_USERINFOt
Ct
C  FUNCTION:  Updates the latest message read times for each folder.
Cd
	IMPLICIT INTEGER (A - Z)a

	INCLUDE 'BULLUSER.INC'4

	COMMON /USERINFO/ READ_IN

	IF (.NOT.READ_IN) RETURN

	OPEN (UNIT=9,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD', 
     &	      RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2,SHARED,t
     &	      FORM='UNFORMATTED',IOSTAT=IER)d

	IF (IER.EQ.0) THENe
	   WRITE (9) LAST_READ_BTIM
	   CLOSE (UNIT=9)
	ELSEt
	   CALL ERRSNS(IDUMMY,IER)O
	   WRITE (6,'(U
     &		 '' ERROR: SYS$LOGIN:BULLETIN.INF cannot be opened.'')')
	   CALL SYS_GETMSG(IER)
	END IFV

	RETURNI
	END


	INTEGER FUNCTION SYS_BINTIM(TIME,BTIM) 

	IMPLICIT INTEGER (A-Z)l

	INTEGER BTIM(2)

	CHARACTER*(*) TIMEE

	IF (TRIM(TIME).EQ.20) THEN)
	   SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM)1
	ELSE 
	   SYS_BINTIM = SYS$BINTIM(TIME,BTIM)
	END IF 

	RETURN 
	END




	SUBROUTINE NEW_MESSAGE_NOTIFICATION
Cb
C  SUBROUTINE NEW_MESSAGE_NOTIFICATION
CR
C  FUNCTION:
C 
C  Update user's last read bulletin date.  If new bulletins have been 
C  added since the last time bulletins have been read, position bulletin
C  pointer so that next bulletin read is the first new bulletin, and
C  alert user.  If READNEW set and no new bulletins, just exit.e
Ci

	IMPLICIT INTEGER (A-Z)0

	INCLUDE 'BULLFOLDER.INC'o

	INCLUDE 'BULLUSER.INC'T

	COMMON /READIT/ READITl

	COMMON /POINT/ BULL_POINT

	CALL UPDATE_READ			! Update login time 

	IF (CLI$PRESENT('SELECT_FOLDER')) THEN
	   CALL SELECT_FOLDER(.TRUE.,IER)
	   IF (IER) RETURNa
	END IFs

	CALL OPEN_FILE_SHARED(7)		! Go find folders

	DO FOLDER_NUMBER = 0,FOLDER_MAX
	   CALL CLR2(NEW_MSG,FOLDER_NUMBER)	! Clear new message flag 
	   IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND.=
     &	      TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.
     &	      .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN	
	      CALL CHANGE_FLAG(0,3)
	      CALL SET_VERSIONa
	   ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR.
     &	       TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENE
	      DO WHILE (REC_LOCK(IER))e
	       READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,O
     &						KEYID=1,IOSTAT=IER)A
     &		FOLDER,FOLDER_NUMBER_DUMMY,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
     &		,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMITM
	      END DO 
	      DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),J
     &					F_NEWEST_BTIM)
	      IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN  ! If new unread messagesR
		 CALL SET2(NEW_MSG,FOLDER_NUMBER)   ! Set new message flag
	      END IF
	   END IF
	END DOS

	CALL CLOSE_FILE(7)N

	IF (READIT.EQ.0) THEN 			! If not in READNEW mode
	   DO FOLDER_NUMBER = 1,FOLDER_MAX 
	      IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN
		 CALL SELECT_FOLDER(.FALSE.,IER)
		 IF (IER) THEN
		    DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &					F_NEWEST_BTIM) 
		    IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN
		      WRITE (6,'('' There are new messages in folder '',
     &			A,''.'')') FOLDER(1:TRIM(FOLDER))
		      CALL SET2(NEW_MSG,FOLDER_NUMBER)
		    ELSE
		      CALL CLR2(NEW_MSG,FOLDER_NUMBER)
		    END IF
		 ELSE				! Can't select the folder
		    CALL CHANGE_FLAG(0,2)	! then clear SET_FLAG
		    CALL CLR2(NEW_MSG,FOLDER_NUMBER)
		 END IF 
	      END IF 
	   END DO
	   FOLDER_NUMBER = 0I
	   CALL SELECT_FOLDER(.FALSE.,IER)D
	   DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &				F_NEWEST_BTIM)
	   IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN
	      CALL FIND_NEWEST_BULL	! See if there are new messages
	      IF (BULL_POINT.NE.-1) THENs
	        WRITE(6,'('' Type READ to read new general messages.'')')
		NEW_COUNT = F_NBULL - BULL_POINT
		DIG = 0 
		DO WHILE (NEW_COUNT.GT.0)t
		   NEW_COUNT = NEW_COUNT / 10F
		   DIG = DIG + 1
		END DO
		WRITE(6,'('' There are '',I<DIG>,'' new messages.'')')
     &			F_NBULL - BULL_POINT	! Alert user if new bulletins,
	      ELSEI
	        BULL_POINT = 0
	        LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)I
	        LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)
		CALL CLR2(NEW_MSG,FOLDER_NUMBER)
	      END IFE
	   END IF
	ELSE				! READNEW mode.
	   DO FOLDER_NUMBER = 0,FOLDER_MAXI
	      IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THENR
		 CALL SELECT_FOLDER(.FALSE.,IER)
		 IF (IER) THEN
		   DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),T
     &					F_NEWEST_BTIM)B
		   IF (DIFF.LT.0) THEN
		    IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDERG
	            IF (BULL_POINT.NE.-1) THEN
		     IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.g
     &			 TEST2(SET_FLAG,FOLDER_NUMBER)) THEN
		      IF (FOLDER_NUMBER.GT.0) THEN
		       WRITE (6,'('' There are new messages in folder '',D
     &			A,''.'')') FOLDER(1:TRIM(FOLDER))
		      END IF
		     ELSE IF (FOLDER_NUMBER.EQ.0.OR.
     &			.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THENL
		       SAVE_BULL_POINT = BULL_POINTN
		       REDO = .TRUE.
		       DO WHILE (REDO)
		          REDO = .FALSE.
		          CALL READNEW(REDO)
			  IF (REDO) CALL REDISPLAY_DIRECTORYE
			  BULL_POINT = SAVE_BULL_POINTc
		       END DO 
		     END IFI
		    END IF
		   ELSEI
		    CALL CLR2(NEW_MSG,FOLDER_NUMBER)
		   END IF
		 ELSE				! Can't select the folder
		    CALL CHANGE_FLAG(0,2)	! then clear SET_FLAG 
		    CALL CLR2(NEW_MSG,FOLDER_NUMBER)
		 END IFI
	      END IF 
	   END DO
	   CALL EXIT 
	END IFt

	RETURNn
	END

