C
C  BULLETIN1.FOR, Version 4/22/91
C  Purpose: Contains subroutines for the bulletin board utility program.
C  Environment: VAX/VMS
C  Usage: Invoked by the BULLETIN command.
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(STATUS)
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
 
	CHARACTER*64 MAIL_SUBJECT
 
	INCLUDE 'BULLDIR.INC'
 
	EXTERNAL CLI$_ABSENT
 
	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
 
	MAIL_SUBJECT = DESCRIP
	IF (CLI$PRESENT('SUBJECT')) THEN
	   IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D)
	   IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN
	      WRITE(6,'('' ERROR: Subject limit is 64 characters.'')')
	      RETURN
	   END IF
	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
 
	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//' '//TIME(:5)//'   (DELETED)'
              ELSE
	         INPUT = 'Date:   '//DATE//' '//TIME(:5)
	      END IF
	   ELSE IF ((SYSTEM.AND.4).EQ.4) THEN	! Is entry shutdown bulletin?
	      INPUT = 'Date:   '//DATE//' '//TIME(:5)//'   Expires on shutdown'
	   ELSE IF ((SYSTEM.AND.2).EQ.2) THEN	! Is entry permanent bulletin?
	      INPUT = 'Date:   '//DATE//' '//TIME(:5)//'   Permanent'
	   ELSE
	      INPUT = 'Date:   '//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)
	ELSE
	   IF (HEAD) WRITE(3,1050) 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(:ILEN)
	END DO
 
	CLOSE (UNIT=3)			! Message copy completed
 
	CALL CLOSE_BULLFIL
 
	LEN_D = TRIM(MAIL_SUBJECT)
	IF (LEN_D.EQ.0) THEN
	   MAIL_SUBJECT = 'BULLETIN message.'
	   LEN_D = TRIM(MAIL_SUBJECT)
	END IF
 
	I = 1
	DO WHILE (I.LE.LEN_D)
	   IF (MAIL_SUBJECT(I:I).EQ.'"') THEN
	      IF (LEN_D.EQ.64) THEN
		 MAIL_SUBJECT(I:I) = '`'
	      ELSE
		 MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(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
 
	CALL DISABLE_PRIVS
	CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P)
     &	   //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,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*31,DEFAULT_USER*12
 
	IF (FOLDER_NUMBER.EQ.0) THEN
	   WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')')
	   RETURN
	ELSE 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.25) THEN
	         WRITE (6,'('' ERROR: Folder name cannot be larger 
     &				than 25 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)e
					! See if folder existso
	   IF (IER.EQ.0) THEN
	      WRITE (6,'('' ERROR: Folder name already exists.'')')
	      CALL CLOSE_BULLFOLDER
	      RETURN 
	   END IF
	END IFL
 o
	CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
 M
	IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THENg
	   LEN_F = TRIM(FOLDER_DIRECTORY)
	   IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)//
     &		FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)//
     &		FOLDER1(:TRIM(FOLDER1))//'.*')
	   IF (IER) THENB
	      IER = 0
	      FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1
	   END IF
	END IFI
 I
	IF (IER.EQ.0) THEN
	   IF (CLI$PRESENT('OWNER')) THEN
	      CALL CHKACL
     &		(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)O
	      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 IFl
	   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)L
	   ELSE
	      FOLDER_FLAG = IBCLR(FOLDER_FLAG,6)E
	   END IF
	   CALL WRITE_FOLDER_FILE(IER)E
	   IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')')
	END IF 
 
	IF (IER.NE.0) THENP
	   WRITE (6,'('' ERROR: Folder modification aborted.'')')
	END IFs
 i
	CALL CLOSE_BULLFOLDER
 R
	RETURNP
	END
 H
 !
 s
	FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)
  
	IMPLICIT INTEGER (A-Z)L
 O
	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 
 o
	RETURNr
	END
 .
 '
 
	SUBROUTINE MOVE(DELETE_ORIGINAL)P
CE
C  SUBROUTINE MOVE
Cr
C  FUNCTION: Moves message from one folder to another.
C,
	IMPLICIT INTEGER (A - Z)I
 R
	COMMON /POINT/ BULL_POINT
  
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 L
	COMMON /ACCESS/ READ_ONLY
	LOGICAL READ_ONLY
 5
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 4
	COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1
	DATA SCRATCH_R1 /0/
 T
	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD
  
	COMMON /HEADER/ HEADERN
 I
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE 'BULLUSER.INC' 
 D
	INCLUDE 'BULLFOLDER.INC'm
 n
	INCLUDE 'BULLFILES.INC'
 '
	EXTERNAL CLI$_ABSENTI
 :
	EXTERNAL BULLETIN_SUBCOMMANDS
 X
	LOGICAL DELETE_ORIGINAL
 N
	CHARACTER SAVE_FOLDER*25,POST_SUBJECT*255
 e
	IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THENm
	   WRITE (6,
     &	  '('' ERROR: You have no privileges to keep original owner.'')')
	   RETURN
	END IFL
 P
	ALL = CLI$PRESENT('ALL')L
 I
	MERGE = CLI$PRESENT('MERGE') 
 
	SAVE_BULL_POINT = BULL_POINT,
 G
	IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
	IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THENL
	   IF (BULL_POINT.EQ.0) THEN	! If no message has been readN
	      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) THEN	! Was message found?
	      WRITE(6,'('' ERROR: Specified message was not found.'')')
	      CALL CLOSE_BULLDIRW
	      RETURNI
	   END IF
 E
	   NUM_COPY = 1
	ELSE3
	   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_BULLDIRL
	      RETURNF
	   END IF
 I
	   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
	      ELSEA
		 NUM_COPY = EBULL - SBULL + 1
		 BULL_POINT = SBULL 
	      END IFR
	      IF (NUM_COPY.GT.1) ALL = .TRUE.
	   ELSE IF (CLI$PRESENT('ALL')) THENa
	      NUM_COPY = NBULLr
	      BULL_POINT = 1I
	   END IF
	END IFU
 P
	FROM_REMOTE = REMOTE_SET
  
	IF (REMOTE_SET) THENL
	   OPEN (UNIT=12,FILE='REMOTE.BULLDIR',
     &	      STATUS='SCRATCH',FORM='UNFORMATTED',N
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,R
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,/
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')T
	   IF (IER.EQ.0) THEN
	      OPEN (UNIT=11,FILE='REMOTE.BULLFIL',F
     &	         STATUS='SCRATCH',IOSTAT=IER,
     &	         ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,D
     &	         FORM='UNFORMATTED')E
	   END IF
	   IF (IER.EQ.0) THEN
	      CALL OPEN_BULLFIL
	      CALL READDIR(0,IER)
	      IF (IER.EQ.1) WRITE (12,IOSTAT=IER1) BULLDIR_HEADER
	      I = BULL_POINT - 16
	      IER = I + 1
	      NBLOCK = 1D
	      LAST = BULL_POINT+NUM_COPY-1
	      NUM_COPY = 0I
	      DO WHILE (I.LT.LAST.AND.IER.EQ.I+1)
		 I = I + 1
		 I1 = IE
	         CALL READDIR(I,IER)A
		 IF ((I1.EQ.BULL_POINT.AND.I1.NE.I)I
     &		     .AND..NOT.CLI$PRESENT('ALL')) THENR
		    WRITE(6,'('' ERROR: Message not found: '',I)') I1S
		    CLOSE (UNIT=11)S
		    CLOSE (UNIT=12)L
		    CALL CLOSE_BULLDIR
	            CALL CLOSE_BULLFILr
		    RETURN
		 END IF.
		 IF (IER.EQ.I+1.AND.I.LE.LAST) THENC
		    BLOCK = NBLOCK
		    CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)E
		    CALL REMOTE_READ_MESSAGE(I,IER1)
	            IF (IER1.GT.0) THEN
	               CALL DISCONNECT_REMOTE
	            ELSE'
	               CALL GET_REMOTE_MESSAGE(IER1)
	            END IF'
		    IF (LENGTH.EQ.0) IER = 1	! Don't allow empty messagesr
		    IF (IER1.EQ.0) THENU
	               SCRATCH_R = SCRATCH_R1
	               DO J=1,LENGTH
	                CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128))i
		        WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128)O
		        IF (IER1.EQ.0) NBLOCK = NBLOCK + 1
		       END DO!
		    END IF
		    IF (IER1.EQ.0) WRITE (12,IOSTAT=IER1) BULLDIR_ENTRYl
		    IF (IER1.NE.0) THEN)
		       I = IER
		    ELSE
		       NUM_COPY = NUM_COPY + 1
		    END IF
		 END IF 
	      END DOD
	   END IF
	   CALL CLOSE_BULLFIL
	   IF (IER1.NE.0) THEN 
	      WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')')
	      CLOSE (UNIT=11)
	      CLOSE (UNIT=12)
	      CALL CLOSE_BULLDIR
	      RETURNP
	   END IF
	END IF
  
	CALL CLOSE_BULLDIR'
	   
	SAVE_FOLDER = FOLDER
	SAVE_FOLDER_NUMBER = FOLDER_NUMBERI
	CALL CLI$GET_VALUE('FOLDER',FOLDER1)1
 h
	FOLDER_NUMBER = -1	! Use FOLDER as key rather than FOLDER_NUMBERN
	CALL SELECT_FOLDER(.FALSE.,IER)
 
	IER1 = .TRUE.
 L
	IF (.NOT.IER) THEN 
	   WRITE (6,'('' ERROR: Cannot access specified folder.'')')F
	ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN
	   IF (READ_ONLY) THENa
	      WRITE (6,'('' ERROR: No access to write into folder.'')')
	   ELSE
	      WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')')T
	   END IF
	   IER1 = .FALSE.
	ELSE IF (REMOTE_SET.EQ.4) THEN 
	   IF (CLI$PRESENT('ORIGINAL')) THENA
	      REMOTE_SET = 0_
	   ELSE
	      SLIST = INDEX(FOLDER_DESCRIP,'<')
	      FOLDER1_DESCRIP = E
     &			FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)I
	      IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN
	         WRITE(6,'('' ERROR: Multiple newsgroup feed'',
     &			'' is present.'')')
	         IER1 = .FALSE.
	      END IF'
	   END IF
	END IFW
 )
	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_NUMBERd
	      FOLDER1 = SAVE_FOLDER
	      CALL SELECT_FOLDER(.FALSE.,IER1):
	   END IF
	   BULL_POINT = SAVE_BULL_POINT
	   CLOSE (UNIT=11)I
	   CLOSE (UNIT=12)L
	   RETURN
	END IFr
Cl
C  Add bulletin to bulletin file and directory entry for to directory file.Y
C0
	IF (REMOTE_SET.GE.3) THEN
	   OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,R
     &		RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') 
	ELSET
	   CALL OPEN_BULLDIR			! Prepare to add dir entry
 K
	   CALL OPEN_BULLFIL			! Prepare to add bulletinN
 N
	   CALL READDIR(0,IER)			! Get NBLOCK
	   IF (IER.EQ.0) NBLOCK = 0		! If new file, NBLOCK is 0
	END IF 
 	
	FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) 
     &		//SAVE_FOLDERR
 /
	IF (.NOT.FROM_REMOTE) 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,L
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,$
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')R
	   END DO
 A
	   IF (IER.EQ.0) THEN
	      DO WHILE (FILE_LOCK(IER,IER1))F
	       OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))
     &	         //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,L
     &	         ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	         FORM='UNFORMATTED')F
	      END DO
	   END IF
	ELSEL
	   IER= 0
	END IFR
 
	IF (REMOTE_SET.GE.3) THEN
	   SAVE_HEADER = HEADER
	   IF (CLI$PRESENT('HEADER')) THENN
	      HEADER = .TRUE.
	   ELSE
	      HEADER = .FALSE.o
	   END IF
	END IF
 
	IF (MERGE) CALL INITIALIZE_MERGE(IER)
 
	START_BULL_POINT = BULL_POINT
 (
	IF (IER.EQ.0) THENF
	   IF (FROM_REMOTE) THEN 
	      READ (12,KEYID=0,KEY=0,IOSTAT=IER),
	   ELSE
	      READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER)
	   END IF
	END IFS
 O
	DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0)
	   READ (12,IOSTAT=IER) BULLDIR_ENTRY
	   NUM_COPY = NUM_COPY - 1S
  
	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	   CALL CONVERT_ENTRY_FROMBIN
 T
	   IF (REMOTE_SET.GE.3) SYSTEM = 0B
 T
	   IF (FROM_REMOTE.EQ.3) THEN
	      SYSTEM = 0o
	      IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN
	         IF (FOLDER_BBEXPIRE.GT.0) THEN
	            CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
	         ELSE
	            CALL GET_EXDATE(EXDATE,14)
		 END IF 
	      END IF 
	   END IF
 T
	   IF (.NOT.BTEST(FOLDER_FLAG,2).OR.	! Not system folder?
     &		 .NOT.SETPRV_PRIV()) THEN	! Or no privileges?A
	      SYSTEM = IBCLR(SYSTEM,0)		! Remove system bit
	   END IF
 N
	   IF (BTEST(SYSTEM,2).AND.		! Shutdown message?L
     &	    (.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'',E
     &				'' shutdown message.'')') 
	      IF (FOLDER_BBEXPIRE.GT.0) THENe
	         CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)L
	         WRITE (6,'('' Expiration will be '',I,'' days.'')')G
     &				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)R
	      CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) 
	      EXTIME = '00:00:00.00' 
	   END IF
 I
	   IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN	! If not /ORIGINAL 
	      FROM = USERNAME			! Specify owner
	   END IF
 g
	   IF (REMOTE_SET.EQ.1) THENL
	      WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2I
	      IF (IER.NE.0) CALL ERROR_AND_EXIT
	   ELSE IF (REMOTE_SET.GE.3) 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)o
	      END IF
	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
	         POST_SUBJECT = INPUT(7:ILEN)
	      ELSEN
	         POST_SUBJECT = DESCRIP
	         IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)E
	      END IFa
  
	      DO WHILE (ILEN.GT.0)		! Copy bulletin into file
	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)R
	         IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)
	      END DO 
 A
	      REWIND (UNIT=3)
 T
	      CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT)4
	   END IF
  
	   IF (REMOTE_SET.LT.3) THENI
	      IF (MERGE) CALL ADD_MERGE_TO(IER)
 A
	      IF (IER.EQ.0) THEN 
	         NBLOCK = NBLOCK + 1 
 I
	         DO I=BLOCK,BLOCK+LENGTH-1 
	            READ (11'I,IOSTAT=IER) INPUT(:128) 
	            IF (IER.EQ.0) THENI
		       CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128))T
	            END IF 
	            NBLOCK = NBLOCK + 1
	         END DO
	      END IF(
 E
	      IF (IER.EQ.0) THENI
	         IF (MERGE) THEN_
		    CALL ADD_MERGE_FROM(IER)
	         ELSE IF (FROM_REMOTE) THEN
	            CALL ADD_ENTRYT
	         ELSE
	            CALL ADD_ENTRY	! Add the new directory entry+
	         END IF
	         BULL_POINT = BULL_POINT + 1R
	      END IFE
	   END IF
	END DOE
 I
	IF (REMOTE_SET.GE.3) CLOSE (UNIT=3)
 '
	IF (MERGE) CALL ADD_MERGE_REST(IER)
 g
	IF (REMOTE_SET.LT.3) CALL CLOSE_BULLFIL
 1
	CLOSE (UNIT=11)
 =
	CLOSE (UNIT=12)
 E
	IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND.REMOTE_SET.LT.3) THEN
	   DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &			       F_NEWEST_BTIM)
	   CALL UPDATE_FOLDER			! Update folder infoE
CI
C  If user is adding message, an no new messages, update last read time forE
C  folder, so user is not alerted of new message which is owned by user.
C 
	   IF (DIFF.GE.0) THENE
	      LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)E
	      LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2) 
	   END IF
	END IFT
 
	IF (REMOTE_SET.LT.3) CALL CLOSE_BULLDIR	! Totally finished with add
 
	IF (IER.EQ.0) THENB
	   WRITE (6,'('' Successful copy to folder '',A)').
     &		FOLDER(:TRIM(FOLDER))//'.'
	   IF (MERGE) THEN	
	      CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// 
     &		  '.BULLDIR;-1')
	   END IF
	ELSE IF (MERGE) THENN
	   WRITE (6,'('' ERROR: Copy aborted. No files copied.'')')
	ELSE 
	   WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')I
     &			BULL_POINT - START_BULL_POINT
	END IFl
 '
	IF (REMOTE_SET.LT.3) HEADER = SAVE_HEADER
 T
	FOLDER_NUMBER = SAVE_FOLDER_NUMBER 
	FOLDER1 = SAVE_FOLDER
	CALL SELECT_FOLDER(.FALSE.,IER1)
  
	BULL_POINT = SAVE_BULL_POINT_
 D
	IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN_
	   IF (FROM_REMOTE.AND.ALL) THENE
	      WRITE (6,'('' WARNING: Original messages not deleted.'')') 
	      WRITE (6,'('' Multiple deletions not possible for '',
     &			''remote folders.'')')O
	   ELSE
	      IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
	      CALL DELETE_MSG
	   END IF
	END IFD
 L
	RETURN
	END
 I
 (
 (
 E
	SUBROUTINE PRINTw
Ce
C  SUBROUTINE PRINT 
CL
C  FUNCTION:  Print header to queue.
Cv
 d
	IMPLICIT INTEGER (A-Z)T
  
	INCLUDE '($SJCDEF)'
 S
	INCLUDE 'BULLDIR.INC'
 .
	INCLUDE 'BULLFOLDER.INC'N
 O
	COMMON /POINT/ BULL_POINT
 _
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 E
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 M
	EXTERNAL CLI$_ABSENT 
  
	CHARACTER*32 QUEUE1
 .
	INTEGER*2 FILE_ID(14)
	INTEGER*2 IOSB(4)
	EQUIVALENCE (IOSB(1),JBC_ERROR)
 '
        CHARACTER*31 FORM_NAME
 =
	PARAMETER FF = CHAR(12)
  
	IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
	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_NBULLD
	ELSE IF (CLI$PRESENT('ALL')) THEN
	   SBULL = 1L
	   EBULL = F_NBULLE
	   IER = 0 
	ELSE IF (BULL_POINT.EQ.0) THEN	! No.  Have we just read a bulletin?
	   WRITE(6,1010)		! No, then error.
	   RETURN
	ELSE 
	   SBULL = BULL_POINT
	   EBULL = SBULL 
	   IER = 0e
	END IFI
 R
	IF (SBULL.LE.0.OR.IER.NE.0) THEN=
	   WRITE (6,1015)
	   RETURN
	END IF
  
	CALL DISABLE_PRIVSS
 U
	OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER,
     &		RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')	
  
	CALL ENABLE_PRIVS
 N
	CALL OPEN_BULLDIR_SHAREDR
 	
	CALL OPEN_BULLFIL_SHAREDQ
  
	HEAD = CLI$PRESENT('HEADER')C
 s
	FIRST = .TRUE.
 L
	DO I=SBULL,EBULLD
	   I1 = I
	   CALL READDIR(I,IER)		! Get info for specified messageO
	   IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT)
     &		('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THENL
	      IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1D
	      IF (I1.GT.SBULL) GO TO 100,
	      CLOSE (UNIT=3,STATUS='DELETE')&
	      CALL CLOSE_BULLFILD
	      CALL CLOSE_BULLDIR 
	      RETURNG
	   ELSE IF (REMOTE_SET) THEN'
	      CALL REMOTE_READ_MESSAGE(I,IER1)N
	      IF (IER1.GT.0) THEN
	         CALL DISCONNECT_REMOTE
	      ELSE1
	         CALL GET_REMOTE_MESSAGE(IER1) 
	      END IFS
	      IF (IER1.NE.0) GO TO 100 
	   END IF
 E
	   IF (.NOT.FIRST) THEN
	      WRITE (3,'(A)') FF&
	   ELSE
	      FIRST = .FALSE.
	   END IF
  
	   ILEN = LINE_LENGTH + 1
 E
	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)H
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENN
	      IF (HEAD) THEN.
		 WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)
		 END IF
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	   ELSE IF (HEAD) THEN(
	      WRITE(3,1060) FROM,DATE//' '//TIME(:8)E
	   END IF
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN 
	      IF (HEAD) WRITE(3,1050) INPUT(7:ILEN)
	   ELSE
	      IF (HEAD) WRITE(3,1050) DESCRIP
	      IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
	   END IF
 O
	   DO WHILE (ILEN.GT.0)		! Copy bulletin into fileM
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)T
	   END DO
	END DOS
 E
100	CLOSE (UNIT=3)			! Bulletin copy completed
 Q
	CALL CLOSE_BULLFILF
	CALL CLOSE_BULLDIR0
 H
	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION,
     &		%LOC('SYS$LOGIN:BULL.LIS'))
  
	IER = CLI$GET_VALUE('QUEUE',QUEUE,ILEN) 	! Get queue name
	IF (ILEN.EQ.0) THEN
	   QUEUE = 'SYS$PRINT'V
	   ILEN = 9
	END IFr
 l
	CALL ADD_2_ITMLST(ILEN,SJC$_QUEUE,%LOC(QUEUE)) 
	CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0)
 T
	IF (CLI$PRESENT('NOTIFY')) THEN
	   CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0)
	END IFy
 m
	IF (CLI$PRESENT('FORM')) THEN
	   IER = CLI$GET_VALUE('FORM',FORM_NAME,FORM_NAME_LEN)Y
	   CALL ADD_2_ITMLST(FORM_NAME_LEN,SJC$_FORM_NAME,%LOC(FORM_NAME))e
	END IFd
 E
	CALL DISABLE_PRIVSw
 e
	CALL END_ITMLST(SJC_ITMLST)
	B
	IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)E
	IF (IER.AND.(.NOT.JBC_ERROR)) THENn
	   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;')
	END IF 
  
	CALL ENABLE_PRIVS			! Reset SYSPRV privileges
 ,
	RETURN 
 m
900	CALL ERRSNS(IDUMMY,IER)R
	CALL ENABLE_PRIVS			! Reset SYSPRV privileges
	WRITE(6,1000)
	CALL SYS_GETMSG(IER)L
	RETURNF
 E
1000	FORMAT(' ERROR: Unable to open temporary file
     & SYS$LOGIN:BULL.LIS for printing.')s
1010	FORMAT(' ERROR: You have not read any message.')I
1015	FORMAT(' ERROR: Specified message number has incorrect format.')1
1030	FORMAT(' ERROR: Following bulletin was not found: ',I)T
1050	FORMAT('Description: ',A,/)
1060	FORMAT('From: ',A,/,'Date: ',A)
  
	END
  
  
 I
 A
	SUBROUTINE READ_MSG(READ_COUNT,BULL_READ)
C 
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 file_
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.
C 
	IMPLICIT INTEGER (A - Z)T
 I
	COMMON /POINT/ BULL_POINT
 O
	INCLUDE 'BULLDIR.INC'
  
	INCLUDE 'BULLFOLDER.INC',
 )
	INCLUDE 'BULLUSER.INC'E
 I
	COMMON /READIT/ READITI
 .
	COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGINGT
	LOGICAL PAGINGL
 T
	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD
 )
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 U
	COMMON /READ_DISPLAY/ LINE_OFFSET
 L
	COMMON /TAGS/ BULL_TAG,READ_TAG
 T
	COMMON /HEADER/ HEADERF
 E
	COMMON /NEXT/ NEXT
	LOGICAL NEXT /.FALSE./D
 R
	DATA SCRATCH_B1/0/ 
  
	CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH)
	CHARACTER SAVE_MSG_KEY*8,PREV_MSG_KEY*8,HEADLINE*132 
 '
	LOGICAL SINCE,PAGE1
  
	EXTERNAL CLI$_NEGATED
 )
	CALL LIB$ERASE_PAGE(1,1)		! Clear screenK
	END = 0					! Nothing outputted on screen
  
	IF (READ_COUNT.GT.0) GO TO 100		! Skip init steps if this is 
						! not first page of bulletin
 (
	SINCE = .FALSE.
	PAGE = .TRUE.
 O
	IF (.NOT.PAGING) PAGE = .FALSE.
	IF (INCMD(:4).EQ.'READ') THEN		! If READ command...
	 IF (CLI$PRESENT('HEADER')) THENd
	    HEADER = .TRUE.
	 ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN
	    HEADER = .FALSE.N
	 END IF
	 IF (CLI$PRESENT('MARKED')) THENS
	    CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)g
	    IF (IER.NE.0) THENA
	       WRITE (6,'('' ERROR: No marked messages found.'')')
	       RETURN
	    ELSE.
	       READ_TAG = .TRUE..
	    END IF 
	 END IF
 A
	 IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE.
	 IF (CLI$PRESENT('SINCE')) THEN		! was /SINCE specified?t
	   IER = CLI$GET_VALUE('SINCE',DATETIME)s
	   IF (DATETIME.EQ.'TODAY') THEN	! TODAY is the default.l
	      IER = SYS$BINTIM('-- 00:00:00.00',TODAY)i
	      CALL GET_MSGKEY(TODAY,MSG_KEY))
 	   ELSE 
	      CALL SYS_BINTIM(DATETIME,MSG_BTIM)W
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
 	   END IF=
	   CALL OPEN_BULLDIR_SHARED
           CALL READDIR_KEYGE(IER)
	   CALL CLOSE_BULLDIR
	 ELSE IF (CLI$PRESENT('NEW')) THEN	! was /NEW specified?T
	    IF (REMOTE_SET.NE.3) THEN
	       DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &			       F_NEWEST_BTIM)
	       IF (DIFF.GE.0) THENF
	          WRITE (6,'('' No new messages are present.'')')
	          RETURNT
	       ELSE
 	          CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &							MSG_KEY)'
	       END IF
	       CALL OPEN_BULLDIR_SHARED
               CALL READDIR_KEYGE(IER)
	       CALL CLOSE_BULLDIR
	    ELSE
	       CALL NEWS_GET_NEWEST_MESSAGE(IER)E
	       IF (IER.EQ.0) THEN
	          WRITE (6,'('' No new messages are present.'')')
	          RETURNR
	       END IF
	    END IF 
	    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.'')')
	      RETURNd
	   ELSE
	      BULL_READ = IER
	      IER = IER + 1
	   END IF
	   SINCE = .TRUE.
	 END IF
	END IFN
 F
	NEXT = .FALSE.R
	IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THENN
	   NEXT = .TRUE.N
	ELSE IF (INCMD(:4).EQ.'READ'.AND..NOT.CLI$PRESENT('SINCE')I
     &		 .AND..NOT.CLI$PRESENT('NEW').AND.
     &		 .NOT.CLI$PRESENT('BULLETIN_NUMBER')) THEN
	   NEXT = .TRUE.C
	END IFI
  
	IF (READ_TAG) THENO
	 IF (INCMD(:4).EQ.'BACK') THEN
	   SAVE_MSG_KEY = MSG_KEY
	   MSG_KEY = BULLDIR_HEADER
	   I = 0R
	   IER = 0M
	   CALL OPEN_BULLDIR_SHARED
	   DO WHILE (IER.EQ.0.AND.MSG_KEY.NE.SAVE_MSG_KEY)T
	      I = I + 1
	      IF (MSG_KEY.NE.SAVE_MSG_KEY) PREV_MSG_KEY = MSG_KEY
	      CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)T
	   END DO
	   IF (IER.EQ.0) THEN
	      MSG_KEY = PREV_MSG_KEYI
	      CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)(
	      IER = BULL_READ + 1
	   ELSE
	      IER = 0
	   END IF
	 ELSE IF (INCMD(:4).EQ.'LAST') THEN
	   CALL OPEN_BULLDIR_SHARED
	   IER = 0 
	   IF (BULL_POINT.EQ.0) CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_READ)
	   DO WHILE (IER.EQ.0)R
	      CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ) 
	   END DO
	   CALL CLOSE_BULLDIR
	   IER = BULL_READ + 1I
	 ELSE IF (NEXT) THENR
	   IF (SINCE) THEN 
	      CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)
	   ELSE
	      IF (BULL_POINT.GT.0) THEN
	         CALL OPEN_BULLDIR_SHARED
	         CALL READDIR(BULL_POINT,IER)
	         CALL CLOSE_BULLDIR
	      ELSEP
	         MSG_KEY = BULLDIR_HEADER
	      END IF
	      CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,BULL_READ)
	   END IF
	   IF (IER.EQ.0) THEN
	      IER = BULL_READ + 1
	   ELSE
	      IER = 0
	   END IF
	 END IF
	END IF.
 E
	IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND.B
     &		INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'))) THENE
	 IF (BULL_READ.GT.0) THEN		! Valid bulletin number?
	   CALL OPEN_BULLDIR_SHARED
	   CALL READDIR(BULL_READ,IER)		! Get bulletin directory entry_
	   IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.EQ.3
     &			.AND.INCMD(:4).EQ.'READ') THEN(
	      IF (CLI$PRESENT('NEW')) THEN
	         NEXT = .TRUE._
	  	 CALL READDIR(BULL_READ,IER)
	      END IFE
	   END IF
	   IF (REMOTE_SET.NE.3.AND.
     &			READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN
	      READ_COUNT = 0,
	      IF (IER.NE.BULL_READ+1) THEN.
	         CALL READDIR(0,IER)N
	         IF (NBULL.GT.0) THEN
	            BULL_READ = NBULL
	            CALL READDIR(BULL_READ,IER)
	         ELSE
		    IER = 0H
	         END IF
	      END IFT
	   ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN
	      CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ)
	      IF (IER1.NE.0) IER = 0)
	   END IF
	   CALL CLOSE_BULLDIR
	 ELSE
	   IER = 0.
	 END IF
	END IFu
  
	NEXT = .FALSE.I
 H
	IF (IER.NE.BULL_READ+1) THEN		! Was bulletin found?
	   IF (REMOTE_SET.NE.3) THEN 
	      WRITE(6,1030)			! If not, then error out
	   ELSE
	      WRITE(6,1040)
	   END IF
	   RETURN
	END IFl
 
	IF (REMOTE_SET.NE.3) THEN
	   DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)):
	   IF (DIFF.GT.0) THEND
	      LAST_READ_BTIM(1,FOLDER_NUMBER+1) = MSG_BTIM(1)
	      LAST_READ_BTIM(2,FOLDER_NUMBER+1) = MSG_BTIM(2)
	   END IF
	ELSEt
	   CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)
	END IFC
 O
	BULL_POINT = BULL_READ			! Update bulletin counterC
 G
	EDIT = .FALSE.Q
 E
	PAGE_WIDTH = REAL_PAGE_WIDTHI
 .
	IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THENN
	   IF (CLI$PRESENT('EDIT')) THENL
	      OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
     &		RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')L
	      IF (IER.NE.0) THEN,
	         CALL ERRSNS(IDUMMY,IER)'
	         CALL SYS_GETMSG(IER)
	         RETURN
	      END IFL
	      EDIT = .TRUE.
	      PAGE_WIDTH = LINE_LENGTHE
	      PAGE = .FALSE.D
	   END IF
	END IFL
 R
	FLEN = TRIM(FOLDER)
	IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT
 E
	IF (REMOTE_SET.EQ.3) THEN
	   WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)')
     &				BULL_POINT,F_START,F_NBULL
	   DO WHILE (INDEX(HEADLINE,'- ').GT.0)
	      I = INDEX(HEADLINE,'- ')S
	      HEADLINE(I+1:) = HEADLINE(I+2:)
	   END DO
	ELSEI
	   WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULLl
	END IF
	DO WHILE (INDEX(HEADLINE,'  ').LT.TRIM(HEADLINE))
	   I = INDEX(HEADLINE,'  ')
	   HEADLINE(I:) = HEADLINE(I+1:)_
	END DOR
	I = TRIM(HEADLINE)0
	HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE))
	HEADLINE(REAL_PAGE_WIDTH-LEN(FOLDER):) = FOLDER(:FLEN)(
	IF (READIT.GT.0) THEN
	   WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE))m
	ELSE IF (EDIT) THEN
	   WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE))
	ELSEe
	   WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))n
	END IF
 0
	END = 1					! Outputted 1 line to screen
 
	IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN 
	   IF (REMOTE_SET.NE.3) THENN
	      INPUT = 'Date:   '//DATE//' '//TIME(:5)//'   (DELETED)'
           ELSEo
	      INPUT = 'Date:   '//DATE//' '//TIME(:5)
	   END IF
	ELSE IF ((SYSTEM.AND.4).EQ.4) THEN	! Is entry shutdown bulletin?d
	   INPUT = 'Date:   '//DATE//' '//TIME(:5)//'   Expires on shutdown'h
	ELSE IF ((SYSTEM.AND.2).EQ.2) THEN	! Is entry permanent bulletin?
	   INPUT = 'Date:   '//DATE//' '//TIME(:5)//'   Permanent'P
	ELSEN
	   INPUT = 'Date:   '//DATE//' '//TIME(:5)//
     &				'   Expires:   '//EXDATE//' '//EXTIME(:5)I
	END IF
	IF ((SYSTEM.AND.1).EQ.1) THEN		! System bulletin?
	   INPUT = INPUT(:TRIM(INPUT))//' / System'
	END IFN
	IF (EDIT) THENN
	   WRITE (3,'(A)') INPUT(:TRIM(INPUT))A
	ELSE1
	   WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT))
	END IFT
 N
	END = END + 1
 A
	CALL OPEN_BULLFIL_SHARED		! Get bulletin file
	LINE_OFFSET = 0
	CHAR_OFFSET = 0
	ILEN = LINE_LENGTH + 1/
	CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
	   INPUT = 'From:   '//INPUT(7:)S
	   DO WHILE (TRIM(INPUT).GT.0)L
	      I = MIN(PAGE_WIDTH,TRIM(INPUT))
	      IF (EDIT) THEN
		 WRITE(3,'(A)') INPUT(:I)	
	      ELSEe
	         WRITE(6,'(1X,A)') INPUT(:I) 
	      END IF 
	      INPUT = INPUT(I+1:)
	      END = END + 1
	   END DO
	   LINE_OFFSET = 1o
	ELSEt
	   IF (EDIT) THEN
	      WRITE(3,'(''From:   '',A)') FROMG
	   ELSE
	      WRITE(6,'('' From:   '',A)') FROM
	   END IF
	   END = END + 1R
	END IFA
	IF (INPUT(:6).NE.'Subj: ') THEN
	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E
	END IFH
	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)6
	      I = MIN(PAGE_WIDTH,TRIM(INPUT))
	      IF (EDIT) THEN 
		 WRITE(3,'(A)') INPUT(:I).
	      ELSEE
	         WRITE(6,'(1X,A)') INPUT(:I)E
	      END IFA
	      INPUT = INPUT(I+1:)
	      END = END + 1
	   END DO
	   LINE_OFFSET = LINE_OFFSET + 1(
	   IF (EDIT) WRITE(3,'(1X)')E
	ELSE.
	   END = END + 1A
	   IF (EDIT) THEN
	      WRITE(3,'(''Subj:   '',A)') DESCRIP
	      WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP)
	   ELSE
	      WRITE(6,'('' Subj:   '',A)') DESCRIP
	      IF (LINE_OFFSET.EQ.1) THEN_
	         CHAR_OFFSET = 1 - PAGE_WIDTH
	         LINE_OFFSET = 2E
	      END IF)
	   END IF
	END IFD
	IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1N
	CALL CLOSE_BULLFIL			! End of bulletin file read 
  
	IF (EDIT) GO TO 200
 R
	WRITE(6,'(1X)')
 B
	IF (READIT.GT.0) WRITE(6,'(1X)')I
	END = END + 1
CF
C  Each page of the bulletin is buffered into temporary memory storage before 
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. 
CR
 R
	IF (SCRATCH_B1.NE.0) THEN		! Is queue empty?D
	   SCRATCH_B = SCRATCH_B1		! No, set queue pointer to headE
	ELSE					! Else if queue is empty
	   CALL INIT_QUEUE(SCRATCH_B,INPUT)
	   SCRATCH_B1 = SCRATCH_B		! Init header pointer 
	END IFD
 I
	READ_ALREADY = 0			! Number of lines already read
						! from record.
	IF (READ_COUNT.EQ.-2) THEN		! Just output header first read
	   READ_COUNT = BLOCK
	   RETURN
	ELSEM
	   READ_COUNT = BLOCK			! Init bulletin record counter.
	END IFC
 P
	GO TO 200
 N
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 
 U
	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header
 _
200	DISPLAY = 0I
	IF (READIT.GT.0) END = END - 2		! /READ can output 2 more lines
 I
	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.
	   ELSE IF (ILEN.GT.0) THEN
	      IF (EDIT) THEN_
	         WRITE(3,'(A)') INPUT(:ILEN)O
	      ELSE IF (CHAR_OFFSET.EQ.0) THEN
		 LEN_TEMP = ILEN
		 CALL CONVERT_TABS(INPUT,LEN_TEMP)
		 IF (LEN_TEMP.GT.PAGE_WIDTH) THENI
		    CHAR_OFFSET = 1R
		    BUFFER = INPUT(:PAGE_WIDTH) 
	            CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) 
		 ELSEL
	            CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)
		 END IFD
	      ELSE,
		 CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTHE
		 IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEND
		    BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP)
	            CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)=
		    CHAR_OFFSET = 0E
		 ELSEI
		    BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1)
	            CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)T
		 END IF(
	      END IF)
	      DISPLAY = DISPLAY + 1
	      IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN
		 MORE_LINES = .FALSE._
	      END IFt
	   END IF
	END DOn
 _
	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 counterN
	   RETURN
	END IFN
 Q
C.
C  Bulletin page is now in temporary memory, so output to terminal.N
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 theI
C  end of the previous page.  The output gets confused and thinks it mustS
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.
CX
  
	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 DOO
 R
	IF (ILEN.EQ.0) THEN			! End of message?
	   READ_COUNT = 0			! init bulletin record counterE
	ELSE	! Possibly end of message since end of page could be last line
	   CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)e
	   IF (IREC.EQ.0) THEN			! Last record?
	      CALL TEST_MORE_LINES(ILEN)	! More lines to read?E
	      IF (ILEN.GT.0) THEN		! Yes, there are still moreE
	         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 IFL
	   ELSE IF (READIT.EQ.0) THEN		! Not last record so
	      WRITE(6,1070)			! say there is more of bulletin
	   END IF
	END IF
  
	RETURNE
 I
1030	FORMAT(' No more messages.')B
1040	FORMAT(' Message not found.')
1070	FORMAT(1X,/,' Press RETURN for more...',/) 
 A
2000	FORMAT(A)
 '
	END
 ,
 )
  
 &
 	
 L
	SUBROUTINE READNEW(REDO) 
CW
C  SUBROUTINE READNEW 
CG
C  FUNCTION: Displays new non-system bulletins with prompts between bulletins.
C 
  
	IMPLICIT INTEGER (A-Z)A
 N
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 A
	INCLUDE 'BULLUSER.INC'I
 )
	INCLUDE 'BULLDIR.INC'
  
	INCLUDE 'BULLFOLDER.INC'L
 (
	COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2)
 /
	COMMON /POINT/ BULL_POINT
 A
	COMMON /READ_DISPLAY/ LINE_OFFSET
 O
	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
	LOGICAL PAGINGE
 I
	CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*6
  
	DATA LEN_FILE_DEF /0/, INREAD/0/I
 )
	LOGICAL SLOW,SLOW_TERMINAL'
 E
	FIRST_MESSAGE = BULL_POINTD
 
	IF (ICHAR(INREAD).EQ.0) THEN	! If calling READNEW for first time:
	   SLOW = SLOW_TERMINAL()	! Check baud rate of terminal
	END IF				! to avoid gobs of output
 e
	LEN_P = 0			! Tells read subroutine there is 
					! no bulletin parameter
 e
1	WRITE(6,1000)			! Ask if want to read new bulletinsE
 N
	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) THENl
	   INREAD = NUMREAD(:1)
	   IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN 
	      IF (INREAD.EQ.'Q') THEN
	         WRITE (6,'(''+uit'',$)')
	      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 DOU
		 DO I=1,FLONG	! Test for new messages in SYSTEM foldersM
		    IF (NEW_MSG(I).NE.0) RETURN+
		 END DOL
		 CALL EXIT
	      ELSEt
	         WRITE (6,'(''+o'',$)')
	      END IF0
	      RETURN	! If NO, exitC
			! Include QUIT to be consistent with next questionT
	   ELSE
	      CALL LIB$ERASE_PAGE(1,1)U
	   END IF
	END IF(
 S
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 IF+
 
	READ_COUNT = 0				! Initialize display pointer(
 T
5	CALL READ_MSG(READ_COUNT,BULL_POINT+1)	! Read next bulletin 
	FILE_POINT = BULL_POINT
	IF (READ_COUNT.EQ.0) THEN		! Is full bulletin displayed?I
	   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. 
	      BULL_POINT = BULL_POINT + 1
	      GO TO 10)
	   END IF
	   CALL CLOSE_BULLDIR
	END IFE
 E
12	IF (READ_COUNT.EQ.0) THEN		! Prompt user in between
	   WRITE(6,1020)			! full screens or end of bull.
	ELSE 
	   WRITE(6,1030) 
	END IFF
  
	CALL GET_INPUT_NOECHO(INREAD)
	CALL STR$UPCASE(INREAD,INREAD)	! Convert input to upper caseI
 3
	IF (INREAD.EQ.'Q') THEN		! If Q , then QUIT
	   WRITE (6,'(''+Quit'',$)') 
	   RETURN
	ELSE IF (INREAD.EQ.'D') THEN	! If D , then redisplay directoryE
	   WRITE (6,'(''+Dir'',$)')
	   REDO = .TRUE.H
	   RETURN
	ELSE IF (INREAD.EQ.'F') THEN	! If F then copy bulletin to file_
	   WRITE (6,'(''+ '')')		! Move cursor from end of prompt line 
					! to beginning of next line.I
	   IF (LEN_FILE_DEF.EQ.0) THEN)
	      CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)1
	      IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR',
     &			BULL_PARAMETER,CONTEXT)
	      IF (IER) THEN
		 FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'o
		 LEN_FILE_DEF = ILEN + 5
	      ELSEe
	         FILE_DEF = 'SYS$LOGIN:'e
	         LEN_FILE_DEF = 10 
	      END IFl
	   END IF
  
	   LEN_FOLDER = TRIM(FOLDER)t
	   CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, 
     &		'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'	
	      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) THENt
		 BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// 
     &				BULL_PARAMETER(:LEN_P)
		 LEN_P = LEN_P + LEN_FILE_DEFn
	      END IF
	   END IF
 
	   BLOCK_SAVE = BLOCK
	   LENGTH_SAVE = LENGTH
	   CALL OPEN_BULLDIR_SHARED
	   CALL OPEN_BULLFIL_SHARED		! Open BULLETIN file
	   CALL READDIR(FILE_POINT,IER)
	   CALL DISABLE_PRIVS
	   OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,d
     &	      RECL=LINE_LENGTH,ERR=18,STATUS='UNKNOWN',
     &	      CARRIAGECONTROL='LIST',ACCESS='APPEND')
	   WRITE(3,1050) DESCRIP		! Output bulletin header info
	   WRITE(3,1060) FROM,DATE//' '//TIME(:5)
	   ILEN = LINE_LENGTH + 1
	   DO WHILE (ILEN.GT.0)
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      IF (ILEN.GT.0) WRITE(3,'(A)') INPUT(:TRIM(INPUT))
	   END DO
	   IF (ILEN.EQ.0) WRITE(6,1040) BULL_PARAMETER(:LEN_P) 
						! Show name of file created.
18	   IF (IER.NE.0) THEN
	      CALL ERRSNS(IDUMMY,IER)
	      CALL SYS_GETMSG(IER) 
	   END IF
	   CLOSE (UNIT=3)			! Bulletin copy completed
	   IF (READ_COUNT.GT.0) THEN		! Reposition GET_BULL routine
	      ILEN = LINE_LENGTH + 1		! in case read in progressW
	      DO I=1,LINE_OFFSET		! and partial block was read.
	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)(
	      END DO,
	   END IF
	   CALL CLOSE_BULLFIL
	   CALL CLOSE_BULLDIR
	   LENGTH = LENGTH_SAVE
	   BLOCK = BLOCK_SAVE
	   CALL ENABLE_PRIVS			! Reset BYPASS privilegesC
	   GO TO 12
	ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THENB
				! 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 bulletin(
	      CALL CLOSE_BULLDIR		! ExitA
	      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 bulletinsB
	   END IF
	   CALL CLOSE_BULLDIR
	ELSE IF (INREAD.EQ.'R') THEN 
	   WRITE (6,'(''+Read'')')l
	   WRITE (6,'('' Enter message number: '',$)').
	   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 12
	   ELSE
	      GO TO 3
	   END IF
	ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN 
	   WRITE(6,1010)h
	   RETURN
	END IF 
	IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2
	GO TO 5
 s
1000	FORMAT(' Read messages? Type N(No),E(Exit),messagee
     & number, or any other key for yes: ',$)!
1010	FORMAT(' No more messages.')R
1020	FORMAT(1X,<PAGE_WIDTH>('-'),/,' Type Q(Quit),
     & F(File it), D(Dir), R(Read msg #) or other for next message: ',$)
1030	FORMAT(1X,<PAGE_WIDTH>('-'),/,' Type Q(Quit), F(File), N(Next),
     & D(Dir), R(Read msg #) or other for MORE: ',$)
1040	FORMAT(' Message written to ',A)o
1050	FORMAT(/,'Description: ',A53)
1060	FORMAT('From: ',A12,' Date: ',A20,/)b
 e
	END
 s
  
 c
 n
	SUBROUTINE SET_DEFAULT_EXPIRE
CA
C  SUBROUTINE SET_DEFAULT_EXPIRE
CC
C  FUNCTION: Sets default expiration date.
C 
	IMPLICIT INTEGER (A-Z)(
 N
	INCLUDE 'BULLFOLDER.INC' 
  
	INCLUDE 'BULLUSER.INC'e
 t
	CHARACTER EXPIRE*3
  
	IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENu
	   IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) 
	   IF (EX_LEN.GT.3) EX_LEN = 3r
	   READ (EXPIRE,'(I<EX_LEN>)') TEMP
 I
	   CALL OPEN_BULLFOLDER		! Open folder file
	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)l
	   IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THENo
	      WRITE (6,'('' ERROR: Expiration cannot be > '',
     &			I3,'' days.'')') BBEXPIRE_LIMIT
	   ELSE IF (TEMP.LT.-1) THEN
	      WRITE (6,'('' ERROR: Expiration must be > -1.'')')W
	   ELSE
	      FOLDER_BBEXPIRE = TEMP:
	      WRITE (6,'('' Default expiration modified.'')')
	   END IF
	   CALL REWRITE_FOLDER_FILE
	   CALL CLOSE_BULLFOLDERU
	ELSEM
	   WRITE (6,'('' You are not authorized to set expiration.'')')
	END IF
 C
	RETURNL
	END
