C
C  BULLETIN11.FOR, Version 4/29/93
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 (.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*132 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(1),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(2),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(1),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)

	CHARACTER*10 BULL_MARK_DIR

	CHARACTER*12 TAG_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)
	   UNLOCK 13
	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
	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
	   FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER
	   CALL OPEN_BULLNEWS_SHARED
	   DO WHILE (IER.EQ.0)
	      DO WHILE (REC_LOCK(IER))
		 READ (23,IOSTAT=IER) NEWS_MARK
	      END DO
	      IF (IER.EQ.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)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	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)) RETURN
	   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 IF

	RETURN
	END



	SUBROUTINE OPEN_NEW_TAG(IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	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

	CHARACTER*10 BULL_MARK_DIR

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

	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 = 13
	   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))
	ELSE
	   MARKUNIT = 23
	   OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	        RECORDSIZE=128,
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:4:INTEGER))
	END IF
	IF (.NOT.IER1) CALL ENABLE_PRIVS
	IF (IER.NE.0) THEN
	   WRITE (6,'('' Cannot create mark file.'')')
	   CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THEN
	      WRITE (6,'('' IOSTAT error = '',I)') IER
	      IER = 0
	   ELSE
	      CALL SYS_GETMSG(IER1)
	      IER = IER1
	   END IF
	ELSE
	   IF (.NOT.IER1) THEN
	      INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER)
	      WRITE (6,'('' Created MARK file: '',A)')
     &		BULL_PARAMETER(:TRIM(BULL_PARAMETER))
	   END IF
	   IF (MARKUNIT.EQ.13) BULL_TAG = 1
	   IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE.
	   IER = 1
	END IF

	RETURN
	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))
	ELSE
	   CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY))
	END IF

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

	RETURN
	END




	SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*12 TAG_KEY,INPUT_KEY

	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 IF

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

	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_HEADER
	   END IF
	   RETURN
	END IF

	MSG_KEY = BULLDIR_HEADER

	HEADER = .TRUE.

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

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

	RETURN

	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 IF

	TAG_TYPE = 0

	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 DO
	      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.
     &	    (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)))) THEN
	   IF (IER.EQ.0) UNLOCK 13
	   IER = 0
	   MESSAGE = MSG_NUM
	ELSE
	   IER = 36
	END IF

	RETURN

	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)n

	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 IF1

	IER = 36e

	HEADER = .FALSE.I

	TAG_TYPE = 0o

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

	DO WHILE (IER.NE.0)
	   I = 0l
	   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),U
     &		        IOSTAT=IER) INPUT_KEY 
		 END DO
		 IF (IER.EQ.0) THENL
	            CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)T
		    IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.
     &		      (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER)))
     &		      IER = 36
		 END IFo
		 IF (IER.EQ.0) THEN 
		    IF (J.EQ.1) THEN
		       NEXT_MSG_KEY = INPUT_KEY(5:)M
		       I = 1
		    ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY,
     &			     INPUT_KEY(5:)).GT.0) THENS
		       I = 2
		    END IF
		 END IF 
	      END IFI
	   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)U
	      DO WHILE (REC_LOCK(IER))U
	         READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I),
     &		        IOSTAT=IER) INPUT_KEY(
	      END DO)
	      IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)B
	      IER = 0
	      RETURN 
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENS
	      MSG_KEY = NEXT_MSG_KEY 
	      RETURNR
	   ELSE
	      MSG_KEY = NEXT_MSG_KEYE
	   END IF
	END DOT

	RETURN(
	END



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

	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)0
	CLOSE_IT = .NOT.CLOSE_ITw
	IF (CLOSE_IT) CALL OPEN_BULLDIR_SHAREDT

	DO MESSAGE = MSG_NUM+1,F_NBULLP
	   CALL READDIR(MESSAGE,IER)E
	   IF (IER.EQ.MESSAGE+1) THEN
	      CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)O
	      IF (IER.EQ.0) THENB
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIR.
		 RETURNL
	      END IFS
	   END IF
	END DOT

	IER = 36
	IF (CLOSE_IT) CALL CLOSE_BULLDIRL

	RETURNA
	END



	INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2)

	IMPLICIT INTEGER (A-Z)L

	CHARACTER*8 MSG_KEY1,MSG_KEY2

	DIMENSION BTIM1(2),BTIM2(2)

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

	COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2)

	RETURNT
	END




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

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLDIR.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	CHARACTER*12 TAG_KEY,INPUT_KEY)

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

	CLOSE_IT = .FALSE.P

	DO WHILE (FOLDER_NUMBER.GT.0)
	   IF (IER.EQ.0) THEN
	      CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)T
	      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.1
     &		  (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_BULLDIR
	      RETURN
	   ELSE
	      CALL DECREMENT_MSG_KEYL
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      INQUIRE (UNIT=2,OPENED=IER)
	      IF (.NOT.IER) THEN 
		 CALL OPEN_BULLDIR_SHAREDR
		 CLOSE_IT = .TRUE.
	      END IFr
	      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) THENU
		    MESSAGE = MESSAGE - 1
		    MSG_NUM = MESSAGEA
		    MSG_KEY = BULLDIR_HEADER
		 END IF 
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIRL
	         RETURN
	      ELSE.
		 DELETE (UNIT=13)F
		 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))E
	            READ (13,IOSTAT=IER) INPUT_KEYE
	 	 END DO
	      END IF
	   END IF

	END DOG

	END



	SUBROUTINE CLOSE_TAG 

	IMPLICIT INTEGER (A-Z)T

	INCLUDE 'BULLUSER.INC's

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

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

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

	TAG_OPENED = .FALSE.E

	IF (BULL_NEWS_TAG) THEN
	   DO I=1,FOLDER_MAX-1_
	      DO M=1,2S
	         IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THENB
	            IF (.NOT.TAG_OPENED) THEN
		       CALL OPEN_OLD_TAG
		       TAG_OPENED = .TRUE.
		    END IF
		    IF (M.EQ.1) THEN
		       NEWS_REC = 1I
		    ELSE
		       NEWS_REC = -32767
		    END IF
	            NEWS_FORMAT = 0
		    IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1n
		    LIMIT = 256/(NEWS_FORMAT+1)O
	            NEWS_NUMBER = LAST_NEWS_READ2(1,I) 
		    K = 5-NEWS_FORMAT*2S
		    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 + 1N
		             SET_LIST = .TRUE.
		          END IF
		       ELSE IF (SET_LIST) THEN
		          IF (LAST_SET.NE.J-1) THENR
			     CALL SET_NEWS_MARK(K,-(J-1))
		             K = K + 1
			  END IFL
		          SET_LIST = .FALSE.
		       END IF
		       IF (J.EQ.NEWS_TAG(2,M,I)) THEN.
		          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) 
		          END DO
		          K = LIMIT + 1 
		       END IF
		       IF (K.GT.LIMIT) THENB
		          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*2
		          NEWS_REC = NEWS_REC + 1(
		          IF (J.EQ.NEWS_TAG(2,M,I)) THEN
		             DO WHILE (REC_LOCK(IER))
		                READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)/
			        IF (IER.EQ.0) THENG
			           DELETE (UNIT=23)
				   NEWS_REC = NEWS_REC + 1
				   L = REC_LOCK(IER)
			        END IF-
			     END DO
		          END IF
		       END IFI
		    END DO
	         END IF
	      END DO0
	   END DO
	   CLOSE (UNIT=23)E
	END IFT

	RETURNI
	END


	SUBROUTINE SET_NEWS_MARK(I,J)

	IMPLICIT INTEGER (A-Z)N

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

	IF (NEWS_FORMAT.EQ.0) THENI
	   NEWS_MARK2(I) = JU
	ELSE
	   NEWS_MARK(I) = J
	END IFL

	RETURN,
	END



	SUBROUTINE ZERO_VM(NUM,NEWS_TAG) 

	IMPLICIT INTEGER (A-Z)S

	LOGICAL*1 NEWS_TAG(1)

	DO I=1,NUM 
	   NEWS_TAG(I) = 0 
	END DOE

	RETURN_
	END




	SUBROUTINE FREE_TAGS(ISUB) 

        IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC' 

	INCLUDE 'BULLUSER.INC'I

	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))B
	EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(2),NEWS_REC) 
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)3

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

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

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

	RETURNA
	END




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

	IMPLICIT INTEGER (A-Z)1

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'_

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	CHARACTER*8 PREV_MSG_KEY

	IER = 36S

	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)
	      IF (IER.EQ.0) THENI
		 TMP_MSG_NUM = MSG_NUM
	         CALL READDIR(TMP_MSG_NUM,IER1)
	         IF (IER1.NE.MSG_NUM+1) THEN 
	            IF (.NOT.BTEST(READ_TAG,3)) THEN
		       CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)
		    END IF
		    IER = 36
	         END IF
	      END IFT
	   END DO
	   BULL_READ = MSG_NUMN
	   IF (CLOSE_IT) CALL CLOSE_BULLDIR &
	ELSES
	   IF (MSG_NUM.EQ.0) RETURN
	   SAVE_MSG_NUM = MSG_NUM
	   PREV_MSG_NUM = MSG_NUM
	   MSG_NUM = 0 
	   MSG_KEY = BULLDIR_HEADER
	   IER = 0Y
	   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)(
	   END DO
	   IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN
	      MSG_NUM = PREV_MSG_NUM
	      MSG_KEY = PREV_MSG_KEYO
	      CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)L
	   ELSE
	      IER = 36G
	   END IF
	END IFE

	RETURN
	END


	SUBROUTINE DECREMENT_MSG_KEYE

	IMPLICIT INTEGER (A-Z)C

	INCLUDE 'BULLDIR.INC'

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

	RETURN
	END




	SUBROUTINE SET_GENERIC(GENERIC)
C,
C  SUBROUTINE SET_GENERICB
C)
C  FUNCTION: Enables or disables "GENERIC" display, i.e. displayingT
C	general bulletins continually for a certain amount of days.
CI
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'0

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

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

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

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)N

	IF (IER.EQ.0) THENM
	   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))
	      ELSE_
		 NEW_FLAG(2) = '   7'3
	      END IFF
	   ELSE
	      NEW_FLAG(2) = 0
	   END IF
	   REWRITE (4) TEMP_USER//USER_ENTRY(13:)
	ELSE 
	   WRITE (6,'('' ERROR: Specified username not found.'')')
	END IF 

	CALL CLOSE_BULLUSER

	RETURNE
	END


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

	INCLUDE 'BULLUSER.INC'C

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(USERNAME,IER)

	IF (BRIEF_CONTINUOUS) THENT
	   NEW_FLAG(2) = -1
	ELSE 
	   NEW_FLAG(2) = 0S
	END IF.

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

	CALL CLOSE_BULLUSER

	RETURN 
	END


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

	INCLUDE 'BULLUSER.INC'Y

	CHARACTER TODAY*24B

	DIMENSION NOLOGIN_BTIM(2)

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

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

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

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)H

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

	CALL CLOSE_BULLUSER

	RETURNM
	END





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

	IMPLICIT INTEGER (A-Z) 

	CHARACTER USERNAME*(*),ACCOUNT*(*)_

	INCLUDE '($UAIDEF)'

	INTEGER*2 UIC(2)&

	CALL INIT_ITMLST_
	CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))
	CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))S
	CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC))
	CALL END_ITMLST(GETUAI_ITMLST))

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

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

	RETURN 
	END



	SUBROUTINE DCLEXH(EXIT_ROUTINE)

	IMPLICIT INTEGER (A-Z))

	INTEGER*4 EXBLK(4)

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

	CALL SYS$DCLEXH(EXBLK(1))

	RETURNG
	END



	SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS)

        IMPLICIT INTEGER (A-Z)

	INCLUDE '($MAILDEF)'T

	CHARACTER*(*) FILE,SENDTO,SUBJECT

	EXTERNAL MAIL_ERROR

	CALL DISABLE_PRIVSE

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

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

	C = 0

	CALL LIB$ESTABLISH(MAIL_ERROR)Y

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

	J = 1
	DO WHILE (J.LE.TRIM(SENDTO))D
	   I = INDEX(SENDTO(J:),',') - 1T
	   IF (I.EQ.-1) I = TRIM(SENDTO(J:))T
           CALL INIT_ITMLST
           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)A
           IF (.NOT.STATUS) GO TO 100
	   J = J + I_
	   IF (SENDTO(J:J).EQ.',') J = J + 1
	END DO 

        CALL INIT_ITMLST
        CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT
     &				,%LOC(SUBJECT)) 
        CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO))G
        CALL END_ITMLST(ATTRIBUTE_ITMLST)

        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)U
        IF (.NOT.STATUS) GO TO 100

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

100	CALL ENABLE_PRIVS
	CALL LIB$REVERT

        RETURN
        ENDA



	FUNCTION MAIL_ERROR(SIGARGS,MECHARGS)

	MAIL_ERROR = .TRUE.

	CALL SYS$PUTMSG(SIGARGS,,)

	RETURNH
	END




        SUBROUTINE SET_NEWS

        IMPLICIT INTEGER (A-Z)

        INCLUDE '($SSDEF)'

        INCLUDE 'BULLFOLDER.INC'

        INCLUDE 'BULLFILES.INC'E

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

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /KEEPLOCK/ KEEPLOCK:

	COMMON /NEXT/ NEXTS

	DIMENSION EXPIRED(2)

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

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

	ENTRY SHOW_NEWS

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

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

	IF (.NOT.(CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('CLASS').OR.1
     &		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 fileL

	IF (CLI$PRESENT('DEFAULT')) THEN_
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)S
	ELSE IF (CLI$GET_VALUE('CLASS',BULL_PARAMETER,LEN_P)) THEN(
	   BULL_PARAMETER = BULL_PARAMETER(:LEN_P)//'.'
	   CALL STR$UPCASE(BULL_PARAMETER,BULL_PARAMETER)
	   LEN_P = LEN_P + 1)
	   IF (LEN_P.GT.LEN(FOLDER)) THEN
	      WRITE (6,'('' ERROR: Class name too long.'')') 
	      CALL CLOSE_BULLNEWS
	      RETURND
	   END IF
	   GROUP = BULL_PARAMETER(:LEN_P)
           LG = LEN_PB
	   CALL READ_FOLDER_FILE_KEYNAME_TEMP(BULL_PARAMETER(:LEN_P),
     &					NEWCLASS)
	   IF (CLI$PRESENT('DELETE')) THEN 
	      IF (NEWCLASS.NE.0) THEN
	         WRITE (6,'('' ERROR: Class not found.'')')
	      ELSEA
	         DELETE (7)
		 WRITE (6,'('' Class deleted.'')')
	      END IF(
              IF (BTEST(FOLDER1_FLAG,0)) THENM
		 OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),
     &					STATUS='OLD',IOSTAT=IER)V
	     	 CLOSE (UNIT=3,DISPOSE='DELETE')A
              END IF
	      RETURN
	   ELSE IF (NEWCLASS.NE.0) THEN
              CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) 
              DO WHILE (IER.EQ.0)	
                 DO WHILE (REC_LOCK(IER)) 
                    READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER)
                 END DOT
                 IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1
              END DO
	      FOLDER1_FLAG = NEWS_FLAG_DEFAULT_
	      FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT	
              F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT 
 	      CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED)I
              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)
	      FOLDER1_NUMBER = NEWS_F1_COUNTB
	      FOLDER1 = BULL_PARAMETERA
 	      FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)E
	      CALL WRITE_FOLDER_FILE_TEMP(IER)E
	      IF (IER.NE.0) THEN
		 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 = TEMPG
	      REWRITE (7) NEWS_FOLDER1_COMH
 	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)R
	   END IF	M
 	ELSE
	   IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.
     &				%LOC(CLI$_ABSENT)) FOLDER1 = FOLDER 
	   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
	      RETURNR
	   END IF
	END IFG

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

	CLASS = CLI$PRESENT('CLASS')_
	DEFAULT = CLI$PRESENT('DEFAULT')C
	ALL = CLI$PRESENT('ALL')
 	IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE.
	DISABLE = CLI$PRESENT('DISABLE')K
      	ENABLE = CLI$PRESENT('ENABLE')G
     	PRIVATE = CLI$PRESENT('PRIVATE')
     	NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED)
	Y
	STORED = 0L
	IF (CLI$PRESENT('STORED')) THEN
	   STORED = 1
	   IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN 1
	      F1_LAST = 0
	      F1_COUNT = 0K
	      F1_START = 0 
	      F1_NBULL = 0A
	      NEWS_F1_FIRST = 0
	      NEWS_F1_END = 0
           END IFD
	   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): ')E
	   IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN'
	      WRITE (6,'('' Stored setting was not removed.'')')R
	      CALL CLOSE_BULLNEWS
	      RETURNA
           END IF 
	   IF (DEFAULT) THEN
	      CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE(I
     &			:TRIM(BULLNEWSDIR_FILE))//';*')	t
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))1
     &			//'[.BULLNEWS*]*.*;*')'
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) 
     &			//'BULLNEWS*.DIR;*')I
	   ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN 
              CALL CLOSE_BULLNEWSA
	      FOLDER_SAVE = FOLDER'
	      IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN
                 FOLDER_NUMBER = FOLDER1_NUMBERA
                 CALL SELECT_FOLDER(.FALSE.,IER)
	      END IF 
	      FOLDER = FOLDER_SAVEI
              CALL OPEN_BULLDIR_SHARED
	      KEEPLOCK = .TRUE.
	      NEXT = .TRUE.
	      BULL_DELETE = 1
	      F_START = 0
	      F_NBULL = 999999T
	      CALL READDIR(BULL_DELETE,IER)
	      DO WHILE (IER.EQ.BULL_DELETE+1)
	         DELETE (2)
	         CALL READDIR(BULL_DELETE,IER)
	      END DO	      
	      NEXT = .FALSE.
	      KEEPLOCK = .FALSE.
              CALL CLOSE_BULLDIR
              CALL OPEN_BULLNEWS_SHARED 
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER)
	      F1_START = 0M
	      F1_NBULL = 0E
	      F1_COUNT = 0 
              F1_LAST = 0U
           END IFR
           FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)E
	   FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)T
        END IF

	IF (NOPRIVATE.AND..NOT.DEFAULT) THEN)
	   OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),E
     &					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),E
     &					STATUS='OLD',IOSTAT=IER) 
	   CLOSE (UNIT=3)
	   IF (IER.NE.0) THEN	B
	      OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),
     &			STATUS='NEW',IOSTAT=IER)
	      CLOSE (UNIT=3)O
	   END IF
	   CALL RESET_PROTECTIONR
	   FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0)
	END IF,

	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_EXPIREN
           NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITT
	END IF.

        CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)A
        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.'')')	R
           IF (BTEST(FOLDER1_FLAG,8)) THEN
              WRITE (6,'('' Default is stored.'')')E
           ELSEN
              WRITE (6,'('' Default is not stored.'')')T
           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):)A
           ELSE IF (CLASS) THEN
              WRITE (6,'('' Expiration is DEFAULT value.'')')T
           ELSEN
              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) THENO
              WRITE (6,'('' Default expiration limit is '',A,''.'')')O
     &                  BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)
           ELSE IF (CLASS.AND.F1_EXPIRE_LIMIT.EQ.0) THEN 
              WRITE (6,'('' Expiration limit is DEFAULT value.'')') 
           ELSEL
              WRITE (6,'('' There is no default expiration limit.'')')
           END IF	
           IF (BTEST(FOLDER1_FLAG,0)) THEN
              WRITE (6,'('' Private is set.'')')
           END IFG
        ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN
	   FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)A
           WRITE (6,'('' For news group '',A,'':'')') 
     &			FOLDER1_NAME(:TRIM(FOLDER1_NAME))
           WRITE (6,'('' Disable is set.'')') 
	ELSED
	   FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)I
           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,,,)I
              IF (FOLDER1_BBEXPIRE.GT.0) THEN
                 WRITE (6,'('' Expiration is '',A,''.'')')
     &                  BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)
              ELSE
                 WRITE (6,'('' Expiration is DEFAULT value.'')')
              END IF
           ELSE 
              WRITE (6,'('' News group is not stored.'')')
	   END IF
           CALL OTS$CVT_L_TI(F1_EXPIRE_LIMIT,BULL_PARAMETER,,,)L
           IF (F1_EXPIRE_LIMIT.GT.0) THENS
              WRITE (6,'('' Expiration limit is '',A,''.'')')_
     &                  BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):)
           ELSE IF (F1_EXPIRE_LIMIT.EQ.0) THEN C
              WRITE (6,'('' Expiration limit is DEFAULT value.'')') 
           ELSEE
              WRITE (6,'('' There is no expiration limit.'')')
           END IFT
	   IF (BTEST(FOLDER1_FLAG,1)) THEN
	      WRITE (6,'('' DUMP has been set.'')')
	   END IF
           IF (BTEST(FOLDER1_FLAG,0)) THEN
              WRITE (6,'('' Private is set.'')')
           END IFA
 	END IF

	IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN
	   CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER)R
	   IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN
	      IF (SETPRV_PRIV()) THEN
	         READ_ACCESS = 1 
		 WRITE_ACCESS = 1%
	      ELSE(
	        CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP),
     &		   USERNAME,READ_ACCESS,WRITE_ACCESS) 
	      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 IFC

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

 	IF (CLASS.AND.(ALL.OR.FLAG)) THEN.
           WRITE (6,'('' Modifying news groups...'')')
	   FOLDER_SAVE = FOLDER
	   CALL LOWERCASE(GROUP)(
           CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)
	   IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THENH
	      CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER))
	   END IF
	   FOUND = .FALSE. 
	   MODALL = INDEX(GROUP,'.').NE.LGS
           DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.L
     &			GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))L
 	      FOUND = .TRUE.
	      IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN  
	         CALL CLOSE_BULLNEWSO
                 FOLDER_NUMBER = FOLDER1_NUMBER 
                 CALL SELECT_FOLDER(.FALSE.,IER)
	         IF (IER) THEN
                    CALL OPEN_BULLDIR_SHARED
		    KEEPLOCK = .TRUE._
		    NEXT = .TRUE.E
		    BULL_DELETE = 1'
		    F_START = 0C
	            F_NBULL = 999999D
		    CALL READDIR(BULL_DELETE,IER)N
		    DO WHILE (IER.EQ.BULL_DELETE+1)E
		       DELETE (2)(
		       CALL READDIR(BULL_DELETE,IER)
		    END DO	      
	      	    NEXT = .FALSE.
		    KEEPLOCK = .FALSE.
                    CALL CLOSE_BULLDIR
	         END IF
	         CALL OPEN_BULLNEWS_SHAREDA
                 CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER)
                 F1_LAST = 0
                 F1_COUNT = 0 
		 F1_START = 0G
		 F1_NBULL = 0N
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) .
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13) 
	      ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN
	         F1_LAST = 0	
                 F1_COUNT = 03
		 F1_START = 0F
		 F1_NBULL = 0W
		 NEWS_F1_FIRST = 0
                 NEWS_F1_END = 0
	         FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8)
              END IF
              IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0S
              IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRE)
              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)	
           END DOS
	   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) 
	      CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG),IER)I
              DELETE (7)  
	      CALL CLOSE_BULLNEWS
	      OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),
     &					STATUS='OLD',IOSTAT=IER)E
	      CLOSE (UNIT=3,DISPOSE='DELETE')
	   END IF
	   IF (FOLDER_SAVE.NE.FOLDER) THEN 
              FOLDER_NUMBER = -1
	      FOLDER1 = FOLDER_SAVE
              CALL SELECT_FOLDER(.FALSE.,IER)R
	      IF (.NOT.IER) THEN 
	         FOLDER_NUMBER = 0 
	         CALL SELECT_FOLDER(.FALSE.,IER))
                 WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &              FOLDER(:TRIM(FOLDER)) 
	      END IF)
	      RETURNE
           END IF	
 	ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN
           WRITE (6,'('' Modifying news groups.'',
     &			''  This will take a while...'')')D
	   IER = 0O
	   DO WHILE (IER.EQ.0)E
	      CALL READ_FOLDER_FILE_TEMP(IER)
              IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0C
              IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 01
	      IF ((STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)).OR.V
     &		  (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8))) THEN 
                 F1_LAST = 0
                 F1_COUNT = 0
		 F1_START = 0S
		 F1_NBULL = 0M
		 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)
	      IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9) 
	      IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9)
	      CALL REWRITE_FOLDER_FILE_TEMP(IER)W
	   END DO	   
	END IFE

	FOLDER_NUMBER = -1_
	FOLDER1 = FOLDERD
        CALL SELECT_FOLDER(.FALSE.,IER)_
	IF (.NOT.IER) THEN 
	   FOLDER_NUMBER = 0E
	   CALL SELECT_FOLDER(.FALSE.,IER)V
           WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &        FOLDER(:TRIM(FOLDER))R
	END IF_

	CALL CLOSE_BULLNEWS

        RETURN
        END)




	SUBROUTINE INCLUDE(EXCLUDE)

	IMPLICIT INTEGER (A-Z)S

	INCLUDE 'BULLUSER.INC'G

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'W

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM	

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

	CALL DISABLE_PRIVS6

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

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

	CALL ENABLE_PRIVS

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

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

	   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 outP
	      RETURNU
	   END IF

	   CALL OPEN_BULLFIL_SHARED	! Open BULLETIN fileD

	   ILEN = LINE_LENGTH + 1

	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)&
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THENG
	      IF (CLI$PRESENT('SUBJECT')) THENM
	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E
	      ELSEO
	         INPUT = INPUT(7:) 
	         IF (INDEX(INPUT,'%"').GT.0) THEN
	            INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1)
	         END IF
	      END IF
	   ELSE
	      INPUT = FROM,
	   END IF
	   IF (CLI$PRESENT('SUBJECT')) THEN
	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
	         INPUT = INPUT(7:)S
	      ELSE 
		 INPUT = DESCRIP
	      END IFU
	   END IF

	   CALL CLOSE_BULLFIL
	END IF

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

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

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

    	ILEN = TRIM(INPUT)E
	ALL = CLI$PRESENT('ALL')
	DISABLE = CLI$PRESENT('DISABLE')I

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

	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERU
	   IF (IER.EQ.0) THEN	      6
	      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) THEN
		    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)N
		    END IF
	         ELSE IF (.NOT.DISABLE.AND.I.EQ.0) THEN
		    OLD_BUFFER = OLD_BUFFER(:OLEN)//':kill'G
		    WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN+5)
		    FULL = .FALSE.
	         END IF
	      ELSE IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THENS
	         IF (.NOT.DISABLE) THEN
		    WRITE (6,'('' ERROR: Entry already present.'')') U
		    CLOSE (UNIT=4)	D
		    CLOSE (UNIT=3)	R
		    RETURN
		 END IFI
 	      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 IFe
	   END IF
	END DO.

	IF (.NOT.DISABLE) THENZ
	   WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)B
	   IF (FULL) WRITE (4,'(A)',IOSTAT=IER)
     &			FOLDER_NAME(:FLEN)//':defaults:kill'E
	END IFE

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

	CALL CHECK_CUSTOM

        RETURN
        END




	SUBROUTINE CHECK_CUSTOM

	IMPLICIT INTEGER (A-Z)B

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC's

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

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEO
	DATA SCRATCH_B1/0/L

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	BULL_USER_CUSTOM = .FALSE.=

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

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

	IF (IER.NE.0) RETURN 

	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 pointeri
	END IFn

	NINCLUDE = 0'
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERO
	   IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.I
     &		OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN
	      BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1) 
	      CALL LOWERCASE(OLD_BUFFER)U
	      IF (INDEX(OLD_BUFFER(TRIM(FOLDER_NAME)+2:),'defaults')C
     &		.EQ.1) THEN
		 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 IFB
	   ELSE IF (IER.EQ.0.AND.OLD_BUFFER(:1).EQ.':') THEN 
		 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)
	   END IF
	END DO 

	CLOSE (UNIT=3) 

        RETURN
	END



	
	LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1))

	IMPLICIT INTEGER (A-Z)C

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'J

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMT
	DATA BULL_USER_CUSTOM/.FALSE./L

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE'
	DATA SCRATCH_B1/0/Q

	CHARACTER*(*) STRING,STRING1 

	INCLUDE_MSG = .TRUE. 
	IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) RETURNA

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header

	FLEN = TRIM(FOLDER_NAME)A

	INC = .FALSE.

	DO I=1,NINCLUDE
	   CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER) 
	   OLEN = TRIM(OLD_BUFFER)'
	   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.S
	      END IF 
	      IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.$
     &		  (STRFIND(STRING(:TRIM(STRING)),OLD_BUFFER 
     &		  (FLEN+15:OLEN)).OR. 
     &		  STREQ(STRING(:TRIM(STRING)),OLD_BUFFER
     &		  (FLEN+15:FLEN+14+TRIM(STRING))))).OR.L
     &		  (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.Y
     &		  STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER
     &		  (FLEN+18:OLEN)))) THEN
		 INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')M
		 IF (.NOT.INCLUDE_MSG) RETURNS
	      END IF0
	   END IF
	END DOM

	RETURND
	END



	FUNCTION STRFIND(STRING,STRING1)

	IMPLICIT INTEGER (A-Z)L

	CHARACTER*(*) STRING,STRING1 

	L = LEN(STRING1)N
	DO I=0,LEN(STRING)-LS
	   J = 1
	   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) THENI
		 J = L + 1
	      ELSE IF (J.EQ.L) THEN
		 STRFIND = .TRUE.L
		 RETURN'
	      ELSEN
	         J = J + 1E
	      END IFM
	   END DO
	END DOA

	STRFIND = .FALSE.

	RETURN4
	END
