C
C  BULLETIN11.FOR, Version 5/12/95
C  Purpose: 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 RESET

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	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

	IF (REMOTE_SET.GE.3) THEN
	   IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN
	      WRITE (6,'('' ERROR: NEWS group is not subscribed.'')')
	      RETURN
	   END IF
	END IF

	IF (CLI$PRESENT('CURRENT')) THEN
	   MESSAGE_NUMBER = BULL_POINT
	ELSE IF (.NOT.CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)) THEN
	   MESSAGE_NUMBER = NBULL
	ELSE
	   CALL GET_2_VALS(BULL_PARAMETER,LEN_P,MESSAGE_NUMBER,EBULL,IER)
	   IF (IER.NE.0) THEN
	      WRITE (6,'(A)') 
     &	        ' ERROR: Specified message number has incorrect format.'
	      RETURN
	   END IF
	END IF

	CALL OPEN_BULLDIR_SHARED

	CALL READDIR(MESSAGE_NUMBER,IER)
	IF (IER.EQ.MESSAGE_NUMBER+1		! Was message found?
     &	          .OR.REMOTE_SET.GE.3) THEN	! Ignore if news
	   IF (REMOTE_SET.LT.3) THEN
	      CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)
	   ELSE
	      I = NEWS_FIND_SUBSCRIBE()
	      LAST_NEWS_READ(2,I) = MESSAGE_NUMBER
	      LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-MESSAGE_NUMBER)
     &			.OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)
	   END IF
	ELSE
	   WRITE(6,1030) MESSAGE_NUMBER
	END IF

100	IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER)

	CALL CLOSE_BULLDIR

	RETURN

1010	FORMAT(' ERROR: You have not read any message.')
1030	FORMAT(' ERROR: Message was not found: ',I)

	END



	SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
	DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./

	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

	CHARACTER*12 TAG_KEY

	EXTERNAL CLI$_ABSENT,CLI$_NEGATED

	IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3)
     &	    .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN
	   CALL OPEN_NEW_TAG(IER)
	   IF (.NOT.IER) RETURN
	END IF

	IF (REMOTE_SET.GE.3) THEN
	   IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN
	      WRITE (6,'('' ERROR: NEWS group is not subscribed.'')')
	      RETURN
	   END IF
	END IF

	IF (ADD_OR_DEL.AND.
     &		INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN
	   CALL ADD_TAG(IER,TAG_TYPE)
	   RETURN
	END IF

	IF (INCMD(:4).EQ.'SEEN') THEN
	   IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN
	      READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1),
     &		    IOSTAT=IER)
	      IF (IER.EQ.0) DELETE (UNIT=13)
	      BULL_TAG = IBCLR(BULL_TAG,1)
	      RETURN
	   END IF
	END IF

	IF (.NOT.CLI$PRESENT('NUMBER')) THEN
	   IF (BULL_POINT.EQ.0) THEN	! No.  Have we just read a bulletin?
	      WRITE(6,1010)		! No, then error.
	      RETURN
	   ELSE IF (ADD_OR_DEL) THEN
	      CALL ADD_TAG(IER,TAG_TYPE)
	   ELSE
	      CALL DEL_TAG(IER,TAG_TYPE)
	      IF (IER.NE.0) THEN
		 IF (TAG_TYPE.EQ.1) THEN
		    WRITE (6,'('' ERROR: Message was not marked.'')')
		 ELSE
		    WRITE (6,'('' ERROR: Message was not seen.'')')
		 END IF
	      END IF
	   END IF
	   RETURN
	END IF

	CALL OPEN_BULLDIR_SHARED

	LAST = 0

	DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)
     &	    .NE.%LOC(CLI$_ABSENT)) 		! Get the specified messages

	   CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)

	   IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN
	      WRITE (6,'(A)') 
     &	        ' ERROR: Specified message number has incorrect format.'
	      GO TO 100
	   END IF

	   DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL)

	      CALL READDIR(MESSAGE_NUMBER,IER)
	      IF (IER.NE.MESSAGE_NUMBER+1	! Was message found?
     &	          .AND.REMOTE_SET.LT.3) THEN	! Ignore if news
	         WRITE(6,1030) MESSAGE_NUMBER	! No
		 GO TO 100
	      ELSE IF (ADD_OR_DEL) THEN
	         CALL ADD_TAG(IER,TAG_TYPE)
	         IF (TAG_TYPE.EQ.2.AND.MESSAGE_NUMBER.GT.LAST) THEN
		    IF (REMOTE_SET.LT.3) THEN
	   	       DIFF = COMPARE_BTIM(MSG_BTIM,
     &				LAST_READ_BTIM(1,FOLDER_NUMBER+1))
		       IF (DIFF.GT.0) CALL COPY2(LAST_READ_BTIM
     &		          	(1,FOLDER_NUMBER+1),MSG_BTIM)
		    ELSE
		       CALL NEWS_UPDATE_NEWEST_MESSAGE(MESSAGE_NUMBER)
	            END IF
	            LAST = MESSAGE_NUMBER
	         END IF
	      ELSE
	         CALL DEL_TAG(IER,TAG_TYPE)
	      END IF
	   END DO
	END DO

100	IF (REMOTE_SET.GE.3) CALL READDIR(BULL_POINT,IER)

	CALL CLOSE_BULLDIR

	RETURN

1010	FORMAT(' ERROR: You have not read any message.')
1030	FORMAT(' ERROR: Message was not found: ',I)

	END



	SUBROUTINE ADD_TAG(IER,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($FORIOSDEF)'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	CHARACTER*12 TAG_KEY

	IF (REMOTE_SET.LT.3) THEN
	   IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags
	      WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1)
	      BULL_TAG = IBSET(BULL_TAG,1)
	   END IF
	   WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE)
	ELSE
	   CALL ADD_NEWS_TAG(IER,TAG_TYPE)
	   RETURN
	END IF

	IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN
	   WRITE (6,'('' ERROR: Unable to mark message.'')')
	   CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THEN
	      WRITE (6,'('' IOSTAT error = '',I)') IER
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	ELSE
	   IER = 0
	END IF

	RETURN
	END




	SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	COMMON /NEWS_MARK/ NEWS_MARK
	DIMENSION NEWS_MARK(128)
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
	EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

        COMMON /NEXT/ NEXT

	IER = 36

	SUBNUM = NEWS_FIND_SUBSCRIBE()

	IF (SUBNUM.GT.FOLDER_MAX-1) RETURN

	DO J=1,2
	   IF (BTEST(READ_TAG,J)) I = J
	END DO

	IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN

	INQUIRE (UNIT=2,OPENED=CLOSE_IT)
	CLOSE_IT = .NOT.CLOSE_IT
	IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED

	OLD_NEXT = NEXT

	NEXT = .FALSE.
	J = F_START - 1
	IER1 = J
	DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1)
	   J = J + 1
	   CALL READDIR(J,IER1)
	END DO

	IF (J+1.NE.IER1) THEN
	   NEXT = OLD_NEXT
	   IF (CLOSE_IT) CALL CLOSE_BULLDIR 
	   RETURN
	END IF

	NEXT = .TRUE.

	DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM)
	   TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)),
     &			NEWS_TAG(1,I,SUBNUM))
	   IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST
	   IF (TEST) THEN
	      HEADER = .TRUE.
	      CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM)
	      IF (IER.EQ.0) MESSAGE = MESSNUM
	      NEXT = OLD_NEXT
	      IF (CLOSE_IT) CALL CLOSE_BULLDIR 
	      RETURN
	   END IF
	END DO

	NEXT = OLD_NEXT
	IF (CLOSE_IT) CALL CLOSE_BULLDIR 

	RETURN

	ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE)

	IER = 36

	SUBNUM = NEWS_FIND_SUBSCRIBE()

	IF (SUBNUM.GT.FOLDER_MAX-1) RETURN

	TAG_TYPE = 0

	DO I=1,2
	   IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3))
     &	    .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND.
     &	    (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN
	      TEST = TEST_TAG(MSG_NUM,
     &		%VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM))
	      IF (TEST) THEN
	         IER = 0
	         TAG_TYPE = IBSET(TAG_TYPE,I)
	      END IF
	   END IF
	END DO

	IF (BTEST(READ_TAG,3)) THEN
	   IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.
     &	       (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN
	      IER = 0
	   ELSE
	      IER = 36
	   END IF
	END IF

	RETURN

	ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE)

	IER = 36

	SUBNUM = NEWS_FIND_SUBSCRIBE()

	IF (SUBNUM.GT.FOLDER_MAX-1) RETURN

	HEADER = .FALSE.

	TAG_TYPE = 0

	DO WHILE (IER.NE.0)
	   I = 0
	   DO J=1,2
	      IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN
		 IER = 36
		 MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM)
	   	 DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM))
	     	    TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)),
     &		  	NEWS_TAG(1,J,SUBNUM))
		    IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST
		    IF (TEST) THEN
		       IER = 0
		    ELSE
		       MNUM = MNUM + 1
		    END IF
		 END DO
		 IF (IER.EQ.0) THEN
		    IF (J.EQ.1) THEN
		       MESSAGE = MNUM
		       I = 1
		    ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN
		       MESSAGE = MNUM
		       I = 2
		    END IF
		 END IF
	      END IF
	   END DO
	   IF (I.EQ.0) RETURN
	   CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM)
	   IF (IER.EQ.0) THEN
	      IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I)
	      IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND.
     &		  MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM)) THEN
		 IF (TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)),
     &		  	NEWS_TAG(1,3-I,SUBNUM))) THEN
		    TAG_TYPE = IBSET(TAG_TYPE,3-I)
                 END IF
	      END IF
	      RETURN
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN
	      RETURN
	   END IF
	END DO

	RETURN
	END




	SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

        COMMON /NEXT/ NEXT

	INQUIRE (UNIT=2,OPENED=CLOSE_IT)
	CLOSE_IT = .NOT.CLOSE_IT
	IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED

	IER = 36

	OLD_NEXT = NEXT

	DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0)
	   I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM)
	   DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM))
	      TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)),
     &		  NEWS_TAG(1,J,SUBNUM))
	      IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST
	      IF (TEST) THEN
	         IER = 0
	         MESSNUM = I
	      ELSE
		 I = I + 1
	      END IF
	   END DO
	   IF (IER.EQ.0) THEN
	      SAVE_MESSNUM = MESSNUM
	      NEXT = .FALSE.
	      CALL READDIR(MESSNUM,IER1)
	      IF (IER1.NE.MESSNUM+1) THEN
	         NEXT = .TRUE.
	         CALL READDIR(MESSNUM,IER1)
	      END IF
	      IF (IER1.NE.MESSNUM+1) THEN
		 IER = 36
	         IF (.NOT.BTEST(READ_TAG,3)) THEN
		    CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM)
		 ELSE
		    NEXT = OLD_NEXT
		    IF (CLOSE_IT) CALL CLOSE_BULLDIR
		    RETURN
		 END IF
		 IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN
	      ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN
		 IER = 36
	         IF (.NOT.BTEST(READ_TAG,3)) THEN
		    CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM)
		 END IF
	      END IF
	   ELSE
	      MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1
	   END IF
	END DO

	IF (IER.EQ.0.AND.HEADER) THEN
	   MESSNUM = MESSNUM - 1
	   MSG_NUM = MESSNUM
	END IF

	NEXT = OLD_NEXT

	IF (CLOSE_IT) CALL CLOSE_BULLDIR 

	RETURN
	END




	SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	IER = 0

	SUBNUM = NEWS_FIND_SUBSCRIBE()
	IF (SUBNUM.GT.FOLDER_MAX-1) RETURN

	IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THEN
	   CALL LIB$FREE_VM((NEWS_TAG(2,TAG_TYPE,SUBNUM)-
     &			  NEWS_TAG(1,TAG_TYPE,SUBNUM))/8+1,
     &			  NEWS_TAG(3,TAG_TYPE,SUBNUM))
	   NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL
	   NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0
	END IF

	IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN
	   NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START
	   NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL
	   CALL LIB$GET_VM((F_NBULL-F_START)/8+1,
     &			   NEWS_TAG(3,TAG_TYPE,SUBNUM))
	   CALL ZERO_VM((F_NBULL-F_START)/8+1,
     &			%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)))
	ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN
	   DO I=1,2
	      IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN
	         CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP)
	         CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,
     &			%VAL(TEMP))
	         CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)-
     &			  NEWS_TAG(1,I,SUBNUM))/8+1,
     &			  %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP))
	         CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)-
     &			  NEWS_TAG(1,I,SUBNUM))/8+1,
     &			  NEWS_TAG(3,I,SUBNUM))
	         NEWS_TAG(2,I,SUBNUM) = F_NBULL
	         NEWS_TAG(3,I,SUBNUM) = TEMP
	      END IF
	   END DO
	END IF

	CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
     &		     NEWS_TAG(1,TAG_TYPE,SUBNUM))
	NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1
		 
	RETURN
	END



	SUBROUTINE SET_TAG(NUM,TAGS,START)

	IMPLICIT INTEGER (A-Z)

	DIMENSION TAGS(1)

	I = (NUM-START)/32
	J = NUM - START - I*32

	TAGS(I+1) = IBSET(TAGS(I+1),J)

	RETURN
	END



	SUBROUTINE CLR_TAG(NUM,TAGS,START)

	IMPLICIT INTEGER (A-Z)

	DIMENSION TAGS(1)

	I = (NUM-START)/32
	J = NUM - START - I*32

	TAGS(I+1) = IBCLR(TAGS(I+1),J)

	RETURN
	END



	LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START)

	IMPLICIT INTEGER (A-Z)

	DIMENSION TAGS(1)

	I = (NUM-START)/32
	J = NUM - START - I*32

	TEST_TAG = BTEST(TAGS(I+1),J)

	RETURN
	END



	SUBROUTINE DEL_TAG(IER,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*12 TAG_KEY

	IER = 0

	IF (REMOTE_SET.GE.3) THEN
	   SUBNUM = NEWS_FIND_SUBSCRIBE()
	   CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)
	   RETURN
	END IF

	DO WHILE (REC_LOCK(IER1))
	   READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE),
     &		 IOSTAT=IER1)
	END DO
	IF (IER1.NE.0) RETURN

	DELETE (UNIT=13,IOSTAT=IER1)

	RETURN
	END



	SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR.
     &	   MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG
     &	    (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))
     &	    ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN
	   RETURN
	ELSE
	   NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1
	   CALL CLR_TAG
     &		(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
     &		NEWS_TAG(1,TAG_TYPE,SUBNUM))
	END IF

	RETURN
	END



	SUBROUTINE OPEN_OLD_TAG

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($FORIOSDEF)'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /NEWS_MARK/ NEWS_MARK
	DIMENSION NEWS_MARK(128)
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
	EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)

	CHARACTER*12 BULL_MARK_DIR
	CHARACTER*12 TAG_KEY,INPUT_KEY

	IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)
	IF (IER) THEN
	   BULL_MARK_DIR = 'BULL_MARK:'
	ELSE
	   BULL_MARK_DIR = 'SYS$LOGIN:'
	END IF

	NTRIES = 0

	DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	   OPEN (UNIT=13,FILE=BULL_MARK_DIR//
     &	     USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:12:CHARACTER))
	   NTRIES = NTRIES + 1
	END DO

	IF (IER.EQ.0) THEN
	   BULL_TAG = IBSET(BULL_TAG,0)
	   DO WHILE (REC_LOCK(IER1))
	      READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1)
	   END DO
	   IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1)
	   DO WHILE (REC_LOCK(IER1))
	      READ (13,KEYGE=TAG_KEY('FFFF'X,BULLDIR_HEADER,1),IOSTAT=IER1)
     &		         INPUT_KEY
	   END DO
	   CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)
	   IF (IER1.EQ.0.AND.FOLDER1_NUMBER.EQ.'FFFF'X) THEN
	      MSG_KEY = INPUT_KEY(5:)
	      CALL SYS$ASCTIM(,DATE,MSG_BTIM,)
	      IF (COMPARE_DATE(DATE,' ').LT.-30) THEN
		 DELETE (13)
	         IER1 = 2
	      END IF
	   END IF
	   IF (IER1.NE.0.OR.FOLDER1_NUMBER.NE.'FFFF'X) THEN
	      CLOSE (UNIT=13)           
	      IER1 = 1
              DO WHILE (IER1)
	         IER1 = LIB$DELETE_FILE(
     &			BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))
     &	            	//'.BULLMARK;-1')
	      END DO
	      CALL CONV$PASS_FILES(
     &		BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK',
     &	        BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP')
	      CALL CONV$PASS_OPTIONS()
	      CALL CONV$CONVERT()
	      CALL LIB$RENAME_FILE(
     &		BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK',
     &	      	BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK;1')
	      CALL LIB$RENAME_FILE(
     &		BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARKTMP',
     &	      	BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.BULLMARK')
              CALL LIB$DELETE_FILE(BULL_MARK_DIR//
     &		USERNAME(:TRIM(USERNAME))//'.BULLMARK;-1')
	      DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	         OPEN (UNIT=13,FILE=BULL_MARK_DIR//
     &	    	    USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD',
     &	    	    ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	    	    ORGANIZATION='INDEXED',IOSTAT=IER,
     &	    	    KEY=(1:12:CHARACTER))
	  	 NTRIES = NTRIES + 1
	      END DO
	      CALL SYS_BINTIM('-',MSG_BTIM)
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      WRITE (13,IOSTAT=IER) TAG_KEY('FFFF'X,MSG_KEY,1)
	   ELSE
	      UNLOCK 13
	   END IF
	END IF

	NTRIES = 0

	IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN
	   DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	     OPEN (UNIT=23,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:4:INTEGER))
	      NTRIES = NTRIES + 1
	   END DO

	   IF (IER.EQ.0) THEN
	      IF (BULL_NEWS_TAG) RETURN
	      BULL_NEWS_TAG = .TRUE.
	   END IF

	   DO WHILE (REC_LOCK(IER1))
	      READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK
	   END DO
	   IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),)
	   IF (IER1.NE.0) THEN
	      OPEN (UNIT=24,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	        RECORDSIZE=128,DISPOSE='DELETE',
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:4:INTEGER))
	      DO WHILE (IER.EQ.0)
	         DO WHILE (REC_LOCK(IER))
		    READ (23,IOSTAT=IER) NEWS_MARK
	         END DO
	         IF (IER.EQ.0) THEN
		    I = NEWS_MARK2(1)
		    NEWS_MARK2(1) = NEWS_MARK2(2)
		    NEWS_MARK2(2) = I
	            WRITE (24,IOSTAT=IER) NEWS_MARK
	         END IF
	      END DO
	      NEWS_MARK(1) = 0
	      CALL SYS_BINTIM('-',NEWS_MARK(2))
	      WRITE (24,IOSTAT=IER) NEWS_MARK
	      CLOSE (UNIT=24,DISPOSE='SAVE')
	      CLOSE (UNIT=23,DISPOSE='DELETE')
	      DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	        OPEN (UNIT=23,FILE=BULL_MARK_DIR//
     &	           USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',
     &	           ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	           FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	           KEY=(1:4:INTEGER))
	  	 NTRIES = NTRIES + 1
	      END DO
	   ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN
	      CLOSE (UNIT=23)           
	      IER1 = 1
              DO WHILE (IER1)
	         IER1 = LIB$DELETE_FILE(
     &			BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))
     &	            	//'.NEWSMARK;-1')
	      END DO
	      CALL CONV$PASS_FILES(
     &		BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK',
     &	        BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP')
	      CALL CONV$PASS_OPTIONS()
	      CALL CONV$CONVERT()
	      CALL LIB$RENAME_FILE(
     &		BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK',
     &	      	BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK;1')
	      CALL LIB$RENAME_FILE(
     &		BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARKTMP',
     &	      	BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK')
              CALL LIB$DELETE_FILE(BULL_MARK_DIR//
     &		USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1')
	      DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	        OPEN (UNIT=23,FILE=BULL_MARK_DIR//
     &	           USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',
     &	           ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	           FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	           KEY=(1:4:INTEGER))
	  	 NTRIES = NTRIES + 1
	      END DO
	      DO WHILE (REC_LOCK(IER1))
	         READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK
	      END DO
	      CALL SYS_BINTIM('-',NEWS_MARK(2))
	      REWRITE (23,IOSTAT=IER) NEWS_MARK
	   END IF
	END IF

	IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN
	   WRITE (6,'('' Unable to open mark file.'')')
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THEN
	      WRITE (6,'('' IOSTAT error = '',I)') IER
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	   RETURN
	END IF

	IF (BULL_NEWS_TAG) THEN
	   OLD_NEWS_NUMBER = 0
	   NEWS_MARK(1) = 0
	   FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER
	   CALL OPEN_BULLNEWS_SHARED
	   DO WHILE (IER.EQ.0)
	      DO WHILE (REC_LOCK(IER))
		 READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK
	      END DO
	      IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN
		 IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN
		    NEWS_FOLDER_NUMBER = NEWS_NUMBER
		    SUBNUM = NEWS_FIND_SUBSCRIBE()
		    IF (SUBNUM.GT.FOLDER_MAX-1) THEN
		       DELETE (UNIT=23)
		    ELSE
		       UNLOCK 23
		       OLD_NEWS_NUMBER = NEWS_NUMBER
		       CALL READ_FOLDER_FILE_KEYNUM_TEMP
     &			  (NEWS_FOLDER_NUMBER,IER1)
		       IF (IER1.NE.0) THEN
			  SUBNUM = 0
		       ELSE
			  DO I=1,2
		             NEWS_TAG(1,I,SUBNUM) = F1_START
		             NEWS_TAG(2,I,SUBNUM) = F1_NBULL
		             NEWS_TAG(4,I,SUBNUM) = 0
		             CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1,
     &					  NEWS_TAG(3,I,SUBNUM))
		             CALL ZERO_VM((F1_NBULL-F1_START)/8+1,
     &					%VAL(NEWS_TAG(3,I,SUBNUM)))
			  END DO
		       END IF
		    END IF
		 END IF
		 IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN
	            IF (SUBNUM.EQ.0) THEN
		       DELETE (UNIT=23)
		    ELSE
		       UNLOCK 23
		       IF (NEWS_REC.GT.0) THEN
			  TAG_TYPE = 1
		       ELSE
			  TAG_TYPE = 2
		       END IF
		       IF (NEWS_FORMAT.EQ.0) THEN	! 16 bit numbers
		          DO I=5,256
		             CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM,
     &					   TAG_TYPE)
		          END DO
		       ELSE
		          DO I=3,128
		             CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE)
		          END DO
		       END IF
		    END IF
		 END IF
	      END IF
	   END DO
	   NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE
	   CALL CLOSE_BULLNEWS
	END IF-

	RETURN
	END



	SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE)O

	IMPLICIT INTEGER (A-Z)&

	INCLUDE 'BULLUSER.INC'N

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	IF (NUM.GT.0) THEN 
	   LAST_NUM = NUM
	   IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR.
     &	       NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN
	   CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
     &		NEWS_TAG(1,TAG_TYPE,SUBNUM))
	ELSE IF (NUM.LT.0) THEN
	   IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURND
	   DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1),(
     &		MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM) 
	      CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
     &		NEWS_TAG(1,TAG_TYPE,SUBNUM))
	   END DO
	END IFR

	RETURNS
	END



	SUBROUTINE OPEN_NEW_TAG(IER)U

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'G

	INCLUDE 'BULLFOLDER.INC'N

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /NEWS_MARK/ NEWS_MARKU
	DIMENSION NEWS_MARK(128)E

	CHARACTER*12 BULL_MARK_DIRU

	DIMENSION BTIM(2)
	CHARACTER KEY*8

	IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)
	IF (IER) THEN
	   BULL_MARK_DIR = 'BULL_MARK:'
	ELSE 
	   BULL_MARK_DIR = 'SYS$LOGIN:'
	END IFD

	IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER) 
	IF (.NOT.IER1) THEN
	   IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)
	   CALL DISABLE_PRIVS
	   IER1 = .FALSE.
	END IF
	IF (REMOTE_SET.LT.3) THEN
	   MARKUNIT = 13N
	   OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW', 
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	        RECORDSIZE=3,
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:12:CHARACTER))
	   IF (IER.EQ.0) THEN
	      CALL SYS_BINTIM('-',BTIM)
	      CALL GET_MSGKEY(BTIM,KEY)
	      WRITE (13) TAG_KEY('FFFF'X,KEY,0)
	   END IF
	ELSER
	   MARKUNIT = 23O
	   OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',N
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	        RECORDSIZE=128,
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:4:INTEGER)),
	   IF (IER.EQ.0) THEN
	      NEWS_MARK(1) = 0E
	      CALL SYS_BINTIM('-',NEWS_MARK(2))
	      WRITE (23,IOSTAT=IER) NEWS_MARK
           END IFR
 	END IF
	IF (.NOT.IER1) CALL ENABLE_PRIVS
	IF (IER.NE.0) THEN.
	   WRITE (6,'('' Cannot create mark file.'')')E
	   CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THEND
	      WRITE (6,'('' IOSTAT error = '',I)') IERT
	      IER = 0
	   ELSE
	      CALL SYS_GETMSG(IER1)
	      IER = IER1I
	   END IF
	ELSE)
	   IF (.NOT.IER1) THEN 
	      INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER)
	      WRITE (6,'('' Created MARK file: '',A)')I
     &		BULL_PARAMETER(:TRIM(BULL_PARAMETER))S
	   END IF
	   IF (MARKUNIT.EQ.13) BULL_TAG = 1
	   IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE.
	   IER = 11
	END IF 

	RETURNT
	END



	CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)	

	CHARACTER*(*) MSG_KEY

	IF (TAG_TYPE.EQ.1) THEN
	   CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY))S
	ELSE 
	   CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY))
	END IF 

	CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))D

	RETURN_
	END




	SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE)

	IMPLICIT INTEGER (A-Z)T

	INCLUDE 'BULLDIR.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*12 TAG_KEY,INPUT_KEYN

	CHARACTER*8 NEXT_MSG_KEY.

	IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3)
     &	    .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THEN 
	   CALL OPEN_NEW_TAG(IER)
	   IF (.NOT.IER) RETURN
	END IFO

	IF (REMOTE_SET.GE.3) THEN
	   CALL GET_FIRST_NEWS_TAG(IER,MESSAGE)
	   RETURN
	END IFC

	IF (BTEST(READ_TAG,3)) THEN
	   MSG_NUM = 0
 	   CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY)=
	   IF (IER.EQ.0) THEN
	      MESSAGE = MESSAGE - 1
	      MSG_NUM = MESSAGE
	      MSG_KEY = BULLDIR_HEADERG
	   END IF
	   RETURN
	END IFE

	MSG_KEY = BULLDIR_HEADERN

	HEADER = .TRUE.

	DO J=1,2Y
	   IF (BTEST(READ_TAG,J)) I = J
	END DO_

	CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I)

	RETURNT

	ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)_

	IF (REMOTE_SET.GE.3) THEN
	   CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE)
	   RETURN
	END IFT

	TAG_TYPE = 0N

	DO I=1,2
	   IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN
	      DO WHILE (REC_LOCK(IER))
	         READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I),
     &		   IOSTAT=IER) INPUT_KEY
	      END DOT
	      IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I) 
	   END IF
	END DO,

	IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.N
     &	    (BTEST(READ_TAG,3).AND.
     &	     (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.(
     &	     (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THENW
	   IF (IER.EQ.0) UNLOCK 13 
	   IER = 0E
	   MESSAGE = MSG_NUML
	ELSE
	   IER = 36
	END IFE

	RETURNT

	ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE) 

	MSG_NUM = MSG_NUM - 1

	CALL DECREMENT_MSG_KEY)

	ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)E

	IF (REMOTE_SET.GE.3) THEN
	   MSG_NUM = ABS(MSG_NUM) + 1
	   CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE)
	   RETURN
	END IF_

	IER = 36=

	HEADER = .FALSE.E

	TAG_TYPE = 0T

	IF (BTEST(READ_TAG,3)) THEN
	   CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)T
	   RETURN
	END IFS

	DO WHILE (IER.NE.0)
	   I = 0T
	   DO J=1,2
	      IF (BTEST(READ_TAG,J)) THEN
	         DO WHILE (REC_LOCK(IER))
	            READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),
     &		        IOSTAT=IER) INPUT_KEY=
		 END DO(
		 IF (IER.EQ.0) THENE
	            CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)I
		    IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.
     &		      (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER)))
     &		      IER = 36
		 END IFE
		 IF (IER.EQ.0) THEN
		    IF (J.EQ.1) THEN
		       NEXT_MSG_KEY = INPUT_KEY(5:)'
		       I = 1
		    ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY,
     &			     INPUT_KEY(5:)).GT.0) THENR
		       I = 2
		    END IF
		 END IFI
	      END IF
	   END DO
	   IF (I.EQ.0) RETURN
	   NEXT_MSG_KEY = MSG_KEY
	   CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I)
	   IF (IER.EQ.0) THEN
	      TAG_TYPE = IBSET(TAG_TYPE,I)
	      DO WHILE (REC_LOCK(IER))N
	         READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I),
     &		        IOSTAT=IER) INPUT_KEYU
	      END DOI
	      IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)
	      IER = 0
	      RETURN2
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENT
	      MSG_KEY = NEXT_MSG_KEY 
	      RETURN_
	   ELSE
	      MSG_KEY = NEXT_MSG_KEY
	   END IF
	END DOV

	RETURN(
	END



	SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE)H

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLFOLDER.INC' 

	INCLUDE 'BULLDIR.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	INQUIRE (UNIT=2,OPENED=CLOSE_IT)
	CLOSE_IT = .NOT.CLOSE_IT
	IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDI

	DO MESSAGE = MSG_NUM+1,F_NBULLI
	   CALL READDIR(MESSAGE,IER)I
	   IF (IER.EQ.MESSAGE+1) THEN
	      CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)S
	      IF (IER.EQ.0) THEN)
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIRG
		 RETURN 
	      END IFP
	   END IF
	END DOA

	IER = 36P
	IF (CLOSE_IT) CALL CLOSE_BULLDIRS

	RETURNM
	END



	INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2)

	IMPLICIT INTEGER (A-Z)M

	CHARACTER*8 MSG_KEY1,MSG_KEY2

	DIMENSION BTIM1(2),BTIM2(2)

	CALL GET_MSGBTIM(MSG_KEY1,BTIM1)
	CALL GET_MSGBTIM(MSG_KEY2,BTIM2)O

	COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2)

	RETURNE
	END




	SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J)H

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLDIR.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	CHARACTER*12 TAG_KEY,INPUT_KEY 

	DO WHILE (REC_LOCK(IER))a
	   READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER)o
     &					INPUT_KEY
	END DO

	CLOSE_IT = .FALSE.s

	DO WHILE (FOLDER_NUMBER.GT.0)
	   IF (IER.EQ.0) THEN
	      CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY) 
	      CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER) 
	   END IF

	   IF (IER.EQ.0) THEN
	      IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.C
     &		  (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER)))
     &		  IER = 36
	   END IF
	   IF (IER.NE.0) THEN
	      IER = 1
	      UNLOCK 13
	      IF (CLOSE_IT) CALL CLOSE_BULLDIRM
	      RETURNO
	   ELSE
	      CALL DECREMENT_MSG_KEY3
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      INQUIRE (UNIT=2,OPENED=IER)
	      IF (.NOT.IER) THENo
		 CALL OPEN_BULLDIR_SHAREDT
		 CLOSE_IT = .TRUE.
	      END IFI
	      CALL READDIR_KEYGE(IER)
	      CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))'
	      IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN
	         UNLOCK 13 
		 MESSAGE = MSG_NUM
		 IF (HEADER) THENE
		    MESSAGE = MESSAGE - 1E
		    MSG_NUM = MESSAGEE
		    MSG_KEY = BULLDIR_HEADER
		 END IFf
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIR 
	         RETURN
	      ELSE
		 DELETE (UNIT=13)S
		 IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN
		    IER = 36
		    IF (CLOSE_IT) CALL CLOSE_BULLDIR
		    RETURN
		 END IF 
		 DO WHILE (REC_LOCK(IER))F
	            READ (13,IOSTAT=IER) INPUT_KEYA
	 	 END DO
	      END IFR
	   END IF

	END DOE

	END



	SUBROUTINE CLOSE_TAG 

	IMPLICIT INTEGER (A-Z)M

	INCLUDE 'BULLUSER.INC'_

	COMMON /NEWS_MARK/ NEWS_MARKL
	DIMENSION NEWS_MARK(128).
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECF
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
	EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)_
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)O

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	TAG_OPENED = .FALSE.D

	IF (BULL_NEWS_TAG) THEN
	   DO I=1,FOLDER_MAX-1'
	      DO M=1,2
	         IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THENG
	            IF (.NOT.TAG_OPENED) THEN
		       CALL OPEN_OLD_TAG
		       TAG_OPENED = .TRUE.
		    END IF
		    IF (M.EQ.1) THEN
		       NEWS_REC = 1L
		    ELSE
		       NEWS_REC = -32767
		    END IF
	            NEWS_FORMAT = 0
		    IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1T
		    LIMIT = 256/(NEWS_FORMAT+1)E
	            NEWS_NUMBER = LAST_NEWS_READ2(1,I)(
		    K = 5-NEWS_FORMAT*2T
		    SET_LIST = .FALSE.
		    DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I)
		       IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)),
     &				      NEWS_TAG(1,M,I))) THEN
		          IF (.NOT.SET_LIST) THEN.
		             CALL SET_NEWS_MARK(K,J)
			     LAST_SET = J
			     K = K + 1'
		             SET_LIST = .TRUE.
		          END IF
		       ELSE IF (SET_LIST) THEN
		          IF (LAST_SET.NE.J-1) THEN
			     CALL SET_NEWS_MARK(K,-(J-1))
		             K = K + 1
			  END IFE
		          SET_LIST = .FALSE.
		       END IF$
		       IF (J.EQ.NEWS_TAG(2,M,I)) THENA
		          IF (SET_LIST.AND.LAST_SET.NE.J) THEN
			     CALL SET_NEWS_MARK(K,-J)
		             K = K + 1
		          END IF
		          DO L=K,LIMIT
			     CALL SET_NEWS_MARK(L,0)S
		          END DO
		          K = LIMIT + 1T
		       END IFe
		       IF (K.GT.LIMIT) THENW
		          DO WHILE (REC_LOCK(IER))
		             READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)
		          END DO
		          IF (IER.NE.0) THEN
		             WRITE (23,IOSTAT=IER) NEWS_MARK
		          ELSE
		             REWRITE (23,IOSTAT=IER) NEWS_MARK
		          END IF
		          K = 5-NEWS_FORMAT*2M
		          NEWS_REC = NEWS_REC + 1
		          IF (J.EQ.NEWS_TAG(2,M,I)) THEN
		             DO WHILE (REC_LOCK(IER))L
		                READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)R
			        IF (IER.EQ.0) THENL
			           DELETE (UNIT=23)
				   NEWS_REC = NEWS_REC + 1
				   L = REC_LOCK(IER)
			        END IF 
			     END DO
		          END IF
		       END IFN
		    END DO
	         END IF
	      END DOR
	   END DO
	   CLOSE (UNIT=23)i
	END IFf

	RETURN 
	END


	SUBROUTINE SET_NEWS_MARK(I,J)

	IMPLICIT INTEGER (A-Z),

	COMMON /NEWS_MARK/ NEWS_MARKE
	DIMENSION NEWS_MARK(128)I
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))	
	EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(1),NEWS_REC) 
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)A

	IF (NEWS_FORMAT.EQ.0) THEN 
	   NEWS_MARK2(I) = JN
	ELSEG
	   NEWS_MARK(I) = J
	END IFF

	RETURNT
	END



	SUBROUTINE ZERO_VM(NUM,NEWS_TAG)S

	IMPLICIT INTEGER (A-Z)A

	LOGICAL*1 NEWS_TAG(1)

	DO I=1,NUMD
	   NEWS_TAG(I) = 0L
	END DOB

	RETURN&
	END




	SUBROUTINE FREE_TAGS(ISUB)

        IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'M

	INCLUDE 'BULLUSER.INC'

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
	COMMON /NEWS_MARK/ NEWS_MARKL
	DIMENSION NEWS_MARK(128) 
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECE
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
	EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)s
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)s

	DO I=1,2,
	   IF (NEWS_TAG(3,I,ISUB).GT.0) THENE
	      CALL LIB$FREE_VM(
     &		(NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))I
	      NEWS_TAG(3,I,ISUB) = 0M
	      NEWS_NUMBER = NEWS_FOLDER_NUMBERT
	      NEWS_REC = -32768
	      DO WHILE (REC_LOCK(IER))A
	         READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARKY
	         IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN
		    DELETE (UNIT=23)
		    L = REC_LOCK(IER) 
	         END IF
	      END DO
	      IF (IER.EQ.0) UNLOCK 23
	   END IF

	   DO J=I,FOLDER_MAX-2A
	      CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J))E
	   END DO

	   DO J=1,4
	      NEWS_TAG(J,I,FOLDER_MAX-1) = 0
	   END DO
	END DOO

	RETURNo
	END




	SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)T

	IMPLICIT INTEGER (A-Z)I

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'E

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	CHARACTER*8 PREV_MSG_KEY

	IER = 36E

	IF (REMOTE_SET.GE.3) THEN
	   INQUIRE (UNIT=2,OPENED=CLOSE_IT)
	   CLOSE_IT = .NOT.CLOSE_IT
	   IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED
	   SUBNUM = NEWS_FIND_SUBSCRIBE()
	   DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START)
	      MSG_NUM = MSG_NUM - 1
	      CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE)V
	      IF (IER.EQ.0) THENN
		 TMP_MSG_NUM = MSG_NUM
	         CALL READDIR(TMP_MSG_NUM,IER1)
	         IF (IER1.NE.MSG_NUM+1) THENB
	            IF (.NOT.BTEST(READ_TAG,3)) THENN
		       CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)B
		    END IF
		    IER = 36
	         END IF
	      END IF 
	   END DO
	   BULL_READ = MSG_NUM
	   IF (CLOSE_IT) CALL CLOSE_BULLDIR U
	ELSEI
	   IF (MSG_NUM.EQ.0) RETURN
	   SAVE_MSG_NUM = MSG_NUM
	   PREV_MSG_NUM = MSG_NUM
	   MSG_NUM = 0
	   MSG_KEY = BULLDIR_HEADER
	   IER = 0=
	   DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM).
	      IF (MSG_NUM.GT.0) THEN 
	         PREV_MSG_KEY = MSG_KEY
	         PREV_MSG_NUM = MSG_NUM
	      END IF 
	      CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)D
	   END DO
	   IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN
	      MSG_NUM = PREV_MSG_NUM 
	      MSG_KEY = PREV_MSG_KEYW
	      CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)(
	   ELSE
	      IER = 36N
	   END IF
	END IFT

	RETURN 
	END


	SUBROUTINE DECREMENT_MSG_KEYN

	IMPLICIT INTEGER (A-Z)I

	INCLUDE 'BULLDIR.INC'

	I = 1
	DO WHILE (I.LT.9)
	   ITEST = ICHAR(MSG_KEY(I:I))E
	   IF (ITEST.GT.0) THEN
	      MSG_KEY(I:I) = CHAR(ITEST-1)
	      I = 9
	   ELSE
	      I = I + 1
	   END IF
	END DOR

	RETURNY
	END




	SUBROUTINE SET_GENERIC(GENERIC)
C3
C  SUBROUTINE SET_GENERICU
CR
C  FUNCTION: Enables or disables "GENERIC" display, i.e. displayingI
C	general bulletins continually for a certain amount of days..
C3
	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLUSER.INC' 

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	IF (.NOT.SETPRV_PRIV()) THENR
	   WRITE (6,'( 
     &      '' ERROR: No privs to change GENERIC.'')')
	   RETURN
	END IFT

	IER = CLI$GET_VALUE('USERNAME',TEMP_USER)

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) 

	IF (IER.EQ.0) THEN(
	   IF (GENERIC) THENT
	      IF (CLI$PRESENT('DAYS')) THEN
	         IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER)
	         CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2))
	      ELSEI
		 NEW_FLAG(2) = '   7'P
	      END IF 
	   ELSE
	      NEW_FLAG(2) = 0
	   END IF
	   REWRITE (4) TEMP_USER//USER_ENTRY(13:)
	ELSE.
	   WRITE (6,'('' ERROR: Specified username not found.'')')Y
	END IF,

	CALL CLOSE_BULLUSER

	RETURNE
	END


	SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS)
C
C  SUBROUTINE SET_BRIEF_CONTINUOUS
C1
C  FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying
C	the brief message continually until the new messages have been read.
CT
	IMPLICIT INTEGER (A-Z)A

	INCLUDE 'BULLUSER.INC'N

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(USERNAME,IER)

	IF (BRIEF_CONTINUOUS) THENM
	   NEW_FLAG(2) = -1
	ELSEA
	   NEW_FLAG(2) = 0 
	END IF 

	IF (IER.EQ.0) REWRITE (4) USER_ENTRY)

	CALL CLOSE_BULLUSER

	RETURNV
	END


	SUBROUTINE SET_LOGIN(LOGIN)
C)
C  SUBROUTINE SET_LOGINF
C(
C  FUNCTION: Enables or disables bulletin display at login.K
C
	IMPLICIT INTEGER (A-Z)I

	INCLUDE 'BULLUSER.INC')

	CHARACTER TODAY*24 

	DIMENSION NOLOGIN_BTIM(2)

	CALL SYS$ASCTIM(,TODAY,,)		! Get the present time

	IF (.NOT.SETPRV_PRIV()) THENI
	   WRITE (6,'((
     &      '' ERROR: No privs to change LOGIN.'')')
	   RETURN
	END IF/

	IER = CLI$GET_VALUE('USERNAME',TEMP_USER)

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)N

	CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)R
	IF (IER.EQ.0) THENM
	   IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN
	      CALL SYS_BINTIM(TODAY,LOGIN_BTIM)
	   ELSE IF (.NOT.LOGIN) THEN 
	      LOGIN_BTIM(1) = NOLOGIN_BTIM(1)
	      LOGIN_BTIM(2) = NOLOGIN_BTIM(2)
	   END IF
	   REWRITE (4) TEMP_USER//USER_ENTRY(13:)
	ELSES
	   WRITE (6,'('' ERROR: Specified username not found.'')')1
	END IFL

	CALL CLOSE_BULLUSER

	RETURNE
	END





	SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER)

	IMPLICIT INTEGER (A-Z),

	CHARACTER USERNAME*(*),ACCOUNT*(*)N

	INCLUDE '($UAIDEF)'

	INTEGER*2 UIC(2)E

	CALL INIT_ITMLST)
	CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))
	CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))=
	CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC))
	CALL END_ITMLST(GETUAI_ITMLST)N

	IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)

	USER = UIC(1)
	GROUP = UIC(2)_

	RETURNE
	END



	SUBROUTINE DCLEXH(EXIT_ROUTINE)

	IMPLICIT INTEGER (A-Z)K

	INTEGER*4 EXBLK(4)2

	EXBLK(2) = EXIT_ROUTINE
	EXBLK(3) = 1O
	EXBLK(4) = %LOC(EXBLK(4))

	CALL SYS$DCLEXH(EXBLK(1))

	RETURNE
	END



	SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS)

        IMPLICIT INTEGER (A-Z)

	INCLUDE '($MAILDEF)''

	INCLUDE 'BULLUSER.INC'S

	CHARACTER*(*) FILE,SENDTO,SUBJECT

	EXTERNAL MAIL_ERROR

	CALL SYS$SETAST(%VAL(1)) 

	CALL DISABLE_PRIVSA

        DO WHILE (INDEX(SENDTO,'""').GT.0)
           SENDTO = SENDTO(:INDEX(SENDTO,'""'))//R
     &                   SENDTO(INDEX(SENDTO,'""')+2:)
        END DO

	DO WHILE (INDEX(SUBJECT,'""').GT.0)
	   SUBJECT = SUBJECT(:INDEX(SUBJECT,'""'))// 
     &			 SUBJECT(INDEX(SUBJECT,'""')+2:)S
	END DO	

	C = 0

	CALL LIB$ESTABLISH(MAIL_ERROR)_

	STATUS = MAIL$SEND_BEGIN(C,0,0)
	IF (.NOT.STATUS) GO TO 100

	J = 1
	DO WHILE (J.LE.TRIM(SENDTO))
	   I = INDEX(SENDTO(J:),',') - 1A
	   IF (I.EQ.-1) I = TRIM(SENDTO(J:))'
           CALL INIT_ITMLSTP
           CALL ADD_2_ITMLST(I,MAIL$_SEND_USERNAME,%LOC(SENDTO(J:)))
           CALL END_ITMLST(ADDRESS_ITMLST)

           STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0)D
           IF (.NOT.STATUS) GO TO 100C
	   J = J + I,
	   IF (SENDTO(J:J).EQ.',') J = J + 1M
	END DOG

        CALL INIT_ITMLST
        CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT
     &				,%LOC(SUBJECT)) 
	IF (SETPRV_PRIV()) THEN
	   CALL ENABLE_PRIVS 
	   CALL ADD_2_ITMLST 
     &		   (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME)) 
	   CALL DISABLE_PRIVS
	END IF 
        CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO))E
        CALL END_ITMLST(ATTRIBUTE_ITMLST)O

        STATUS = MAIL$SEND_ADD_ATTRIBUTE(C,%VAL(ATTRIBUTE_ITMLST),0)
        IF (.NOT.STATUS) GO TO 100
                                        
        CALL INIT_ITMLST
        CALL ADD_2_ITMLST(TRIM(FILE),MAIL$_SEND_FILENAME,%LOC(FILE))
        CALL END_ITMLST(BODYPART_ITMLST)

        STATUS = MAIL$SEND_ADD_BODYPART(C,%VAL(BODYPART_ITMLST),0)
        IF (.NOT.STATUS) GO TO 100

        STATUS = MAIL$SEND_MESSAGE(C,0,0)N
        IF (.NOT.STATUS) GO TO 100

        STATUS = MAIL$SEND_END(C,0,0)(
        IF (.NOT.STATUS) GO TO 100

100	CALL ENABLE_PRIVS_
	CALL LIB$REVERT

        RETURN
        ENDN



	FUNCTION MAIL_ERROR(SIGARGS,MECHARGS)

	MAIL_ERROR = .TRUE.

	CALL SYS$PUTMSG(SIGARGS,,)3

	RETURNM
	END




        SUBROUTINE SET_NEWSM

        IMPLICIT INTEGER (A-Z)

        INCLUDE '($SSDEF)'

        INCLUDE 'BULLUSER.INC'

        INCLUDE 'BULLFOLDER.INC'

        INCLUDE 'BULLFILES.INC'I

        COMMON /BULLPAR/ BULL_PARAMETER,LEN_PN
        CHARACTER*64 BULL_PARAMETER 
	 
	EXTERNAL CLI$_NEGATED,CLI$_ABSENT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /NEXT/ NEXTY

	COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE(
	CHARACTER*80 BULLNEWSDIR_FILE

	DIMENSION EXPIRED(2)R

	CHARACTER GROUP*44,FOLDER_SAVE*44,NEW_NEWS_ACCESS*132
	CHARACTER NEWS_ACCESS*132

	IF (.NOT.SETPRV_PRIV()) THENS
	   WRITE (6,'('' ERROR: No privs to change NEWS.'')')
	   RETURN
	END IF 

	ENTRY SHOW_NEWS

	LIMIT = -2L
	IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN
	   IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1))R
	   IF (.NOT.IER.OR.LIMIT.LT.-1) THEN_
	      WRITE (6,'('' ERROR: Invalid value for LIMIT.'')')E
	      RETURN 
	   END IF   R
	END IF	

        EXPIRE = -1=
        IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN
           IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1))T
	   IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN
	      WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')')
	      RETURN3
	   END IF   
        END IF

	IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR.L
     &		CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN 
	   WRITE (6,'('' ERROR: You have not selected a news group.'')') 
           RETURN 
        END IF

	CALL OPEN_BULLNEWS_SHARED	! Open folder fileU

	IF (CLI$PRESENT('DEFAULT')) THEN_
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)_
	ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THENM
	   BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.'
	   CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER)
	   LEN_P = LEN_P + 1I
	   IF (LEN_P.GT.LEN(FOLDER)) THEN
	      WRITE (6,'('' ERROR: Class name too long.'')') 
	      CALL CLOSE_BULLNEWS
	      RETURN3
	   END IF
	   GROUP = BULL_PARAMETER(:LEN_P)
           LG = LEN_P	
	   CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P),
     &					NEWCLASS)
	   IF (CLI$PRESENT('DELETE')) THENs
	      IF (NEWCLASS.NE.0) THEN
	         WRITE (6,'('' ERROR: Class not found.'')')
	      ELSE 
	         DELETE (7)
		 WRITE (6,'('' Class deleted.'')')
	      END IF	
              IF (BTEST(FOLDER1_FLAG,0)) THENN
		 OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),
     &					STATUS='OLD',IOSTAT=IER)I
	     	 CLOSE (UNIT=3,DISPOSE='DELETE')F
              END IF
	      RETURNL
	   ELSE IF (NEWCLASS.NE.0) THEN
              CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)I
              DO WHILE (IER.EQ.0)'
                 DO WHILE (REC_LOCK(IER))T
                    READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER) 
                 END DOA
                 IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1
              END DO
	      FOLDER1_FLAG = NEWS_FLAG_DEFAULTM
	      FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULTS
              F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULTU
 	      CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED)S
              CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) 
	      CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED)
              CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE)R
	      FOLDER1_NUMBER = NEWS_F1_COUNTW
	      FOLDER1 = BULL_PARAMETERA
 	      FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)U
	      CALL WRITE_FOLDER_FILE_TEMP(IER),
	      IF (IER.NE.0) THENC
		 CALL CLOSE_BULLNEWS
		 WRITE (6,'('' Unable to add entry.'')')
                 RETURN 
	      END IF	      
	      TEMP = FOLDER1_NUMBER
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)
	      NEWS_F1_COUNT = TEMPI
	      REWRITE (7) NEWS_FOLDER1_COMT
 	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER) 
	   END IF	I
 	ELSE
	   IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.
     &				%LOC(CLI$_ABSENT)) FOLDER1 = FOLDERA
	   IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1)
       	   CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR: Invalid news group.'')')
	      CALL CLOSE_BULLNEWS
	      RETURN/
	   END IF
	END IFN

 	IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = EXPIRE
	IF (LIMIT.GE.-1) F1_EXPIRE_LIMIT = LIMIT'

	CLASS = CLI$PRESENT('CLASS')C
	DEFAULT = CLI$PRESENT('DEFAULT')F
	ALL = CLI$PRESENT('ALL')E
 	IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE.
	DISABLE = CLI$PRESENT('DISABLE')_
      	ENABLE = CLI$PRESENT('ENABLE')Y
     	PRIVATE = CLI$PRESENT('PRIVATE')
     	NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED)
	T
	STORED = 0E
	IF (CLI$PRESENT('STORED')) THEN
	   STORED = 1
	   IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN O
	      F1_LAST = 0
	      F1_COUNT = 0C
	      F1_START = 0 
	      F1_NBULL = 0T
	      NEWS_F1_FIRST = 0
	      NEWS_F1_END = 0
           END IFE
	   FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8)
	ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN   
	   STORED = 2
	   CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, 
     &      'Are you sure you want to remove stored setting? '//
     &	    '(Y/N with N as default): ') 
	   IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN'
	      WRITE (6,'('' Stored setting was not removed.'')') 
	      CALL CLOSE_BULLNEWS
	      RETURNI
           END IF)
	   IF (DEFAULT) THENE
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))E
     &			//'[.BULLNEWS*]*.*;*')'
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) 
     &			//'BULLNEWS*.DIR;*')1
	   ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN 
              CALL CLOSE_BULLNEWS
	      FOLDER_SAVE = FOLDERG
	      IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN
                 FOLDER_NUMBER = FOLDER1_NUMBERT
                 CALL SELECT_FOLDER(.FALSE.,IER)
	      END IFE
	      FOLDER = FOLDER_SAVEV
              CALL OPEN_BULLDIRK
	      CALL CLOSE_BULLDIR_DELETE
              CALL OPEN_BULLNEWS_SHARED 
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER)
	      F1_START = 0 
	      F1_NBULL = 0U
	      F1_COUNT = 0 
              F1_LAST = 0L
           END IFO
           FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)A
	   FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)N
        END IF

	IF (NOPRIVATE.AND..NOT.DEFAULT) THEN
	   OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),T
     &					STATUS='OLD',IOSTAT=IER) 
	   CLOSE (UNIT=3,DISPOSE='DELETE') 
	   FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0)
	END IF(

	IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN_
	   CALL SET_PROTECTION 
	   OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),A
     &					STATUS='OLD',IOSTAT=IER) 
	   CLOSE (UNIT=3)
	   IF (IER.NE.0) THEN	M
	      OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),
     &			STATUS='NEW',IOSTAT=IER)R
	      CLOSE (UNIT=3)T
	   END IF
	   CALL RESET_PROTECTIONT
	   FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0)
	END IFD

	IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)T
	IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9)

	FLAG = ENABLE.OR.DISABLE.OR.STORED.NE.0.OR.PRIVATE.OR.NOPRIVATE

        CALL REWRITE_FOLDER_FILE_TEMP(IER)

        IF (DEFAULT.OR.(CLASS.AND.(STREQ(GROUP(:LG),FOLDER(:LG))
     &		.OR.STREQ(GROUP(:LG-1),FOLDER)))) THEN D
           NEWS_FLAG_DEFAULT = NEWS_F1_FLAG 
           NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE 
           NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT
	END IF

        CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) 
        IF (DEFAULT.OR.CLASS) THEN
	   IF (CLASS) THENE
              WRITE (6,'('' For class '',A,'':'')') GROUP(:LG)
	   END IF
           IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')')	E
           IF (BTEST(FOLDER1_FLAG,8)) THEN
              WRITE (6,'('' Default is stored.'')')A
           ELSEE
              WRITE (6,'('' Default is not stored.'')')E
           END IF
           CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)
           IF (FOLDER1_BBEXPIRE.GT.0) THEN
              WRITE (6,'('' Default expiration for stored groups is ''
     &         ,A,''.'')') BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) 
           ELSE IF (CLASS) THENH
              WRITE (6,'('' Expiration is DEFAULT value.'')')T
           ELSED
              WRITE (6,'('' Default expiration for stored groups is ''
     &			 ,''14.'')') 
           END IF_
           CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)_
           IF (F1_EXPIRE_LIMIT.GT.0) THEN_
              WRITE (6,'('' Default expiration limit is '',A,''.'')'),
     &                  BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)
           ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN U
              WRITE (6,'('' Expiration limit is DEFAULT value.'')')I
           ELSE
              WRITE (6,'('' There is no default expiration limit.'')')
           END IFE
           IF (BTEST(FOLDER1_FLAG,0)) THEN
              WRITE (6,'('' Private is set.'')')
           END IF 
        ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN
	   FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)T
           WRITE (6,'('' For news group '',A,'':'')') 
     &			FOLDER1_NAME(:TRIM(FOLDER1_NAME))
           WRITE (6,'('' Disable is set.'')')E
	ELSEK
	   FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1) 
           WRITE (6,'('' For news group '',A,'':'')') 
     &			FOLDER1_NAME(:TRIM(FOLDER1_NAME))
           IF (BTEST(FOLDER1_FLAG,8)) THEN
              WRITE (6,'('' News group is stored.'')')
              CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)V
              IF (FOLDER1_BBEXPIRE.GT.0) THENU
                 WRITE (6,'('' Expiration is '',A,''.'')')
     &                  BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)
              ELSE
                 WRITE (6,'('' Expiration is DEFAULT value.'')')
              END IF
           ELSEN
              WRITE (6,'('' News group is not stored.'')')
	   END IF
           CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)S
           IF (F1_EXPIRE_LIMIT.GT.0) THENR
              WRITE (6,'('' Expiration limit is '',A,''.'')')
     &                  BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)
           ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN 
              WRITE (6,'('' Expiration limit is DEFAULT value.'')') 
           ELSE
              WRITE (6,'('' There is no expiration limit.'')')
           END IF(
	   IF (BTEST(FOLDER1_FLAG,1)) THENS
	      WRITE (6,'('' DUMP has been set.'')')
	   END IF
           IF (BTEST(FOLDER1_FLAG,0)) THEN
              WRITE (6,'('' Private is set.'')')
           END IF 
           NOTIFY_FLAG_NEWS = .FALSE.M
           SET_FLAG_NEWS = .FALSE.
	   BRIEF_FLAG_NEWS = .FALSE.,
 	   CALL OPEN_BULLINF_SHAREDC
           DO WHILE (REC_LOCK(IER1))
              READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC
       	   END DOE
	   IF (IER1.EQ.0) THENU
	      I = 1
              DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER
     &					.AND.I.LE.FOLDER_MAX-1)
	         I = I + 1D
       	      END DO
	      IF (I.LE.FOLDER_MAX-1) THEN
	         NOTIFY_FLAG_NEWS = BTEST(INF_REC2(2,I),13)
	         SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14)R
	         BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15)E
		 WRITE (6,'('' This is a default news group.'')') 
              ELSE
	         IER1 = 2
	      END IF 
           END IFE
           NOTIFY_PERM_FLAG_NEWS = .FALSE.
           SET_PERM_FLAG_NEWS = .FALSE.E
	   BRIEF_PERM_FLAG_NEWS = .FALSE.
           DO WHILE (REC_LOCK(IER2))
              READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC
       	   END DOY
	   IF (IER2.EQ.0) THENT
	      I = 1
              DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER
     &					.AND.I.LE.FOLDER_MAX-1)
	         I = I + 1
       	      END DO
	      IF (I.LE.FOLDER_MAX-1) THEN
	         NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13) 
	         SET_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),14)
	         BRIEF_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),15)
		 WRITE (6,'('' This is a permanent news group.'')')S
	      END IFE
           END IFU
	   PERM = .FALSE.
	   IF (SET_FLAG_NEWS) THEN 
	      IF (BRIEF_FLAG_NEWS) THEN
	         IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEND
	            PERM = .TRUE.
		    WRITE (6,'('' Default is BRIEF, which is permanent.'')')
		 ELSEW
		    WRITE (6,'('' Default is BRIEF.'')')
		 END IFR
	      ELSE(
	        IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN
	           PERM = .TRUE.2
		   WRITE (6,'('' Default is READNEW, which is permanent.'')')N
		ELSE
		   WRITE (6,'('' Default is READNEW.'')')_
		END IF
	      END IFG
	   ELSE IF (BRIEF_FLAG_NEWS) THEN
	      IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THENN
	         PERM = .TRUE.'
		 WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')_
	      ELSE.
		 WRITE (6,'('' Default is SHOWNEW.'')') 
    	      END IF 
	   END IF
	   IF (.NOT.PERM) THENT
	    IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN
	      	WRITE (6,'('' BRIEF is the permanent setting.'')')
	    ELSE IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN
		WRITE (6,'('' READNEW is the permanent setting.'')')
	    ELSE IF (BRIEF_PERM_FLAG_NEWS.AND..NOT.SET_PERM_FLAG_NEWS) THEN
		WRITE (6,'('' SHOWNEW is the permanent setting.'')')
	    END IF,
	   END IF
	   IF (NOTIFY_FLAG_NEWS) THEN
	      IF (NOTIFY_PERM_FLAG_NEWS) THEN
		 WRITE (6,'('' Default is NOTIFY, which is permanent.'')')
	      ELSE IF (IER1.EQ.0) THENA
		 WRITE (6,'('' Default is NOTIFY.'')')
	      END IF 
	   ELSE IF (NOTIFY_PERM_FLAG_NEWS) THEN
	      WRITE (6,'('' NOTIFY is permanent.'')')
	   ELSE IF (IER1.EQ.0) THEN
 	      WRITE (6,'('' Default is NONOTIFY.'')') 
	   END IF
	   CALL CLOSE_BULLINF
 	END IF

	IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN
	   CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER) 
	   IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN 
	      IF (SETPRV_PRIV()) THEN
	         READ_ACCESS = 1W
		 WRITE_ACCESS = 1 
	      ELSE	
	        CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP),
     &		   USERNAME,READ_ACCESS,WRITE_ACCESS)K
	      END IF 
	      IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP))	
	   ELSE IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
	      WRITE (6,'('' Access is not limited.'')')
	   END IF
	END IFA

        IF (EXPIRE.LT.0.AND.LIMIT.LT.-1.AND..NOT.FLAG.AND.
     &		(.NOT.CLASS.OR.NEWCLASS.EQ.0)) THEN 
	   CALL CLOSE_BULLNEWSW
	   RETURN
	END IF	

 	IF (CLASS.AND.(ALL.OR.FLAG)) THEN
           WRITE (6,'('' Modifying news groups...'')')
	   FOLDER_SAVE = FOLDER
	   CALL LOWERCASE(GROUP)E
           CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)(
	   IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN 
	      CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) 
	   END IF
	   FOUND = .FALSE.S
	   MODALL = INDEX(GROUP,'.').NE.LGE
           DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.
     &			GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))1
 	      FOUND = .TRUE.
	      IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN )
	         CALL CLOSE_BULLNEWS(
                 FOLDER_NUMBER = FOLDER1_NUMBERR
                 CALL SELECT_FOLDER(.FALSE.,IER)
	         IF (IER) THENM
                    CALL OPEN_BULLDIR
                    CALL CLOSE_BULLDIR_DELETER
	         END IF
	         CALL OPEN_BULLNEWS_SHAREDI
                 CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER)
                 F1_LAST = 0
                 F1_COUNT = 0N
		 F1_START = 0
		 F1_NBULL = 0C
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) 
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)E
	      ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN
	         F1_LAST = 0T
                 F1_COUNT = 0B
		 F1_START = 0U
		 F1_NBULL = 0R
		 NEWS_F1_FIRST = 0
                 NEWS_F1_END = 0
	         FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8)
              END IF
              IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0I
              IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRES
              IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 
              IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT
	      IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)(
	      IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9)
	      IF (PRIVATE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0)
	      IF (NOPRIVATE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0)
              CALL REWRITE_FOLDER_FILE_TEMP(IER)
              CALL READ_FOLDER_FILE_KEYNAMEGT_TEMP(FOLDER1,IER)A
           END DOO
	   IF (.NOT.FOUND) THEN
	      WRITE (6,'('' ERROR: No news groups match class name.'')') 
	      WRITE (6,'('' ERROR: Class has been removed.'')') 
	      CALL OPEN_BULLNEWS_SHARED
	      CALL STR$UPCASE(GROUP,GROUP)I
	      CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER)U
              DELETE (7) R
	      CALL CLOSE_BULLNEWS
	      OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),
     &					STATUS='OLD',IOSTAT=IER)=
	      CLOSE (UNIT=3,DISPOSE='DELETE')
	   END IF
	   IF (FOLDER_SAVE.NE.FOLDER) THEN 
              FOLDER_NUMBER = -1
	      FOLDER1 = FOLDER_SAVE
              CALL SELECT_FOLDER(.FALSE.,IER).
	      IF (.NOT.IER) THEN 
	         FOLDER_NUMBER = 01
	         CALL SELECT_FOLDER(.FALSE.,IER)A
                 WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &              FOLDER(:TRIM(FOLDER)) 
	      END IFN
	      RETURNE
           END IF 
 	ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN
           WRITE (6,'('' Modifying news groups.'',
     &			''  This will take a while...'')') 
	   IER = 0 
	   DO WHILE (IER.EQ.0) 
	      CALL READ_FOLDER_FILE_TEMP(IER)
              IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0A
              IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0 
	      IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR. 
     &		  (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN 
                 F1_LAST = 0
                 F1_COUNT = 0 
		 F1_START = 0N
		 F1_NBULL = 0 
		 NEWS_F1_FIRST = 0
                 NEWS_F1_END = 0
              END IF
	      IF (STORED.EQ.1) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8)
	      IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)
	      IF (STORED.EQ.2) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)I
	      IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)B
	      IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9)
	      CALL REWRITE_FOLDER_FILE_TEMP(IER) 
	   END DO	   
	END IFA

	FOLDER_NUMBER = -1F
	FOLDER1 = FOLDER
        CALL SELECT_FOLDER(.FALSE.,IER) 
	IF (.NOT.IER) THEN 
	   FOLDER_NUMBER = 0 
	   CALL SELECT_FOLDER(.FALSE.,IER)
           WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &        FOLDER(:TRIM(FOLDER))i
	END IFE

	CALL CLOSE_BULLNEWS

        RETURN
        ENDo




	SUBROUTINE INCLUDE(EXCLUDE)

	IMPLICIT INTEGER (A-Z)A

	INCLUDE 'BULLUSER.INC'I

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'T

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /LAST_BUFFER/ OLD_BUFFER
 	CHARACTER*(INPUT_LENGTH) OLD_BUFFERS

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMD

	IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER)
	IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'P

	CALL DISABLE_PRIVS 

	OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
     &	    STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)S

	OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
     &	    DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW',
     &	    SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)i

	CALL ENABLE_PRIVS

	IF (IER.NE.0) THENL
	   WRITE(6,'('' ERROR: Error in opening custom file.'')')
	   RETURN
	END IFN

	ALL = CLI$PRESENT('ALL')E
	FULL = CLI$PRESENT('FULL')N
	IF (.NOT.CLI$GET_VALUE('P1',INPUT,LEN_P).AND..NOT.ALL) THEN
	   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

	   BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,1)
	   CALL READDIR(BULL_POINT,IER)	! Get info for specified bulletin
	   BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1)

       	   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
	      RETURNS
	   END IF

	   CALL OPEN_BULLFIL_SHARED	! Open BULLETIN file

	   ILEN = LINE_LENGTH + 1

	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENs
	      IF (CLI$PRESENT('SUBJECT')) THENI
	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)L
	      ELSEE
	         INPUT = INPUT(7:) 
	         IF (INDEX(INPUT,'%"').GT.0) THEN
	            INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1)
	         END IF
	      END IFR
	   ELSE
	      INPUT = FROM.
	   END IF
	   IF (CLI$PRESENT('SUBJECT')) THEN
	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
	         INPUT = INPUT(7:)L
	      ELSE=
		 INPUT = DESCRIP
	      END IFE
	   END IF

	   CALL CLOSE_BULLFIL
	END IF 

	IF (CLI$PRESENT('SUBJECT')) THENn
	   INPUT = 'SUBJECT:'//INPUT
	ELSE 
	   INPUT = 'FROM:'//INPUT
	END IF

	IF (EXCLUDE) THEN
	   INPUT = ':EXCLUDE:'//INPUT
	ELSEE
	   INPUT = ':INCLUDE:'//INPUT
	END IFT

	FLEN = TRIM(FOLDER_NAME)
	INPUT = FOLDER_NAME(:FLEN)//INPUT

    	ILEN = TRIM(INPUT)S
	DISABLE = CLI$PRESENT('DISABLE'),

	IF (IER1.NE.0) THEN
	   IF (.NOT.DISABLE.AND.LEN_P.GT.0)
     &		WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)U
	   CLOSE (UNIT=4,DISPOSE='SAVE')T
	   RETURN
	END IFA

	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERE
	   IF (IER.EQ.0) THEN	      H
	      IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults').EQ.1.AND.FULL
     &		.AND.INPUT(:FLEN).EQ.OLD_BUFFER(:MIN(FLEN,OLEN))) THEN
		 I = INDEX(OLD_BUFFER,':kill')
		 IF (DISABLE.AND.I.GT.0) THENS
		    IF (I.GT.FLEN-1.OR.OLEN.GT.I+4) THEN
		       OLD_BUFFER = OLD_BUFFER(:I-1)//OLD_BUFFER(I+5:)
		       WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN-5)E
		    END IF
	         ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN
		    OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill'(
		    WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5)
		    FULL = .FALSE.
	         END IF
	      ELSE IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THEN 
	         IF (.NOT.DISABLE) THEN
		    WRITE (6,'('' ERROR: Entry already present.'')')  
		    CLOSE (UNIT=4)	"
		    CLOSE (UNIT=3)	C
		    RETURN
		 END IFS
 	      ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ.
     &		OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN
                 WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN) 
	      END IFI
	   END IF
	END DO

	IF (.NOT.DISABLE) THENP
	   WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)S
	   IF (FULL) WRITE (4,'(A)',IOSTAT=IER)
     &			FOLDER_NAME(:FLEN)//':defaults:kill' 
	END IFN

	CLOSE (UNIT=4,DISPOSE='SAVE')
	CLOSE (UNIT=3,DISPOSE='DELETE')

	CALL CHECK_CUSTOM

        RETURN
        END'




	SUBROUTINE SET_CUSTOM(PARAM)L
CI
C  SUBROUTINE SET_CUSTOM
CI

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLDIR.INC'

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	CHARACTER*(*) PARAM

	IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER)
	IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM'M

	CALL DISABLE_PRIVSS

	OPEN(UNIT=3,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
     &	    STATUS='OLD',SHARED,IOSTAT=IER1,RECL=INPUT_LENGTH)T

	OPEN(UNIT=4,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
     &	    DISPOSE='DELETE',CARRIAGECONTROL='LIST',STATUS='NEW',
     &	    SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)E

	CALL ENABLE_PRIVS

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

	LENP = LEN(PARAM)

	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT
	   IF (IER.EQ.0.AND.PARAM(:LENP).NE.INPUT(2:LENP+1)) THEN
              WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)_
	   END IF
	END DOE

	IF (CLI$GET_VALUE('SET_PARAM2',INPUT,ILEN)) THENA
	   WRITE (4,'(A)',IOSTAT=IER) ':'//PARAM(:LENP)//':'//INPUT(:ILEN)G
	END IF,

	CLOSE (UNIT=4,DISPOSE='SAVE')
	CLOSE (UNIT=3,DISPOSE='DELETE')

	CALL CHECK_CUSTOM

        RETURN
        END'




	SUBROUTINE CHECK_CUSTOM

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

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

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEW
	DATA SCRATCH_B1/0/R

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /FILE_DIRECTORY/ FILE_DIRECTORYE
	CHARACTER*64 FILE_DIRECTORY

	FILE_DIRECTORY = ' 'P

	IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THENv
	   BULL_USER_CUSTOM = .FALSE.
	ELSED
	   BULL_USER_CUSTOM = .FALSE.
	   BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4)
	END IF 

	IER = SYS_TRNLNM('BULL_USER_CUSTOM',BULL_PARAMETER)
	IF (.NOT.IER) BULL_PARAMETER = 'SYS$LOGIN:BULL.CUSTOM' 

	OPEN(UNIT=17,FILE=BULL_PARAMETER(:TRIM(BULL_PARAMETER)), 
     &	    STATUS='OLD',SHARED,IOSTAT=IER,RECL=INPUT_LENGTH)

	IF (IER.NE.0) RETURNE

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

	NINCLUDE = 0 
	DO WHILE (IER.EQ.0)
	   READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER
	   IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.T
     &		OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN
	      BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1)N
	      CALL LOWERCASE(OLD_BUFFER)!
	      IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults')A
     &		.EQ.1) THENE
		 IF (INDEX(OLD_BUFFER,':header').GT.0)
     &		            BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2)
		 IF (INDEX(OLD_BUFFER,':kill').GT.0)
     &		            BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3)
              ELSE
	         BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1)
	         CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)
	         NINCLUDE = NINCLUDE + 1)
	      END IF 
	   ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THENA
		 IF (INDEX(OLD_BUFFER,':header').GT.0)
     &		            BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,2)
		 IF (INDEX(OLD_BUFFER,':kill').GT.0)
     &		            BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3)
		 IF (INDEX(OLD_BUFFER,':file_directory').GT.0)
     &		            FILE_DIRECTORY = OLD_BUFFER(17:)
	   END IF
	END DOE

	CLOSE (UNIT=17)

        RETURN
	END



	 
	LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1) 

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'R

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM 
	DATA BULL_USER_CUSTOM/.FALSE./S

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEE
	DATA SCRATCH_B1/0/ 

	CHARACTER*(*) STRING,STRING1N

	INCLUDE_MSG = .TRUE. 
	IF (BTEST(BULL_USER_CUSTOM,4)) RETURN
	IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNS

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header

	FLEN = TRIM(FOLDER_NAME)L

	INC = .FALSE.

	DO I=1,NINCLUDE
	   CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)I
	   OLEN = TRIM(OLD_BUFFER)I
	   IF (STREQ(FOLDER_NAME(:FLEN)//':',
     &		OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN
	      IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN 
		 IF (.NOT.INC) INCLUDE_MSG = .FALSE.
		 INC = .TRUE.F
	      END IFU
	      C
	      MATCH = .FALSE.
	      IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN
		 LS = TRIM(STRING)
		 IF (TRIM(OLD_BUFFER)-FLEN-14.GE.LS.AND.
     &		     STREQ(STRING(:LS),OLD_BUFFER(FLEN+15:FLEN+14+LS)).AND.E
     &		     (TRIM(OLD_BUFFER)-FLEN-14.EQ.LS.OR.
     &		      INDEX('%@',OLD_BUFFER(FLEN+15+LS:FLEN+15+LS)).NE.0))
     &		      MATCH = .TRUE.
	      ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.
     &		  STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER
     &		  (FLEN+18:OLEN))) THEN.
		 MATCH = .TRUE.C
	      END IF 
	      IF (MATCH) THEN _
		 INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE') 
		 IF (.NOT.INCLUDE_MSG) RETURNs
	      END IF 
	   END IF
	END DOE

	RETURNR
	END



	FUNCTION STRFIND(STRING,STRING1).

	IMPLICIT INTEGER (A-Z)E

	CHARACTER*(*) STRING,STRING1I

	L = LEN(STRING1)=
	DO I=0,LEN(STRING)-L
	   J = 1C
	   DO WHILE (J.LE.L)
	      DIFF = ABS(ICHAR(STRING(I+J:I+J))-ICHAR(STRING1(J:J)))'
	      IF (DIFF.NE.0.AND.DIFF.NE.32) THENE
		 J = L + 1
	      ELSE IF (J.EQ.L) THEN
		 STRFIND = .TRUE.V
		 RETURNR
	      ELSEE
	         J = J + 1 
	      END IFI
	   END DO
	END DOE

	STRFIND = .FALSE.

	RETURNI
	END




        SUBROUTINE SET_NEWNAME

        IMPLICIT INTEGER (A-Z)

        INCLUDE 'BULLUSER.INC'

	COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) 
	COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX)
	COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)I
	COMMON /USERINFO/ LAST(2,FOLDER_MAX)S

	CHARACTER*12 NEW,OLD$

	IF (.NOT.SETPRV_PRIV()) THEN2
	   WRITE (6,'('' ERROR: No privs to set a new name.'')') 
	   RETURN
	END IF 

	CALL CLI$GET_VALUE('OLDNAME',OLD,LENO) 
	CALL CLI$GET_VALUE('NEWNAME',NEW,LENN)(

	CALL OPEN_BULLUSER_SHARED

	TEMP_USER = USERNAME)
        DO WHILE (REC_LOCK(IER))
	   READ (4,IOSTAT=IER,KEYEQ=OLD) USER_ENTRY
	END DO 

	IF (IER.EQ.0) THEN 
	   USERNAME = NEW
           DO WHILE (REC_LOCK(IER))$
	      READ (4,IOSTAT=IER,KEYEQ=NEW)
	   END DO 
	   IF (IER.NE.0) THEN
	      WRITE (4,IOSTAT=IER) USER_ENTRY
	   ELSE
	      REWRITE (4,IOSTAT=IER) USER_ENTRY
	   END IF	'
	END IF	

	USERNAME = TEMP_USERS
        DO WHILE (REC_LOCK(IER1)) 
	   READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY
	END DO 

	CALL CLOSE_BULLUSER

	IF (IER.NE.0) THEN 
	   WRITE (6,'('' ERROR: Old name not found.'')') 
	   RETURN
	END IFT

	CALL OPEN_BULLINF_SHAREDE

        DO WHILE (REC_LOCK(IER))
	   READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST
	END DO 

        DO WHILE (REC_LOCK(IER))
	   READ (9,KEY=NEW,IOSTAT=IER)L
	END DO 
	IF (IER.NE.0) THENN
	   WRITE (9,IOSTAT=IER) NEW,LASTT
	ELSE 
	   REWRITE (9,IOSTAT=IER) NEW,LASTN
	END IF	

	OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO)))
	NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN)))
        DO WHILE (REC_LOCK(IER))
	   READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST
	END DO 
	IF (IER.EQ.0) THENL
           DO WHILE (REC_LOCK(IER))
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO U
	   IF (IER.NE.0) THEN
	      WRITE (9,IOSTAT=IER) NEW,LAST
	   ELSE
	      REWRITE (9,IOSTAT=IER) NEW,LAST
	   END IF	T
	ELSE 
           DO WHILE (REC_LOCK(IER))T
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO 	
	   IF (IER.EQ.0) DELETE (9)
	END IFU
	OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO)))I
	NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN)))N

	OLD(LENO:LENO) = CHAR(128.OR.ICHAR(OLD(LENO:LENO)))
	IF (LENO.GT.1) THEN
	   OLD(LENO-1:LENO-1) = CHAR(128.OR.ICHAR(OLD(LENO-1:LENO-1)))A
	ELSEL
	   OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2)))B
	END IFR
	NEW(LENN:LENN) = CHAR(128.OR.ICHAR(NEW(LENN:LENN)))
	IF (LENN.GT.1) THEN
	   NEW(LENN-1:LENN-1) = CHAR(128.OR.ICHAR(NEW(LENN-1:LENN-1)))E
	ELSE 
	   NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2))):
	END IFR
        DO WHILE (REC_LOCK(IER))
	   READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST
	END DO 
	IF (IER.EQ.0) THEN 
           DO WHILE (REC_LOCK(IER))E
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO W
	   IF (IER.NE.0) THEN
	      WRITE (9,IOSTAT=IER) NEW,LAST
	   ELSE
	      REWRITE (9,IOSTAT=IER) NEW,LAST
	   END IF	 
	ELSE 
           DO WHILE (REC_LOCK(IER))T
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO  
	   IF (IER.EQ.0) DELETE (9)
	END IFA

	CALL CLOSE_BULLINFa

        RETURN
        ENDI
