C
C  BULLETIN1.FOR, Version 1/23/95
C  Purpose: Contains subroutines for the BULLETIN utility program.
C  Environment: VAX/VMS
C  Programmer: Mark R. London
C
C  Copyright (c) 1990
C  Property of Massachusetts Institute of Technology, Cambridge MA 02139.
C  This program cannot be copied or distributed in any form for non-MIT
C  use without specific written approval of MIT Plasma Fusion Center
C  Management.
C
	SUBROUTINE MAIL
C
C  SUBROUTINE MAIL
C
C  FUNCTION: Sends message which you have read to user via DEC mail.
C
	IMPLICIT INTEGER (A - Z)

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE
	CHARACTER*256 FROM_LINE,SUBJECT_LINE
	CHARACTER*12 MSGNUM

	INCLUDE 'BULLDIR.INC'

	EXTERNAL CLI$_ABSENT

	IF (BTEST(CAPTIVE(-1),1)) THEN
	   WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')')
	   RETURN
	END IF

	IF (BULL_POINT.EQ.0) THEN	! If no bulletin has been read
	   WRITE(6,'('' ERROR: You have not read any message.'')')
	   RETURN			! And return
	END IF

	CALL OPEN_BULLDIR_SHARED

	CALL READDIR(BULL_POINT,IER)	! Get info for specified bulletin

	IF (IER.NE.BULL_POINT+1) THEN	! Was bulletin found?
	   WRITE(6,'('' ERROR: Specified message was not found.'')')
	   CALL CLOSE_BULLDIR		! If not, then error out
	   RETURN
	END IF

	CALL CLOSE_BULLDIR

	IF (CLI$PRESENT('EDIT')) THEN
	   CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
	END IF

	OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
     &	   RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')

	IF (IER.NE.0) THEN
	   WRITE(6,'('' ERROR: Error in opening scratch file.'')')
	   RETURN
	END IF

	IF (CLI$PRESENT('HEADER')) THEN		! Printout header?
	   IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN
	      IF (REMOTE_SET.NE.3) THEN
		 INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)
     &				//'   (DELETED)'
	      ELSE
		 INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)
	      END IF
	   ELSE IF ((SYSTEM.AND.4).EQ.4) THEN	! Is entry shutdown bulletin?
	      INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)
     &				//'   Expires on shutdown'
	   ELSE IF ((SYSTEM.AND.2).EQ.2) THEN	! Is entry permanent bulletin?
	      INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)
     &				//'   Permanent'
	   ELSE
	      INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)//
     &				'   Expires:   '//EXDATE//' '//EXTIME(:5)
	   END IF
	   IF ((SYSTEM.AND.1).EQ.1) THEN		! System bulletin?
	      INPUT = INPUT(:TRIM(INPUT))//' / System'
	   END IF
	   WRITE (3,'(A)') INPUT(:TRIM(INPUT))
	END IF

	HEAD = CLI$PRESENT('HEADER')

	CALL OPEN_BULLFIL_SHARED	! Open BULLETIN file

	ILEN = LINE_LENGTH + 1

	CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
	   IF (HEAD) WRITE(3,1060) INPUT(7:ILEN)
	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	ELSE IF (HEAD) THEN
	   WRITE(3,1060) FROM
	END IF

	IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
	   IF (HEAD) WRITE(3,1050) INPUT(7:ILEN)
	   SUBJECT_LINE = INPUT(7:ILEN)
	ELSE
	   IF (HEAD) WRITE(3,1050) DESCRIP
	   IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
	   SUBJECT_LINE = DESCRIP
	END IF

	IF (CLI$PRESENT('SUBJECT')) THEN
	   IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D)
	END IF

	DO WHILE (ILEN.GT.0)		! Copy bulletin into file
	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	   IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
	END DO

	CLOSE (UNIT=3)			! Message copy completed

	CALL CLOSE_BULLFIL

	LEN_D = TRIM(SUBJECT_LINE)
	IF (LEN_D.EQ.0) THEN
	   SUBJECT_LINE = 'BULLETIN message.'
	   LEN_D = TRIM(SUBJECT_LINE)
	END IF

	I = 1
	DO WHILE (I.LE.LEN_D)
	   IF (SUBJECT_LINE(I:I).EQ.'"') THEN
	      IF (LEN_D.EQ.64) THEN
		 SUBJECT_LINE(I:I) = '`'
	      ELSE
		 SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:)
		 I = I + 1
		 LEN_D = LEN_D + 1
	      END IF
	   END IF
	   I = I + 1
	END DO

	LEN_P = 0
	DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I)
     &	    .NE.%LOC(CLI$_ABSENT))		! Get all the usernames
	   LEN_P = LEN_P + I + 1
	   BULL_PARAMETER(LEN_P:LEN_P) = ','
	END DO
	LEN_P = LEN_P - 1

	I = 1		! Must change all " to """ in MAIL recipients
	DO WHILE (I.LE.LEN_P)
	   IF (BULL_PARAMETER(I:I).EQ.'"') THEN
	      BULL_PARAMETER = BULL_PARAMETER(:I)//'""'//
     &					BULL_PARAMETER(I+1:)
	      I = I + 2
	      LEN_P = LEN_P + 2
	   END IF
	   I = I + 1
	END DO

	IF (CLI$PRESENT('EDIT')) THEN
	   CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
	   CONTEXT = 0
	   IER =  LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT)
	   VERSION = INDEX(INPUT,';') + 1
	   IF (INPUT(VERSION:VERSION).EQ.'1') THEN
	      CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
	      WRITE (6,'('' ERROR: No message mailed.'')')
	      RETURN
	   END IF
	END IF

	CALL DISABLE_PRIVS
	CALL SENDMAIL('SYS$LOGIN:BULL.SCR',BULL_PARAMETER(:LEN_P)
     &			,SUBJECT_LINE,STATUS)
C       CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P)
C     &    //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS)
C	IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS)

	CALL ENABLE_PRIVS
	CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')

	RETURN

1050	FORMAT('Description: ',A,/)
1060	FORMAT('From: ',A)

	END



	SUBROUTINE MODIFY_FOLDER
C
C  SUBROUTINE MODIFY_FOLDER
C
C  FUNCTION: Modifies a folder's information.
C
	IMPLICIT INTEGER (A - Z)

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($SSDEF)'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER PASSWORD*32

	IF (.NOT.FOLDER_ACCESS
     &		 (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
	   WRITE (6,'('' ERROR: No privileges to modify folder.'')')
	   RETURN
	END IF

	IF (CLI$PRESENT('NAME')) THEN
	   IF (REMOTE_SET) THEN
	      WRITE (6,'('' ERROR: Cannot change name of'',
     &				'' remote folder.'')')
	      RETURN
	   ELSE
	      CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P)
	      IF (LEN_P.GT.44) THEN
		 WRITE (6,'('' ERROR: Folder name cannot be larger
     &				than 44 characters.'')')
		 RETURN
	      END IF
	   END IF
	ELSE
	   FOLDER1 = FOLDER
	END IF

	IF (CLI$PRESENT('DESCRIPTION')) THEN
	   WRITE (6,'('' Enter one line description of folder.'')')
	   LENF = 81
	   DO WHILE (LENF.GT.80)
	      CALL GET_LINE(FOLDER1_DESCRIP,LENF)	! Get input line
	      IF (LENF.LE.0) THEN
		 WRITE (6,'('' ERROR: Folder modification aborted.'')')
		 RETURN
	      ELSE IF (LENF.GT.80) THEN			! If too many characters
		 WRITE (6,'('' ERROR: Description must be < 80 characters.'')')
	      ELSE
		 FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces
	      END IF
	   END DO
	ELSE
	   FOLDER1_DESCRIP = FOLDER_DESCRIP
	END IF

	IF (CLI$PRESENT('OWNER')) THEN
	   CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P)
	   IF (LEN_P.GT.12) THEN
	      WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')')
	      RETURN
	   ELSE IF (CLI$PRESENT('ID')) THEN
	      IER = CHKPRO(FOLDER1_OWNER)
	   ELSE
	      CALL GET_UAF
     &		   (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)
	   END IF
	   IF (.NOT.IER) THEN
	      WRITE (6,'('' ERROR: Owner name is not valid username.'')')
	      RETURN
	   ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN
	      WRITE (6,'('' ERROR: Folder owner name too long.'')')
	      RETURN
	   ELSE IF (.NOT.SETPRV_PRIV()) THEN
	      WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10)
	      CALL GET_INPUT_NOECHO(PASSWORD)
	      IF (TRIM(PASSWORD).EQ.0) THEN
		 WRITE (6,'('' ERROR: No password entered.'')')
		 RETURN
	      END IF
	      WRITE (6,'('' Attempting to verify password name...'')')
	      OPEN (UNIT=10,NAME='SYS$NODE"'//
     &		   FOLDER1_OWNER(:TRIM(FOLDER1_OWNER))
     &		   //' '//PASSWORD(:TRIM(PASSWORD))//'"::',
     &		   TYPE='SCRATCH',IOSTAT=IER)
	      CLOSE (UNIT=10)
	      IF (IER.NE.0) THEN
		 WRITE (6,'('' ERROR: Password is invalid.'')')
		 RETURN
	      ELSE
		 WRITE (6,'('' Password was verified.'')')
	      END IF
	   ELSE
	      FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P)
	   END IF
	ELSE
	   FOLDER1_OWNER = FOLDER_OWNER
	END IF

	CALL OPEN_BULLFOLDER		! Open folder file

	IF (CLI$PRESENT('NAME')) THEN
	   READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0)
	   				! See if folder exists
	   IF (IER.EQ.0) THEN
	      WRITE (6,'('' ERROR: Folder name already exists.'')')
	      CALL CLOSE_BULLFOLDER
	      RETURN
	   END IF
	END IF

	CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)

	IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN
	   LEN_F = TRIM(FOLDER_DIRECTORY)
	   IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)//
     &		FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)//
     &		FOLDER1(:TRIM(FOLDER1))//'.*')
	   IF (.NOT.IER) THEN
	      I = 0
	      IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)//
     &		FOLDER(:TRIM(FOLDER))//'.*',INPUT,I)
	   END IF
	   IF (IER.OR..NOT.IER1) THEN
	      FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1
	      FOLDER_NAME = FOLDER1
	      IER = 0
	   END IF
	END IF

	IF (IER.EQ.0) THEN
	   IF (CLI$PRESENT('OWNER')) THEN
	      CALL CHKACL
     &		(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)
	      IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
		 CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)
		 CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER)
	      END IF
	   END IF
	   FOLDER = FOLDER1
	   FOLDER_OWNER = FOLDER1_OWNER
	   FOLDER_DESCRIP = FOLDER1_DESCRIP
	   DELETE (7)
	   IF (CLI$PRESENT('ID')) THEN
	      FOLDER_FLAG = IBSET(FOLDER_FLAG,6)
	   ELSE
	      FOLDER_FLAG = IBCLR(FOLDER_FLAG,6)
	   END IF
	   CALL WRITE_FOLDER_FILE(IER)
	   IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')')
	END IF

	IF (IER.NE.0) THEN
	   WRITE (6,'('' ERROR: Folder modification aborted.'')')
	END IF

	CALL CLOSE_BULLFOLDER

	RETURN
	END



	FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) USERNAME,FOLDER_OWNER

	IF (SETPRV_PRIV()) THEN
	   FOLDER_ACCESS = .TRUE.
	ELSE IF (BTEST(FOLDER_FLAG,6)) THEN	! If folder owner is ID
	   FOLDER_ACCESS = CHKPRO(FOLDER_OWNER)
	ELSE
	   FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER
	END IF

	RETURN
	END



	SUBROUTINE MOVE(DELETE_ORIGINAL)
C
C  SUBROUTINE MOVE
C
C  FUNCTION: Moves message from one folder to another.
C
	IMPLICIT INTEGER (A - Z)

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /ACCESS/ READ_ONLY
	LOGICAL READ_ONLY

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1
	DATA SCRATCH_R1 /0/

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	COMMON /HEADER/ HEADER

	COMMON /NEXT/ NEXT

	COMMON /NEWGROUP/ NEWGROUP

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLFILES.INC'

	EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS

	LOGICAL DELETE_ORIGINAL

	CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24

	DATA TEMP_FILE/.FALSE./

	DIMENSION BTIM(2)

	ORIGINAL = CLI$PRESENT('ORIGINAL')

	IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN
	   WRITE (6,'('' ERROR: You have no privileges to keep''
     &			,'' original owner.'')')
	   RETURN
	END IF

	ALL = CLI$PRESENT('ALL')

	MERGE = CLI$PRESENT('MERGE')

	SAVE_BULL_POINT = BULL_POINT

	IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
	IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN
	   IF (BULL_POINT.EQ.0) THEN	! If no message has been read
	      WRITE(6,'('' ERROR: You are not reading any message.'')')
	      RETURN			! and return
	   END IF

	   CALL OPEN_BULLDIR_SHARED
	   CALL READDIR(BULL_POINT,IER)		! Get message directory entry
	   IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN
	      WRITE(6,'('' ERROR: Specified message was not found.'')')
	      CALL CLOSE_BULLDIR
	      BULL_POINT = SAVE_BULL_POINT
	      RETURN
	   END IF

	   NUM_COPY = 1
	ELSE
	   CALL OPEN_BULLDIR_SHARED
	   CALL READDIR(0,IER)		! Get message directory entry
	   IF (NBULL.EQ.0) THEN		! Were messages found?
	      WRITE(6,'('' ERROR: No messages were found.'')')
	      CALL CLOSE_BULLDIR
	      RETURN
	   END IF

	   IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN
	      CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1)
	      IF (EBULL.GT.F_NBULL) EBULL = F_NBULL
	      IF (SBULL.LE.0.OR.IER1.NE.0) THEN
		 WRITE (6,'(A)')
     &		  ' ERROR: Specified message number has incorrect format.'
		 CALL CLOSE_BULLDIR
		 RETURN
	      ELSE
		 NUM_COPY = EBULL - SBULL + 1
		 BULL_POINT = SBULL
	      END IF
	      IF (NUM_COPY.GT.1) ALL = .TRUE.
	      IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN
	         NEWGROUP = .TRUE.	! Kludgey way of detecting new2bull
	         NEXT = .TRUE.		! If SBULL does not exist, will find
              ELSE			! next message after SBULL
	         SBULL1 = SBULL
	   	 CALL READDIR(SBULL,IER)
	   	 IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN
		    WRITE(6,'('' ERROR: Specified message was not found.'')')
	      	    CALL CLOSE_BULLDIR
	      	    RETURN
	         END IF
	      END IF
	   ELSE IF (ALL) THEN
	      NUM_COPY = NBULL
	      BULL_POINT = 1
	      NEWGROUP = .TRUE.
	      NEXT = .TRUE.
	   END IF
	END IF

	FROM_REMOTE = REMOTE_SET
	CALL CLI$GET_VALUE('FOLDER',FOLDER1)
	IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1)
	TO_NEWS = TEST_NEWS(FOLDER1)

	IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN
	   IF (.NOT.TEMP_FILE) THEN
	      OPEN (UNIT=12,FILE='REMOTE.BULLDIR',
     &		 STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER)
	      IF (IER.EQ.0) THEN
		 OPEN (UNIT=11,FILE='REMOTE.BULLFIL',
     &		    STATUS='SCRATCH',IOSTAT=IER,
     &		    ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &		    FORM='UNFORMATTED')
	      END IF
	   ELSE
	      REWIND (12,IOSTAT=IER)
	   END IF
	   IF (IER.EQ.0) THEN
	      TEMP_FILE = .TRUE.
	      CALL OPEN_BULLFIL
	      CALL READDIR(0,IER)
	      I = BULL_POINT - 1
	      IER = I + 1
	      NBLOCK = 1
	      LAST = BULL_POINT+NUM_COPY-1
	      NUM_COPY = 0
	      DO WHILE (I.LT.LAST.AND.IER.EQ.I+1)
		 I = I + 1
		 CALL READDIR(I,IER)
		 IF (IER.EQ.I+1.AND.I.LE.LAST) THEN
		    CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
		    IF (REMOTE_SET) THEN
		       CALL REMOTE_READ_MESSAGE(I,IER1)
		       IF (IER1.GT.0) THEN
			  CALL DISCONNECT_REMOTE
		       ELSE
			  CALL GET_REMOTE_MESSAGE(IER1)
		       END IF
		    ELSE
		       IER1 = 0
		    END IF
		    IF (LENGTH.EQ.0) IER = 1	! Don't allow empty messages
		    IF (IER1.EQ.0) THEN
		       SCRATCH_R = SCRATCH_R1
		       DO J=1,LENGTH
			  IF (REMOTE_SET) THEN
			     CALL READ_QUEUE(%VAL(SCRATCH_R),
     &					SCRATCH_R,INPUT(:128))
			  ELSE
			     READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128)
			  END IF
			  WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128)
		       END DO
		    END IF
		    IF (IER1.EQ.0) THEN
		       BLOCK = NBLOCK
		       NBLOCK = NBLOCK + LENGTH
		       WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY
		    END IF
		    IF (TO_NEWS.AND.ORIGINAL) THEN
		       WRITE (12,IOSTAT=IER1) NEWS_MSGID
		    END IF
		    IF (IER1.NE.0) THEN
		       I = IER
		    ELSE
		       NUM_COPY = NUM_COPY + 1
		    END IF
		 END IF
	      END DO
	      CALL CLOSE_BULLFIL
	   END IF
	   IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN
	      WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')')
	      CLOSE (UNIT=12)
	      CLOSE (UNIT=11)
	      TEMP_FILE = .FALSE.
	      CALL CLOSE_BULLDIR
	      RETURN
	   END IF
	END IF

	CALL CLOSE_BULLDIR

	SAVE_FOLDER = FOLDER
	SAVE_FOLDER_NUMBER = FOLDER_NUMBER

	FOLDER_NUMBER = -1	! Use FOLDER as key rather than FOLDER_NUMBER
	CALL SELECT_FOLDER(.FALSE.,IER)

	IER1 = .TRUE.

	POST_NEWS = (.NOT.ORIGINAL.AND.REMOTE_SET.EQ.4).OR.REMOTE_SET.EQ.3

	IF (.NOT.IER) THEN
	   WRITE (6,'('' ERROR: Cannot access specified folder.'')')
	ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN
	   IF (READ_ONLY) THEN
	      WRITE (6,'('' ERROR: No access to write into folder.'')')
	   ELSE
	      WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')')
	   END IF
	   IER1 = .FALSE.
	ELSE IF (REMOTE_SET.EQ.0.AND.NEWS_FEED()) THEN
	   IF (.NOT.ORIGINAL) THEN
	      SLIST = INDEX(FOLDER_DESCRIP,'<')
	      FOLDER1_DESCRIP =
     &			FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)
	      IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN
		 WRITE(6,'('' ERROR: Multiple newsgroup feed'',
     &			'' is present.'')')
		 IER1 = .FALSE.
	      ELSE
		 REMOTE_SET = 3
	      END IF
	   END IF
	END IF

	IF (.NOT.IER.OR..NOT.IER1) THEN
	   FOLDER_NUMBER = SAVE_FOLDER_NUMBER
	   IF (.NOT.IER) THEN
	      FOLDER = SAVE_FOLDER
	      BULL_POINT = SAVE_BULL_POINT
	   ELSE
	      FOLDER_NUMBER = SAVE_FOLDER_NUMBER
	      FOLDER1 = SAVE_FOLDER
	      CALL SELECT_FOLDER(.FALSE.,IER1)
	   END IF
	   BULL_POINT = SAVE_BULL_POINT
	   CLOSE (UNIT=12)
	   CLOSE (UNIT=11)
	   TEMP_FILE = .FALSE.
	   RETURN
	END IF
C
C  Add bulletin to bulletin file and directory entry for to directory file.
C
	IF (POST_NEWS) THEN
	   OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
     &		RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')
	ELSE
	   CALL OPEN_BULLDIR			! Prepare to add dir entry
	   IF (REMOTE_SET.EQ.4) THEN            ! In case exdate has bad date
	      IF (FOLDER_BBEXPIRE.GT.0) THEN
		 EX = FOLDER_BBEXPIRE
	      ELSE
		 EX = NEWS_EXPIRE_DEFAULT
	      END IF
	      CALL GET_EXDATE(EXDATE,EX)
	      CALL SYS$ASCTIM(,TODAY,,)		! Get the present time
	      EXTIME = TODAY(13:)
	   END IF
	   CALL OPEN_BULLFIL			! Prepare to add bulletin

	   CALL READDIR(0,IER)			! Get NBLOCK
	   IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0
	END IF

	FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//SAVE_FOLDER

	IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	      OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))
     &		//'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
     &		RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
     &		ORGANIZATION='INDEXED',IOSTAT=IER,
     &		KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
	   END DO

	   IF (IER.EQ.0) THEN
	      DO WHILE (FILE_LOCK(IER,IER1))
		 OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))
     &		   //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,
     &		   ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &		   FORM='UNFORMATTED')
	      END DO
	   END IF
	ELSE
	   IER= 0
	END IF

	IF (REMOTE_SET.GE.3) THEN
	   SAVE_HEADER = HEADER
	   IF (CLI$PRESENT('HEADER')) THEN
	      HEADER = .TRUE.
	   ELSE
	      HEADER = .FALSE.
	   END IF
	END IF

	IF (MERGE) CALL INITIALIZE_MERGE(IER)

	START_BULL_POINT = BULL_POINT

	IF (IER.EQ.0) THEN
	   IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN
	      REWIND (12)
	   ELSE
	      READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER)
	   END IF
	END IF

	DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0)
	   READ (12,IOSTAT=IER) BULLDIR_ENTRY
	   IF (TO_NEWS.AND.ORIGINAL) THEN
	      READ (12,IOSTAT=IER) NEWS_MSGID
	   END IF
	   NUM_COPY = NUM_COPY - 1

	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	   CALL CONVERT_ENTRY_FROMBIN_FOLDER

	   IF (REMOTE_SET.GE.3) SYSTEM = 0

	   IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN
	      SYSTEM = 0
	      IF (FOLDER_BBEXPIRE.GT.0) THEN
		 CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
	      ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN   ! Permanent message
		 EXDATE = '5-NOV-2000'
		 SYSTEM = 2
	      ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN
		 CALL GET_EXDATE(EXDATE,14)
	      END IF
	   ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN
	      IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN
		 LIMIT = NEWS_F_EXPIRE_LIMIT
		 IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT
		 IF (LIMIT.GT.0) THEN
		    CALL GET_EXDATE(EXDATE,LIMIT)
		    CALL SYS_BINTIM(EXDATE,BTIM)
		    IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN
		       CALL COPY2(EX_BTIM,BTIM)
		    END IF
		 END IF
		 CALL SYS$ASCTIM(,EXDATE,EX_BTIM,)
		 IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN
		    IER = 0
		    GO TO 100
		 END IF
	      ELSE
		 IF (FOLDER_BBEXPIRE.GT.0) THEN
		    EX = FOLDER_BBEXPIRE
		 ELSE
		    EX = NEWS_EXPIRE_DEFAULT
		 END IF
		 IF (F_LAST.EQ.0) THEN
		    EX = EX + COMPARE_DATE(DATE,' ')
		    IF (EX.LE.0) THEN
		       IER = 0
		       GO TO 100
		    END IF
		 END IF
		 CALL GET_EXDATE(EXDATE,EX)
	      END IF
	      CALL SYS$ASCTIM(,TODAY,,)		! Get the present time
	      EXTIME = TODAY(13:)
	   END IF

	   IF (.NOT.BTEST(FOLDER_FLAG,2).OR.	! Not system folder?
     &		 .NOT.SETPRV_PRIV()) THEN	! Or no privileges?
	      SYSTEM = IBCLR(SYSTEM,0)		! Remove system bit
	   END IF

	   IF (BTEST(SYSTEM,2).AND.		! Shutdown message?
     &	    (.NOT.BTEST(FOLDER_FLAG,2).OR.	! Not system folder?
     &		 .NOT.SETPRV_PRIV())) THEN	! Or no privileges?
	      SYSTEM = IBCLR(SYSTEM,2)		! Remove shutdown bit
	      WRITE (6,'('' ERROR: No privileges to add'',
     &				'' shutdown message.'')')
	      IF (FOLDER_BBEXPIRE.GT.0) THEN
		 CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
		 WRITE (6,'('' Expiration will be '',I,'' days.'')')
     &				FOLDER_BBEXPIRE
	      ELSE
		 CALL GET_EXDATE(EXDATE,14)
		 WRITE (6,'('' Expiration will be '',I,'' days.'')') 14
	      END IF
	      EXTIME = '00:00:00.00'
	   ELSE IF (BTEST(SYSTEM,1).AND.	! Permanent?
     &		F_EXPIRE_LIMIT.GT.0.AND..NOT.   ! Expiration limit present?
     &		FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
	      WRITE (6,'('' ERROR: No privileges to add'',
     &				'' permanent message.'')')
	      WRITE (6,'('' Expiration will be '',I,'' days.'')')
     &				F_EXPIRE_LIMIT
	      SYSTEM = IBCLR(SYSTEM,1)
	      CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT)
	      EXTIME = '00:00:00.00'
	   END IF

	   IF (.NOT.ORIGINAL) THEN	! If not /ORIGINAL
	      FROM = USERNAME			! Specify owner
	   END IF

	   IF (REMOTE_SET.EQ.1) THEN
	      WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2
	      IF (IER.NE.0) CALL ERROR_AND_EXIT
	   END IF

	   IF (REMOTE_SET.GE.3.AND..NOT.ORIGINAL) THEN
	      ILEN = LINE_LENGTH + 1

	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
		 CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      END IF
	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
		 POST_SUBJECT = INPUT(7:ILEN)
	      ELSE
		 POST_SUBJECT = DESCRIP
		 IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
	      END IF

	      DO WHILE (ILEN.GT.0)		! Copy bulletin into file
		 CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
		 IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)
	      END DO

	      REWIND (UNIT=3)

	      CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT)
	   ELSE
	      IF (MERGE) CALL ADD_MERGE_TO(IER)

	      IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE

	      IF (IER.EQ.0) THEN
		 NBLOCK = NBLOCK + 1

		 DO I=BLOCK,BLOCK+LENGTH-1
		    READ (11'I,IOSTAT=IER) INPUT(:128)
		    IF (IER.EQ.0) THEN
		       CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128))
		    END IF
		    NBLOCK = NBLOCK + 1
		 END DO
	      END IF

	      IF (IER.EQ.0) THEN
		 IF (MERGE) THEN
		    CALL ADD_MERGE_FROM(IER)
		 ELSE
		    IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,3)
		    CALL ADD_ENTRY	! Add the new directory entry
		 END IF
		 BULL_POINT = BULL_POINT + 1
	      END IF
	   END IF
100	   CONTINUE
	END DO

	IF (POST_NEWS) CLOSE (UNIT=3)

	IF (MERGE) CALL ADD_MERGE_REST(IER)

	IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL

	IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN
	   CLOSE (UNIT=11)
	   CLOSE (UNIT=12)
	   TEMP_FILE = .FALSE.F
	END IFo

	IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWSI
     &		.AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN
	   DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &			       F_NEWEST_BTIM)
	   CALL UPDATE_FOLDER			! Update folder infoi
Cr
C  If user is adding message, an no new messages, update last read time fort
C  folder, so user is not alerted of new message which is owned by user.
CS
	   IF (DIFF.GE.0) THENB
	      CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM)
	   END IF
	END IF

	IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR	! Totally finished with addB

	IF (IER.EQ.0) THENL
	   WRITE (6,'('' Successful copy to folder '',A)')_
     &		FOLDER(:TRIM(FOLDER))//'.'
	   IF (MERGE) THENF
	      CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//E
     &		  '.BULLDIR;-1')
	   END IF
	ELSE IF (MERGE) THENE
	   WRITE (6,'('' ERROR: Copy aborted. No files copied.'')')
	ELSE6
	   WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')E
     &			BULL_POINT - START_BULL_POINT
	END IFe

	IF (.NOT.POST_NEWS) HEADER = SAVE_HEADERo
	IF (ORIGINAL.AND.(NEWS_FEED().OR.REMOTE_SET.EQ.4)) RETURN

	FOLDER_NUMBER = SAVE_FOLDER_NUMBERE
	FOLDER1 = SAVE_FOLDER
	CALL SELECT_FOLDER(.FALSE.,IER1)d

	BULL_POINT = SAVE_BULL_POINTI

	IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN(
	   IF (FROM_REMOTE.AND.ALL) THEN 
	      WRITE (6,'('' WARNING: Original messages not deleted.'')')
	      WRITE (6,'('' Multiple deletions not possible for '',
     &			''remote folders.'')')L
	   ELSE
	      IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
	      CALL DELETE_MSG
	   END IF
	END IFL

	RETURNH
	END




	SUBROUTINE PRINT(PRINT_NUM,OPEN_IT)
C)
C  SUBROUTINE PRINT(
CE
C  FUNCTION:  Print header to queue.
C

	IMPLICIT INTEGER (A-Z)I

	INCLUDE '($SJCDEF)'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'.

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	EXTERNAL CLI$_ABSENT 

	CHARACTER*32 QUEUE,TEST

	INTEGER*2 IOSB(4)
	EQUIVALENCE (IOSB(1),JBC_ERROR)

	CHARACTER*32 FORM

	PARAMETER FF = CHAR(12)

	DATA FIRST /.TRUE./, CHANGED /.FALSE./w

	OPENED = .FALSE.T

	IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND.t
     &	    INCMD(:4).EQ.'PRIN') THEN
	   WRITE (6,'('' Printing all previously queued messages.'')')E
	   GO TO 200=
	ELSE IF (.NOT.FIRST) THEN
	   IER = CLI$GET_VALUE('QUEUE',TEST,TLEN)
	   CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0E
	   CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY
	   IER = CLI$GET_VALUE('FORM',TEST,FLEN)F
	   CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0)R
	   IF (CHANGED) THENL
	      WRITE (6,'('' Printing all previously queued messages.'')')
	      GO TO 200
	   END IF
	END IFI

        IF (INCMD(:4).EQ.'PRIN') THENE
	   IF (CLI$PRESENT('CANCEL')) THEN 
	      WRITE (6,'('' Cancelling all previously queued messages.'')')
	      CLOSE (UNIT=24,DISPOSE='DELETE')0
	      FIRST = .TRUE. 
	      RETURNI
	   END IF
	END IF 

50	IF (PRINT_NUM.EQ.0) THEN0
	   IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)F
	   IF (IER.NE.%LOC(CLI$_ABSENT)) THEN	! Was bulletin specified?
	      CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)
	      IF (EBULL.GT.F_NBULL) EBULL = F_NBULL
	   ELSE IF (OPENED) THENI
	      CALL CLOSE_BULLFIL 
	      CALL CLOSE_BULLDIRu
	      GO TO 150
	   ELSE IF (CLI$PRESENT('ALL')) THENU
	      SBULL = 1
	      EBULL = F_NBULL
	      IER = 0
	   ELSE IF (BULL_POINT.EQ.0) THEN  ! No.  Have we just read a bulletin?
	      WRITE(6,1010)		  ! No, then error. 
	      RETURNE
	   ELSE
	      SBULL = BULL_POINTa
	      EBULL = SBULL
	      IER = 0
	   END IF
	   IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN
	      WRITE (6,1015)I
	      IF (OPENED) THENS
		 CALL CLOSE_BULLFIL
		 CALL CLOSE_BULLDIRT
	      END IF_
	      WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P)
	      RETURND
	   END IF
	ELSE
	   SBULL = PRINT_NUM 
	   EBULL = SBULLL
	END IF

	IF (FIRST) THEN
	   QLEN = 0
	   IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) 	! Get queue nameN
	   IF (QLEN.EQ.0) THENm
	      QUEUE = 'SYS$PRINT'
	      QLEN = TRIM(QUEUE)P
	   END IF

	   NOTIFY = CLI$PRESENT('NOTIFY')

	   FLEN = 0
	   IER = CLI$GET_VALUE('FORM',FORM,FLEN)	 ! Get form name

	   CALL DISABLE_PRIVS

	   OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER,
     &		RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L

	   CALL ENABLE_PRIVS 
	END IF 

	IF (OPEN_IT) THEN
	   CALL OPEN_BULLDIR_SHARED
	   CALL OPEN_BULLFIL_SHARED
	   OPENED = .TRUE. 
	END IF 

	HEAD = CLI$PRESENT('HEADER')$

	DO I=SBULL,EBULL,
	   I1 = I
	   CALL READDIR(I,IER)		! Get info for specified messageS
	   IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENTG
     &		('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THENe
	      IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 
	      IF (I1.GT.SBULL) GO TO 100$
	      CLOSE (UNIT=24,DISPOSE='DELETE') 
	      IF (OPEN_IT) THEN
		 CALL CLOSE_BULLFILA
		 CALL CLOSE_BULLDIRL
	      END IFR
	      RETURN
	   ELSE IF (REMOTE_SET) THENE
	      CALL REMOTE_READ_MESSAGE(I,IER1)(
	      IF (IER1.GT.0) THEN
		 CALL DISCONNECT_REMOTEI
	      ELSE$
		 CALL GET_REMOTE_MESSAGE(IER1)
	      END IF
	      IF (IER1.NE.0) GO TO 100)
	   END IF

	   IF (.NOT.FIRST) THEN
	      WRITE (24,'(A)') FF
	   ELSE
	      FIRST = .FALSE.
	   END IF

	   ILEN = LINE_LENGTH + 1

	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)O
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENL
	      IF (HEAD) THEN'
		 WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)U
	      END IFN
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	   ELSE IF (HEAD) THEN
	      WRITE(24,1060) FROM,DATE//' '//TIME(:8)
	   END IF
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENR
	      IF (HEAD) WRITE(24,1050) INPUT(7:ILEN)e
	   ELSE
	      IF (HEAD) WRITE(24,1050) DESCRIP'
	      IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN)(
	   END IF

	   DO WHILE (ILEN.GT.0)		! Copy bulletin into file'
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN)
	   END DO
	END DO'

100	IF (PRINT_NUM.EQ.0) THEN
	   IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,)R
	   IF (SBULL.EQ.EBULL) THEN
	      WRITE(6,1040)
     &		 BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)T
	   ELSE
	      WRITE(6,1045)
     &		 BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) 
	      IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,)
	      WRITE(6,1046)
     &		 BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)'
	   END IF

1040	   FORMAT(' Message ',A,' sent to printer.')S
1045	   FORMAT(' Messages ',A,$)
1046	   FORMAT('+-',A,' sent to printer.')
	   GO TO 50
	ELSE IF (OPEN_IT) THEN
	   CALL CLOSE_BULLFIL
	   CALL CLOSE_BULLDIR
	END IFF

150	IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN

	ENTRY PRINT_NOW

200	IF (FIRST) RETURN

	FIRST = .TRUE.W

	CLOSE (UNIT=24)

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION,
     &		%LOC('SYS$LOGIN:BULL.LIS'))h

	CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE))E
	CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0)

	IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0)	

	IF (FLEN.GT.0) THEN
	   CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM))T
	END IFN

	CALL DISABLE_PRIVSE

	CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) 

	CALL END_ITMLST(SJC_ITMLST)

	IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)'
	IF (IER.AND.(.NOT.JBC_ERROR)) THENO
	   CALL SYS_GETMSG(JBC_ERROR)
	   IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;')
	ELSE IF (.NOT.IER) THEN
	   CALL SYS_GETMSG(IER)
	   IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;')
	ELSER
	   IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,)
	   IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A,.
     &	      '') started on '',A)') QUEUE(:QLEN), 
     &	      BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN)
	END IFS

	CALL ENABLE_PRIVS			! Reset SYSPRV privileges

	IF (CHANGED) THEN
	   CHANGED = .FALSE.R
	   GO TO 50
	END IF(

	RETURNR

900	CALL ERRSNS(IDUMMY,IER)	
	CALL ENABLE_PRIVS			! Reset SYSPRV privileges
	WRITE(6,1000)
	CALL SYS_GETMSG(IER) 
	RETURN 

1000	FORMAT(' ERROR: Unable to open temporary file
     &	 SYS$LOGIN:BULL.LIS for printing.')
1010	FORMAT(' ERROR: You have not read any message.')
1015	FORMAT(' ERROR: Specified message number has incorrect format:')Y
1030	FORMAT(' ERROR: Following bulletin was not found: ',I)N
1050	FORMAT('Description: ',A,/)
1060	FORMAT('From: ',A,/,'Date: ',A)

	END




	SUBROUTINE READ_MSG(READ_COUNT,BULL_READ)
CC
C  SUBROUTINE READ_MSG
CE
C  FUNCTION: Reads a specified bulletin.
C(
C  PARAMETER:
C	READ_COUNT - Variable to store the record in the message fileD
C		that READ will read from.  Must be set to 0 to indicate
C		that it is the first read of the message.  If -1,
C		READ will search for the last message in the message file
C		and read that one.  If -2, just display header information.
C	BULL_READ - Message number to be read.
CF
	IMPLICIT INTEGER (A - Z) 

	COMMON /POINT/ BULL_POINT

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

	INCLUDE 'BULLUSER.INC'E

	COMMON /READIT/ READITE

	COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGINGH
	LOGICAL PAGINGL

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /READ_DISPLAY/ LINE_OFFSET

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	COMMON /HEADER/ HEADER 

	COMMON /NEXT/ NEXT 
	LOGICAL NEXT /.FALSE./N

	COMMON /POST/ POSTTIMEL

	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*256 MESSAGE_IDT

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM
	DATA BULL_USER_CUSTOM/.FALSE./I

	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP
	COMMON /MAIN_HEADER_INFO/ INEXDATEr
	CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP

	DATA SCRATCH_B1/0/ 

	CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH)E
	CHARACTER HEADLINE*132L

	LOGICAL SINCE,PAGED

	EXTERNAL CLI$_NEGATED

	KILL = BTEST(BULL_USER_CUSTOM,3)E
	BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3))

	POSTTIME = .TRUE.

	CALL LIB$ERASE_PAGE(1,1)		! Clear screenS
	END = 0					! Nothing outputted on screen

	IF (READ_COUNT.GT.0) GO TO 100		! Skip init steps if this isW
						! not first page of bulletin

	IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR.
     &	    INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR.
     &	    INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN
	   IF (CLI$PRESENT('HEADER')) THEN
	      HEADER = .TRUE.
	   ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN
	      HEADER = .FALSE.A
	   END IF
	   ROTC = CLI$PRESENT('ROTATE')
	END IF_

	SINCE = .FALSE.
	NEW = .FALSE.
	PAGE = .TRUE.

	IER = 0

	IF (.NOT.PAGING) PAGE = .FALSE.
	IF (INCMD(:4).EQ.'READ') THEN		! If READ command...
	   POSTTIME = CLI$PRESENT('POST')
	   IF (CLI$PRESENT('MARKED')) THENW
	      READ_TAG = 1 + IBSET(0,1)
	   ELSE IF (CLI$PRESENT('SEEN')) THEN
	      READ_TAG = 1 + IBSET(0,2)
	   ELSE IF (CLI$PRESENT('UNMARKED').OR.
     &		   CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN
	      READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)E
	   ELSE IF (CLI$PRESENT('UNSEEN').OR.
     &		    CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THENN
	      READ_TAG = 1 + IBSET(0,2) + IBSET(0,3):
	   ELSE IF (CLI$PRESENT('ALL')) THEN 
	      READ_TAG = IBSET(0,1) + IBSET(0,2)
	      IF (REMOTE_SET.GE.3) THEN
		 BULL_READ = F_START
	      ELSE
		 BULL_READ = 1
	      END IF
	   END IF
	   IF (READ_TAG) THEN
	      IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THENA
		 WRITE (6,'('' ERROR: Invalid qualifier'',
     &			    '' with remote folder.'')')
		 READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)y
		 GO TO 9999
	      END IF	
	      CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT)
	   END IF

	   IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE.
	   IF (CLI$PRESENT('SINCE')) THEN		! was /SINCE specified?T
	      IER = CLI$GET_VALUE('SINCE',DATETIME)
	      IF (DATETIME.EQ.'TODAY') THEN	! TODAY is the default.
		 IER = SYS$BINTIM('-- 00:00:00.00',TODAY)
		 CALL GET_MSGKEY(TODAY,MSG_KEY)E
	      ELSEL
		 CALL SYS_BINTIM(DATETIME,MSG_BTIM)0
		 CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      END IFQ
	      CALL OPEN_BULLDIR_SHARED
	      CALL READDIR_KEYGE(IER)
	      CALL CLOSE_BULLDIR 
	   ELSE IF (CLI$PRESENT('NEW')) THEN	! was /NEW specified?F
	      NEW = .TRUE.B
	      IF (REMOTE_SET.LT.3) THEN
		 DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),L
     &				 F_NEWEST_BTIM)L
		 IF (DIFF.GE.0) THEN
		    WRITE (6,'('' No new messages are present.'')')O
		    GO TO 9999
		 ELSE 
		    CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &							  MSG_KEY)P
		 END IF 
		 CALL OPEN_BULLDIR_SHAREDB
                 IER = 0
		 DO WHILE (IER.EQ.0)
		    CALL READDIR_KEYGE(IER)L
	   	    IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN
		       CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY)
		       IF (IER1.EQ.0) THEN
	                  CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &					MSG_BTIM)
		          CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &					MSG_KEY)L
			  IER = 0
	               END IF
		    ELSE IF (IER.EQ.0) THEN'
		       CALL CLOSE_BULLDIRB
		       WRITE (6,'('' No new messages are present.'')')
		       GO TO 9999 
	            END IF 
	         END DO
		 CALL CLOSE_BULLDIRN
	      ELSEU
                 IER = 0
		 DO WHILE (IER.EQ.0)
		    CALL NEWS_GET_NEWEST_MESSAGE(IER)_
	   	    IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)
     &			.OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN
		       MSG_NUM = IER
		       CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY)
		       IF (IER1.EQ.0) THEN
	                  CALL NEWS_UPDATE_NEWEST_MESSAGE(IER)E
			  IER = 0
	               END IF
		    ELSE IF (IER.EQ.0) THEN'
		       WRITE (6,'('' No new messages are present.'')')
		       GO TO 9999D
	            END IFZ
	         END DO
	      END IFT
	      BULL_READ = IER
	      IER = IER + 1
	   END IF
	   IF (CLI$PRESENT('SINCE')) THEN
	      IF (IER.EQ.0) THEN.
		 WRITE (6,'('' No messages past specified date.'')')
		 GO TO 9999=
	      ELSE 
		 BULL_READ = IER
		 IER = IER + 1
	      END IFS
	      SINCE = .TRUE.-
	   END IF
	END IF 

	NEXT = .FALSE. 
	IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THENC
	   NEXT = .TRUE.
	ELSE IF (INCMD(:4).EQ.'READ') THEN
	   IF (.NOT.SINCE.AND..NOT.NEWM
     &		 .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') 
     &		 .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE.
	END IF 

	BULL_NOW = BULL_POINT

	OK = .TRUE.
50	IF (READ_TAG) THENS
	   IER = 0	
	   IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR.N
     &	       (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN
	      IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THENT
		 MSG_NUM = F_NBULL+1
	      ELSEI
		 MSG_NUM = BULL_NOW	
	      END IF_
	      CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
	      IF (IER1.EQ.0) IER = BULL_READ + 1)
	   ELSE IF (INCMD(:4).EQ.'BACK') THEN
	      CALL OPEN_BULLDIR_SHARED:
	      CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
	      CALL CLOSE_BULLDIR	
	      IF (IER1.EQ.0) IER = BULL_READ + 1W
	   ELSE IF (INCMD(:4).EQ.'LAST') THEN
	      CALL OPEN_BULLDIR_SHARED.
	      IF (BULL_NOW.GT.0) THEN
		 CALL READDIR(BULL_NOW,IER) 
		 IF (IER.NE.BULL_NOW+1) THEN
		    BULL_NOW = 0
		 ELSE 
		    CALL GET_THIS_OR_NEXT_TAGY
     &				   (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) 
		    IF (IER1.NE.0) BULL_NOW = 0
		 END IF1
	      END IFE
	      IF (BULL_NOW.EQ.0) THEN
		 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)l
		 IF (IER1.EQ.0) IER = BULL_READ + 1 
	      END IF)
	      DO WHILE (IER1.EQ.0)
		 CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
		 IF (IER1.EQ.0) IER = BULL_READ + 1_
	      END DO
	      CALL CLOSE_BULLDIRD
	   ELSE IF (INCMD(:4).EQ.'FIRS') THEN
	      CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)F
	      CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
	      IF (IER1.EQ.0) IER = BULL_READ + 1I
	   ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN_
	      OLD_NEXT = NEXT
	      NEXT = .FALSE. 
	      IF (NEW) MSG_NUM = BULL_READi
	      IF (.NOT.OLD_NEXT) THEN
		 CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
	      ELSEo
		 IF (REMOTE_SET.GE.3) THEN
		    MSG_NUM = BULL_NOW
		 ELSE IF (BULL_NOW.GT.0) THENL
		    CALL OPEN_BULLDIR_SHARED
		    CALL READDIR(BULL_NOW,IER)
		    CALL CLOSE_BULLDIR
		 ELSE)
		    MSG_KEY = BULLDIR_HEADER
		    MSG_NUM = 0
		 END IF.
		 CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
	      END IFO
	      NEXT = OLD_NEXT
	      IF (IER1.EQ.0) THEN
		 IER = BULL_READ + 1
	      ELSET
		 IER = 0
	      END IF&
	   END IF
	END IF 

	IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND.:
     &		INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND.
     &		INCMD(:4).NE.'FIRS'))) THENl
	   IF (BULL_READ.GT.0) THEN		! Valid bulletin number?
	      CALL OPEN_BULLDIR_SHARED)
	      CALL READDIR(BULL_READ,IER)	! Get bulletin directory entryT
	      IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3E
     &			   .AND.INCMD(:4).EQ.'READ') THEN
		 IF (NEW) THEN
		    NEXT = .TRUE.E
		    CALL READDIR(BULL_READ,IER)L
		 END IF.
	      END IFF
	      IF (REMOTE_SET.LT.3.AND. 
     &			   READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN'
		 READ_COUNT = 0,
		 IF (IER.NE.BULL_READ+1) THENb
		    CALL READDIR(0,IER)t
		    IF (NBULL.GT.0) THEN
		       BULL_READ = NBULL
		       CALL READDIR(BULL_READ,IER)
		    ELSE
		       IER = 0
		    END IF
		 END IF
	      ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THENO
		 CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
		 IF (IER1.NE.0) IER = 0I
	      END IF$
	      CALL CLOSE_BULLDIRI
	   ELSE
	      IER = 0
	   END IF
	END IF 

	IF (IER.NE.BULL_READ+1) THEN		! Was bulletin found?
	   IF (REMOTE_SET.LT.3) THENT
	      WRITE(6,1030)			! If not, then error outN
	   ELSE
	      WRITE(6,1040)
	   END IF
	   NEXT = .FALSE.
	   IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFILR
	   GO TO 9999
	END IF(

	BULL_POINT = BULL_READ			! Update bulletin counterF

	IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHAREDS

	IF (BTEST(BULL_USER_CUSTOM,1)
     &			.AND.(NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR.C
     &		INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THENi
	   ILEN = LINE_LENGTH + 1
	   BLOCK_SAVE = BLOCK

	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENL
	      INFROM = INPUT(7:ILEN) 
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	   ELSE
	      INFROM = FROM
	   END IF
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THENT
	      INDESCRIP = INPUT(7:ILEN)
	   ELSE
	      INDESCRIP = DESCRIP
	   END IF

	   OK = INCLUDE_MSG(INFROM,INDESCRIP)

	   IF (.NOT.OK) THEN 
	      BULL_NOW = MSG_NUMT
	      IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN(
	         BULL_READ = MSG_NUM - 1 
	      ELSE)
	         BULL_READ = MSG_NUM + 1L
	      END IFF
	      IF (REMOTE_SET) CALL CLOSE_BULLFIL
	      IF (REMOTE_SET.LT.3) THEN
		 DIFF = COMPARE_BTIM(MSG_BTIM,
     &				LAST_READ_BTIM(1,FOLDER_NUMBER+1))
	         IF (DIFF.GT.0) THENN
	            CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)_
	         END IF
	      ELSEE
	         CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)
              END IF
	      GO TO 50 
	   END IF

	   BLOCK = BLOCK_SAVE
	END IFL

	NEXT = .FALSE.'
	IF (REMOTE_SET.LT.3) THEN
           IF (INCMD(:4).NE.'SEAR') THEN
	      DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1))
	      IF (DIFF.GT.0) THEN
	         CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)
	      END IFE
	   END IF
	   IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2)O
	   IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN 
	      CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM)
	   END IF
	ELSE
	   IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID
	   IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2)
	   IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THENI
	      CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL)A
	   END IF
	   IF (INCMD(:4).NE.'SEAR') THEN 
	      CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) 
	   ELSE
	      CALL NEWS_GET_NEWEST_MESSAGE(IER)
	      IF (IER.EQ.BULL_READ) CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)R
	   END IF
	END IFa

	EDIT = .FALSE.B

	PAGE_WIDTH = REAL_PAGE_WIDTH=

	IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN&
	   IF (CLI$PRESENT('EDIT')) THENR
	      OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
     &		RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')E
	      IF (IER.NE.0) THEND
		 CALL ERRSNS(IDUMMY,IER)
		 CALL SYS_GETMSG(IER)$
		 GO TO 9999,
	      END IF=
	      EDIT = .TRUE.
	      PAGE_WIDTH = LINE_LENGTHe
	      PAGE = .FALSE.I
	   END IF
	END IF.

	IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT

	IF (REMOTE_SET.GE.3) THEN
	   WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)')
     &				BULL_POINT,F_START,F_NBULL
	   DO WHILE (INDEX(HEADLINE,'- ').GT.0)
	      I = INDEX(HEADLINE,'- ')L
	      HEADLINE(I+1:) = HEADLINE(I+2:)
	   END DO
	ELSE 
	   WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULLO
	END IFE
	DO WHILE (INDEX(HEADLINE,'  ').LT.TRIM(HEADLINE))
	   I = INDEX(HEADLINE,'  ')
	   HEADLINE(I:) = HEADLINE(I+1:))
	END DOE
	I = TRIM(HEADLINE)R
	HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE))
	FLEN = TRIM(FOLDER_NAME)(
	HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN)F
	IF (READIT.GT.0) THEN
	   WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)),
	ELSE IF (EDIT) THEN
	   WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE))
	ELSE)
	   WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))/
	END IFU

	END = 1					! Outputted 1 line to screenL

	IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN2
	   IF (REMOTE_SET.NE.3) THEN)
	      INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)E
     &				//'   (DELETED)'
	   ELSE
	      INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)I
	   END IF
	ELSE IF ((SYSTEM.AND.4).EQ.4) THEN	! Is entry shutdown bulletin?W
	   INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)
     &				//'   Expires on shutdown'
	ELSE IF ((SYSTEM.AND.2).EQ.2) THEN	! Is entry permanent bulletin?
	   INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)
     &				//'   Permanent'
	ELSE 
	   INPUT = 'Date:   '//DATE(:TRIM(DATE))//' '//TIME(:5)//
     &				'   Expires:   '//EXDATE//' '//EXTIME(:5)E
	END IFW
	IF ((SYSTEM.AND.1).EQ.1) THEN		! System bulletin?
	   INPUT = INPUT(:TRIM(INPUT))//' / System'
	END IFP
	IF (EDIT) THEN 
	   WRITE (3,'(A)') INPUT(:TRIM(INPUT))(
	ELSEL
	   WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT))
	END IF'

	END = END + 1

	LINE_OFFSET = 0
	CHAR_OFFSET = 0
	ILEN = LINE_LENGTH + 1M
	CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: '
     &	   .AND..NOT.BTEST(SYSTEM,3)) THEN
	   INPUT = 'From:   '//INPUT(7:)I
	   DO WHILE (TRIM(INPUT).GT.0)T
	      I = MIN(PAGE_WIDTH,TRIM(INPUT))
	      IF (EDIT) THENC
		 WRITE(3,'(A)') INPUT(:I)I
	      ELSEa
		 WRITE(6,'(1X,A)') INPUT(:I)
	      END IF_
	      INPUT = INPUT(I+1:)
	      END = END + 1
	   END DO
	   LINE_OFFSET = 1$
	ELSE%
	   IF (EDIT) THEN
	      WRITE(3,'(''From:   '',A)') FROM 
	   ELSE
	      WRITE(6,'('' From:   '',A)') FROM
	   END IF
	   END = END + 12
	END IFL
	IF (INPUT(:6).NE.'Subj: ') THEN
	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)L
	END IF_
	LEN_TEMP = ILEN
	CALL CONVERT_TABS(INPUT,LEN_TEMP)
	IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
	   INPUT = 'Subj:   '//INPUT(7:)
	   DO WHILE (TRIM(INPUT).GT.0)E
	      I = MIN(PAGE_WIDTH,TRIM(INPUT))
	      IF (EDIT) THENS
		 WRITE(3,'(A)') INPUT(:I)F
	      ELSEH
		 WRITE(6,'(1X,A)') INPUT(:I)
	      END IFE
	      INPUT = INPUT(I+1:)
	      END = END + 1
	   END DO
	   LINE_OFFSET = LINE_OFFSET + 1(
	   IF (EDIT) WRITE(3,'(1X)')e
	ELSE,
	   END = END + 1 
	   IF (EDIT) THEN
	      WRITE(3,'(''Subj:   '',A)') DESCRIP(:TRIM(DESCRIP))
	      WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP)R
	   ELSE
	      WRITE(6,'('' Subj:   '',A)') DESCRIP(:TRIM(DESCRIP))E
	      IF (LINE_OFFSET.EQ.1) THEN
		 CHAR_OFFSET = 1 - PAGE_WIDTHc
		 LINE_OFFSET = 2
		 IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP)
	      END IFH
	   END IF
	END IF)
	IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1o
	CALL CLOSE_BULLFIL			! End of bulletin file read,

	IF (EDIT) GO TO 200

	WRITE(6,'(1X)')

	IF (READIT.GT.0) WRITE(6,'(1X)')S
	END = END + 1
CE
C  Each page of the bulletin is buffered into temporary memory storage beforeI
C  being outputted to the terminal.  This is to be able to quickly close the
C  bulletin file, and to avoid the possibility of the user holding the screen,
C  and thus causing the bulletin file to stay open.  The temporary memory)
C  is structured as a linked-list queue, where SCRATCH_B1 points to the header
C  of the queue.  See BULLSUBS.FOR for more description of the queue. 
CE

	IF (SCRATCH_B1.NE.0) THEN		! Is queue empty?L
	   SCRATCH_B = SCRATCH_B1		! No, set queue pointer to head 
	ELSE					! Else if queue is empty
	   CALL INIT_QUEUE(SCRATCH_B,INPUT)
	   SCRATCH_B1 = SCRATCH_B		! Init header pointer 
	END IF 

	READ_ALREADY = 0			! Number of lines already read
						! from record.
	IF (READ_COUNT.EQ.-2) THEN		! Just output header first read
	   READ_COUNT = BLOCK
	   GO TO 9999
	ELSEt
	   READ_COUNT = BLOCK			! Init bulletin record counterI
	END IF'

	GO TO 200

100	IF (READIT.EQ.0) THEN 			! If not 1st page of READ
	   WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info
	   END = END + 2			! Increase display counter
	END IF 

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header

200	DISPLAY = 0 
	IF (READIT.GT.0) END = END - 2		! /READ can output 2 more lines

	CALL OPEN_BULLFIL_SHARED		! Get bulletin file
	MORE_LINES = .TRUE.
	DO WHILE (ILEN.GT.0.AND.MORE_LINES)
	   IF (CHAR_OFFSET.EQ.0) THEN
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      LINE_OFFSET = LINE_OFFSET + 1
	   END IF
	   IF (ILEN.LT.0) THEN		! Error, couldn't read record
	      ILEN = 0			! Fake end of reading file
	      MORE_LINES = .FALSE.E
	   ELSE IF (ILEN.GT.0) THEN
	      IF (EDIT) THEN4
		 WRITE(3,'(A)') INPUT(:ILEN)
	      ELSE IF (CHAR_OFFSET.EQ.0) THEN
		 LEN_TEMP = ILEN
		 CALL CONVERT_TABS(INPUT,LEN_TEMP)
		 IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP)
		 IF (LEN_TEMP.GT.PAGE_WIDTH) THENT
		    CHAR_OFFSET = 1I
		    BUFFER = INPUT(:PAGE_WIDTH)E
		    CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)
		 ELSEF
		    CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)
		 END IFI
	      ELSED
		 CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH/
		 IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN 
		    BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP)
		    CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)
		    CHAR_OFFSET = 0E
		 ELSED
		    BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1)
		    CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)
		 END IFL
	      END IFE
	      DISPLAY = DISPLAY + 1
	      IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN
		 MORE_LINES = .FALSE.
	      END IFT
	   END IF
	END DOM

	CALL CLOSE_BULLFIL			! End of bulletin file read 

	IF (EDIT) THEN 
	   CLOSE (UNIT=3)
	   CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
	   CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
	   READ_COUNT = 0			! init bulletin record counterG
	   GO TO 9999
	END IF1

CT
C  Bulletin page is now in temporary memory, so output to terminal.A
C  Note that if this is a /READ, the first line will have problems with
C  the usual FORMAT statement.  It will cause a blank line to be outputted
C  at the top of the screen.  This is because of the input QIO at theT
C  end of the previous page.  The output gets confused and thinks it mustE
C  end the previous line.  To prevent that, the first line of a new page
C  in a /READ must use a different FORMAT statement to surpress the CR/LF.
CE

	SCRATCH_B = SCRATCH_B1			! Reinit queue pointer to head
	DO I=1,DISPLAY				! Output page to terminal
	   CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record
	   IF (I.EQ.1.AND.READIT.GT.0) THEN
	      WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER))	 ! (See above comments)
	   ELSE
	      WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER))
	   END IF
	END DOT

	IF (ILEN.EQ.0) THEN			! End of message?
	   READ_COUNT = 0			! init bulletin record counter_
	ELSE	! Possibly end of message since end of page could be last line
	   CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) 
	   IF (IREC.EQ.0) THEN			! Last record?
	      CALL TEST_MORE_LINES(ILEN)	! More lines to read?
	      IF (ILEN.GT.0) THEN		! Yes, there are still moreP
		 IF (READIT.EQ.0) WRITE(6,1070)	! say there is more of bulletin 
	      ELSE				! Yes, last line anyway
		 READ_COUNT = 0			! init bulletin record counter
	      END IFS
	   ELSE IF (READIT.EQ.0) THEN		! Not last record so
	      WRITE(6,1070)			! say there is more of bulletin
	   END IF
	END IFm

9999	POSTTIME = .FALSE.P
	IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3)L
	RETURN0

1030	FORMAT(' No more messages.')
1040	FORMAT(' Message not found.')
1070	FORMAT(1X,/,' Press RETURN for more...',/)G

2000	FORMAT(A)

	END





	SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP)

	IMPLICIT INTEGER (A-Z)L

	CHARACTER INPUT*(*)

	DO I=1,LEN_TEMP
	   IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN	
	      INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13)
	      IF (INPUT(I:I).LT.'A')X
     &			INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26)
	   ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN
	      INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13)
	      IF (INPUT(I:I).LT.'a')b
     &			INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26)

	   END IF
	END DO 

	RETURNB
	END






	SUBROUTINE READNEW(REDO)X
CE
C  SUBROUTINE READNEW 
Cx
C  FUNCTION: Displays new non-system bulletins with prompts between bulletins.
C 

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLUSER.INC''

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'(

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2)

	COMMON /POINT/ BULL_POINT

	COMMON /READ_DISPLAY/ LINE_OFFSET

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
	LOGICAL PAGINGO

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /ACCESS/ READ_ONLY
	LOGICAL READ_ONLY

	EXTERNAL BULLETIN_SUBCOMMANDS

	CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8
	CHARACTER INREAD*1 
	EQUIVALENCE (INREAD4,INREAD)(

	DATA LEN_FILE_DEF /0/, INREAD/0/I

	LOGICAL SLOW,SLOW_TERMINAL:

	FIRST_MESSAGE = BULL_POINT(

	IF (ICHAR(INREAD).EQ.0) THEN	! If calling READNEW for first timeP
	   SLOW = SLOW_TERMINAL()	! Check baud rate of terminal
	END IF				! to avoid gobs of output

	LEN_P = 0			! Tells read subroutine there isE
					! no bulletin parameter

1	WRITE(6,1000)			! Ask if want to read new bulletinsE

	CALL GET_INPUT_NUM(NUMREAD,NLEN)	! Get input.
	CALL STR$UPCASE(NUMREAD,NUMREAD)	! Make input upper case 
	READ (NUMREAD,'(I<NLEN>)',IOSTAT=IER) TEMP_READ
	IF (IER.NE.0) THEN,
	   INREAD = NUMREAD(:1)
	   IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THENT
	      IF (INREAD.EQ.'Q') THEN
		 WRITE (6,'(''+uit'',$)')T
	      ELSE IF (INREAD.EQ.'E') THEN 
		 WRITE (6,'(''+xit'',$)') 
		 DO I=1,FLONG			! Just show SYSTEM folders
		    NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I)
		 END DO2
		 DO I=1,FLONG	! Test for new messages in SYSTEM folders
		    IF (NEW_MSG(I).NE.0) RETURN.
		 END DO	
		 CALL EXIT
	      ELSEL
		 WRITE (6,'(''+o'',$)')S
	      END IFN
	      RETURN	! If NO, exitY
	      		! Include QUIT to be consistent with next question
	   ELSE
	      CALL LIB$ERASE_PAGE(1,1)
	   END IF
	END IFN

3	IF (TEMP_READ.GT.0) THEN
	   IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN
	      WRITE (6,'('' ERROR: Specified new message not found.'')').
	      GO TO 1
	   ELSE
	      BULL_POINT = TEMP_READ - 11
	   END IF
	END IF2

	READ_COUNT = 0				! Initialize display pointerU

5	CALL READ_MSG(READ_COUNT,BULL_POINT+1)	! Read next bulleting
	BULL_POINT_READ = BULL_POINTH
	IF (READ_COUNT.EQ.0) THEN		! Is full bulletin displayed?	
	   CALL OPEN_BULLDIR_SHARED		! If so, see if more new bulls
10	   CALL READDIR(BULL_POINT+1,IER_POINT)
	   IF ((IER_POINT.EQ.BULL_POINT+2).AND.	! If system bulletin (and system 
     &	       (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN	! folder) then skip it.a
	      BULL_POINT = BULL_POINT + 1
	      GO TO 10e
	   END IF
	   CALL CLOSE_BULLDIR
	END IF(

	GO TO 12o

11	IF (READ_COUNT.GT.0) THEN
	   CALL OPEN_BULLDIR_SHARED
	   CALL OPEN_BULLFIL_SHARED
	   CALL READDIR(BULL_POINT,IER)
	   ILEN = LINE_LENGTH+1
	   DO I=1,LINE_OFFSET
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	   END DO
	   CALL CLOSE_BULLFIL
	   CALL CLOSE_BULLDIR
	END IFe

	BULL_POINT = BULL_POINT_SAVEt
	LENGTH = LENGTH_SAVE.
	BLOCK = BLOCK_SAVE 

12	IF (READ_COUNT.EQ.0) THEN		! Prompt user in between
	   WRITE(6,1020)			! full screens or end of bull.
	ELSEg
	   WRITE(6,1030) 
	END IF 

	CALL GET_INPUT_NOECHO(INREAD)
	CALL STR$UPCASE(INREAD,INREAD)	! Convert input to upper case 

	BLOCK_SAVE = BLOCKM
	LENGTH_SAVE = LENGTH
	BULL_POINT_SAVE = BULL_POINTC

	IF (INREAD.EQ.'Q') THEN		! If Q , then QUIT
	   WRITE (6,'(''+Quit'',$)')
	   RETURN
	ELSE IF (INREAD.EQ.'D') THEN	! If D , then redisplay directoryM
	   WRITE (6,'(''+Dir'',$)')
	   REDO = .TRUE.
	   RETURN
	ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN_
	   				! If F then copy bulletin to file_
	   WRITE (6,'(''+ '')')		! Move cursor from end of prompt line 
	   				! to beginning of next line.
	   IF (LEN_FILE_DEF.EQ.0) THENC
	      CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)
	      IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR',
     &			BULL_PARAMETER,CONTEXT)
	      IF (IER) THEN
		 FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' 
		 LEN_FILE_DEF = ILEN + 5
	      ELSE(
		 FILE_DEF = 'SYS$LOGIN:'
		 LEN_FILE_DEF = 10
	      END IFT
	   END IF

	   LEN_FOLDER = TRIM(FOLDER)E
	   CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,D
     &		'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)//
     &		FOLDER(:LEN_FOLDER)//'.LIS) ')

	   IF (LEN_P.EQ.0) THEN
	      BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER)
     &			//'.LIS'c
	      LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4
	   ELSE
	      IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT)
	      IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0
     &		  .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN.
		 BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//R
     &				BULL_PARAMETER(:LEN_P)
		 LEN_P = LEN_P + LEN_FILE_DEFE
	      END IFE
	   END IF

	   BULL_POINT = BULL_POINT_READ
	   INCMD = 'FILE '//BULL_PARAMETER(:LEN_P)A
	   IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)P
	   CALL FILE(0,.TRUE.)
	   GO TO 11
	ELSE IF (INREAD.EQ.'P') THEND
	   WRITE (6,'(''+P'',$)')
	   BULL_POINT = BULL_POINT_READ
	   IF (REMOTE_SET.GE.3.OR.$
     &	       INDEX(FOLDER_DESCRIP,'<').GT.0) THEN
	      WRITE(6,1040)
	      CALL GET_INPUT_NOECHO(INREAD)
	      CALL STR$UPCASE(INREAD,INREAD)P
	      IF (INREAD.EQ.'P') THEN
		 WRITE (6,'(''+P'',$)').
		 INCMD = 'REPLY'
	      ELSE IF (INREAD.EQ.'U') THEN)
		 WRITE (6,'(''+U'',$)') 
		 INCMD = 'RESPOND'
	      ELSE IF (INREAD.EQ.'B') THEN.
		 WRITE (6,'(''+B'',$)')N
		 INCMD = 'RESPOND/LIST'E
	      ELSET
		 GO TO 11L
	      END IFE
	      IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
	      CALL RESPONDT
	   ELSE IF (READ_ONLY) THEN
	      WRITE (6,'(
     &		 '' ERROR: You do not write access to this folder.'')')T
	   ELSE
	      INCMD = 'REPLY'
	      IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
	      CALL REPLYl
	   END IF
	   GO TO 11
	ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN,
	   			! If NEXT and last bulletins not finished
	   READ_COUNT = 0			! Reset read bulletin counter
	   CALL OPEN_BULLDIR_SHARED		! Look for NEXT bulletin
20	   CALL READDIR(BULL_POINT+1,IER)
	   IF (IER.NE.BULL_POINT+2) THEN	! If no NEXT bulletinT
	      CALL CLOSE_BULLDIR		! Exit 
	      WRITE(6,1010)
	      RETURN 
	   ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN
	      BULL_POINT = BULL_POINT + 1	! If SYSTEM bulletin, skip it
	      GO TO 20			! Look for more bulletinsS
	   END IF
	   CALL CLOSE_BULLDIR
	ELSE IF (INREAD.EQ.'R') THENA
	   WRITE (6,'(''+Read'')')G
	   WRITE (6,'('' Enter message number: '',$)')C
	   CALL GET_INPUT_NUM(NUMREAD,NLEN)	! Get input
	   CALL STR$UPCASE(NUMREAD,NUMREAD)	! Make input upper case
	   READ (NUMREAD,'(I<NLEN>)',IOSTAT=IER) TEMP_READ 
	   IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN
	      WRITE (6,'('' ERROR: Invalid message number specified.'')')
	      GO TO 12E
	   ELSE
	      GO TO 3
	   END IF
	ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN
	   WRITE(6,1010)R
	   RETURN
	END IF 
	IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2
	GO TO 5

1000	FORMAT(' Read messages? Type N(No),E(Exit),message',_
     &	 ' number, or any other key for yes: ',$)
1010	FORMAT(' No more messages.')I
1020	FORMAT(1X,<PAGE_WIDTH>('-'),/,' Type Q(Quit),F(File),D(Dir),',_
     &	'R(Read msg #),P(Reply) or other for next message: ',$)
1030	FORMAT(1X,<PAGE_WIDTH>('-'),/,' Type Q(Quit),F(File),N(Next),',
     &	'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) 
1040	FORMAT(' Type P to post reply, U to reply to user,',s
     &	' B to do both, or other to quit: ',$) 

	END




	SUBROUTINE SET_DEFAULT_EXPIRE
CL
C  SUBROUTINE SET_DEFAULT_EXPIRE
CI
C  FUNCTION: Sets default expiration date.
C_
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'U

	INCLUDE 'BULLUSER.INC'G

	CHARACTER EXPIRE*3L

	IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN 
	   IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) 
	   IF (EX_LEN.GT.3) EX_LEN = 3 
	   READ (EXPIRE,'(I<EX_LEN>)') TEMP

	   CALL OPEN_BULLFOLDER		! Open folder file
	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)E
	   IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN9
	      WRITE (6,'('' ERROR: Expiration cannot be > '',
     &			I3,'' days.'')') BBEXPIRE_LIMIT
	   ELSE IF (TEMP.LT.-1) THEN$
	      WRITE (6,'('' ERROR: Expiration must be > -1.'')')E
	   ELSE
	      FOLDER_BBEXPIRE = TEMP'
	      WRITE (6,'('' Default expiration modified.'')')
	   END IF
	   CALL REWRITE_FOLDER_FILE(IER)=
	   CALL CLOSE_BULLFOLDERI
	ELSEN
	   WRITE (6,'('' You are not authorized to set expiration.'')')
	END IFR

	RETURN 
	END




	LOGICAL FUNCTION NEWS_FEED()S

	IMPLICIT INTEGER (A-Z)	

	INCLUDE 'BULLFOLDER.INC'T

	NEWS_FEED = .FALSE.

	SLIST = INDEX(FOLDER_DESCRIP,'<')
	IF (SLIST.GT.0) THEN_
	   I = SLIST + 1
	   FLEN = TRIM(FOLDER_DESCRIP)E
	   DO WHILE (I.LE.FLEN)
	      IF (FOLDER_DESCRIP(I:I).EQ.'>') THENN
		 I = FLEN + 1I
	      ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR.
     &		  FOLDER_DESCRIP(I:I).GT.'Z').AND.
     &		  FOLDER_DESCRIP(I:I).NE.':'.AND.E
     &		  FOLDER_DESCRIP(I:I).NE.'@'.AND._
     &		  FOLDER_DESCRIP(I:I).NE.'%') THEN
		 I = I + 1
	      ELSE 
		 I = FLEN + 2 
	      END IF 
	   END DO
	   IF (I.EQ.FLEN+1) NEWS_FEED = .TRUE.C
	END IFB

	RETURNE
	END
