C
C  BULLETIN11.FOR, Version 10/6/98
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.'E000'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)

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	IF (.NOT.BULL_NEWS_TAG) RETURN

	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 '($RMSDEF)'

	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

	IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN
	   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))

	   IF (IER.EQ.0) THEN
	      IF (BULL_NEWS_TAG) RETURN
	      BULL_NEWS_TAG = .TRUE.
	   ELSE
	      CALL ERRSNS(IDUMMY,IER1)
	      IF (IER1.EQ.RMS$_FLK) THEN
	         BULL_NEWS_TAG = .FALSE.
	         RETURN
	      END IF
	   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
	      CLOSE (UNIT=23)
	      OPEN (UNIT=23,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:4:INTEGER))
	      IF (IER.EQ.0) THEN
	      OPEN (UNIT=24,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',
     &	        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')
	      END IF
	      DO WHILE (FILE_LOCK(IER,IER1))
	        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))
	      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))
	        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))
	      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
		       OLD_NEWS_NUMBER = NEWS_NUMBER
		       CALL READ_FOLDER_FILE_KEYNUM_TEMP
     &			  (NEWS_FOLDER_NUMBER,IER1)
		       IF (IER1.NE.0) THEN
	      		  CALL ERRSNS(IDUMMY,IER2)
		          IF (IER2.NE.RMS$_RNF) 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

	COMMON /NEWS_MARK/ NEWS_MARK
	DIMENSION NEWS_MARK(128)

	CHARACTER*12 BULL_MARK_DIR

	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 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))
	   IF (IER.EQ.0) THEN
	      CALL SYS_BINTIM('-',BTIM)
	      CALL GET_MSGKEY(BTIM,KEY)
	      WRITE (13) TAG_KEY('FFFF'X,KEY,0)
	   END IF
	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))
	   IF (IER.EQ.0) THEN
	      NEWS_MARK(1) = 0
	      CALL SYS_BINTIM('-',NEWS_MARK(2))
	      WRITE (23,IOSTAT=IER) NEWS_MARK
           END IF
 	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)

	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.

	TAG_TYPE = 0

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

	DO WHILE (IER.NE.0)
	   I = 0
	   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) THEN
	            CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)
		    IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.
     &		      (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER)))
     &		      IER = 36
		 END IF
		 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) THEN
		       I = 2
		    END IF
		 END IF
	      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))
	         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)
	      IER = 0
	      RETURN
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN
	      MSG_KEY = NEXT_MSG_KEY
	      RETURN
	   ELSE
	      MSG_KEY = NEXT_MSG_KEY
	   END IF
	END DO

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

	DO MESSAGE = MSG_NUM+1,F_NBULL
	   CALL READDIR(MESSAGE,IER)
	   IF (IER.EQ.MESSAGE+1) THEN
	      CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)
	      IF (IER.EQ.0) THEN
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIR
		 RETURN
	      END IF
	   END IF
	END DO

	IER = 36
	IF (CLOSE_IT) CALL CLOSE_BULLDIR

	RETURN
	END



	INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2)

	IMPLICIT INTEGER (A-Z)

	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)

	RETURN
	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.

	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.
     &		  (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_KEY
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      INQUIRE (UNIT=2,OPENED=IER)
	      IF (.NOT.IER) THEN
		 CALL OPEN_BULLDIR_SHARED
		 CLOSE_IT = .TRUE.
	      END IF
	      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) THEN
		    MESSAGE = MESSAGE - 1
		    MSG_NUM = MESSAGE
		    MSG_KEY = BULLDIR_HEADER
		 END IF
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIR
	         RETURN
	      ELSE
		 DELETE (UNIT=13)
		 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))
	            READ (13,IOSTAT=IER) INPUT_KEY
	 	 END DO
	      END IF
	   END IF

	END DO

	END



	SUBROUTINE CLOSE_TAG

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	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 /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)

	TAG_OPENED = .FALSE.

	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) THEN
	            IF (.NOT.TAG_OPENED) THEN
		       CALL OPEN_OLD_TAG
		       TAG_OPENED = .TRUE.
		    END IF
		    IF (M.EQ.1) THEN
		       NEWS_REC = 1
		    ELSE
		       NEWS_REC = -32767
		    END IF
	            NEWS_FORMAT = 0
		    IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1
		    LIMIT = 256/(NEWS_FORMAT+1)
	            NEWS_NUMBER = LAST_NEWS_READ2(1,I)
		    K = 5-NEWS_FORMAT*2
		    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 IF
		          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) THEN
		          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) THEN
			           DELETE (UNIT=23)
				   NEWS_REC = NEWS_REC + 1
				   L = REC_LOCK(IER)
			        END IF
			     END DO
		          END IF
		       END IF
		    END DO
	         END IF
	      END DO
	   END DO
	   CLOSE (UNIT=23)
	END IF

	RETURN
	END


	SUBROUTINE SET_NEWS_MARK(I,J)

	IMPLICIT INTEGER (A-Z)

	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)

	IF (NEWS_FORMAT.EQ.0) THEN
	   NEWS_MARK2(I) = J
	ELSE
	   NEWS_MARK(I) = J
	END IF

	RETURN
	END



	SUBROUTINE ZERO_VM(NUM,NEWS_TAG)

	IMPLICIT INTEGER (A-Z)

	LOGICAL*1 NEWS_TAG(1)

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

	RETURN
	END




	SUBROUTINE FREE_TAGS(ISUB)

        IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.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)

	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))
	      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_MARK
	         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-2
	      CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J))
	   END DO

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

	RETURN
	END




	SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	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 = 36

	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) THEN
		 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 IF
	   END DO
	   BULL_READ = MSG_NUM
	   IF (CLOSE_IT) CALL CLOSE_BULLDIR 
	ELSE
	   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)
	   END DO
	   IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN
	      MSG_NUM = PREV_MSG_NUM
	      MSG_KEY = PREV_MSG_KEY
	      CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)
	   ELSE
	      IER = 36
	   END IF
	END IF

	RETURN
	END


	SUBROUTINE DECREMENT_MSG_KEY

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

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

	RETURN
	END




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

	INCLUDE 'BULLUSER.INC'

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	IF (.NOT.SETPRV_PRIV()) THEN
	   WRITE (6,'(
     &      '' 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)

	IF (IER.EQ.0) THEN
	   IF (GENERIC) THEN
	      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'
	      END IF
	   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

	RETURN
	END


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

	INCLUDE 'BULLUSER.INC'

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(USERNAME,IER)

	IF (BRIEF_CONTINUOUS) THEN
	   NEW_FLAG(2) = -1
	ELSE
	   NEW_FLAG(2) = 0
	END IF

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

	CALL CLOSE_BULLUSER

	RETURN
	END


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

	INCLUDE 'BULLUSER.INC'

	CHARACTER TODAY*24

	DIMENSION NOLOGIN_BTIM(2)

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

	IF (.NOT.SETPRV_PRIV()) THEN
	   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)

	CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)
	IF (IER.EQ.0) THEN
	   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:)
	ELSE
	   WRITE (6,'('' ERROR: Specified username not found.'')')
	END IF

	CALL CLOSE_BULLUSER

	RETURN
	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))
	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) = 1
	EXBLK(4) = %LOC(EXBLK(4))

	CALL SYS$DCLEXH(EXBLK(1))

	RETURN
	END



	SUBROUTINE SENDMAIL(FILE,TO,SUBJECT,STATUS)

        IMPLICIT INTEGER (A-Z)

	PARAMETER CRLF = CHAR(13)//CHAR(10)

	INCLUDE '($MAILDEF)'

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	COMMON /MAIL_INFO/ USE_INFROM
	DATA USE_INFROM /.FALSE./

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

	COMMON /HEADER_QUEUE/ HEADER_Q,HEADER_Q1,NHEAD
	DATA HEADER_Q1/0/

	COMMON /SENDTO/ SENDTO
	CHARACTER*256 SENDTO

	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME

	COMMON /NEWSBULL/ NEWSBULL

	CHARACTER*(*) FILE,TO,SUBJECT

	EXTERNAL MAIL_ERROR

	CALL SYS$SETAST(%VAL(1))

	CALL DISABLE_PRIVS

	SENDTO = TO
        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,'""'))//
     &			 SUBJECT(INDEX(SUBJECT,'""')+2:)
	END DO	

	IF ((USE_INFROM.OR.NEWSBULL).AND.(SYS_TRNLNM('TWF$TCP','DEFINED').OR.
     &	    SYS_TRNLNM('MULTINET_SOCKET_LIBRARY','DEFINED').OR.
     &	    SYS_TRNLNM('UCX$DEVICE','DEFINED'))
     &	    .AND..NOT.SYS_TRNLNM('BULL_DISABLE_SMTP','DEFINED')) THEN
	   IER = SYS$ASCTIM(,INPUT,,)
	   INPUT = INPUT(:2)//INPUT(4:6)//INPUT(10:11)//
     &	      INPUT(13:14)//INPUT(16:17)//INPUT(19:20)//
     &	      INPUT(22:23)
	   IF (INPUT(:1).EQ.' ') INPUT = INPUT(2:)
	   OPEN (UNIT=8,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
     &		INPUT(:TRIM(INPUT))//'.SMTP',IOSTAT=IER1,
     &		STATUS='NEW',RECL=256)
	   IF (IER1.EQ.0) THEN
	      IF (LPATH.EQ.0) CALL GET_PATHNAME
	      WRITE (8,'(A)',IOSTAT=IER) 'helo '//PATHNAME(:LPATH)
	      INPUT = INFROM
	      I = INDEX(INPUT,'<')
	      IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN 
		 INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1)
	      END IF
	      WRITE (8,'(A)',IOSTAT=IER) 'MAIL FROM:<'//
     &					INPUT(:TRIM(INPUT))//'>'
	      SENDTO = SENDTO(INDEX(SENDTO,'"')+1:)
	      DO WHILE (INDEX(SENDTO,'"').GT.0)
		 SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)//
     &			  SENDTO(INDEX(SENDTO,'"')+1:)
	      END DO
	      WRITE (8,'(A)',IOSTAT=IER) 'RCPT TO:<'//SENDTO(:TRIM(SENDTO))
     &					//'>'
	      WRITE (8,'(A)',IOSTAT=IER) 'DATA'
	      HEADER_Q = HEADER_Q1
	      DO I=1,NHEAD
		 CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
		 WRITE (8,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT))
	      END DO
	      IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN
		 WRITE (8,'(A)',IOSTAT=IER)
     &			'Subject: '//SUBJECT(:TRIM(SUBJECT))
		 WRITE (8,'(A)',IOSTAT=IER)
	      END IF
	      IF (NEWSBULL) THEN
		 WRITE (8,'(A)') 'This message was posted via a folder'//
     &		    ' with a news group associated with it.'
		 WRITE (8,'(A)') 'It will continue to attempt to be'//
     &		    ' posted to the news group using the file:'
		 WRITE (8,'(A)') FILE(:TRIM(FILE))
		 WRITE (8,'(A)') 'If necessary, you can either'//
     &		    ' delete the file or edit it to fix it.'
		 WRITE (8,'(A)') 'If you edit it, delete old versions.'
		 WRITE (8,'(A)') ' '
	      END IF
	      OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER)
	      DO WHILE (IER.EQ.0)
		 READ (3,'(Q,A)',IOSTAT=IER) L,INPUT
		 IF (IER.EQ.0) THEN
		    WRITE (8,'(A)',IOSTAT=IER) INPUT(:L)
		 END IF
	      END DO
	      CLOSE (UNIT=3)
	      REWIND (UNIT=8,IOSTAT=IER)
	      IF (IER.NE.0) THEN
	         CLOSE (UNIT=8,STATUS='DELETE')
	         IER1 = 2
	      END IF
	   END IF
	   IF (.NOT.SMTP_CONNECT()) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (INPUT(:3).NE.'220') GOTO 10
	   IF (.NOT.SMTP_WRITE_PACKET('helo '//PATHNAME(2:LPATH)//CRLF))
     &	       GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (INPUT(:3).NE.'250') GOTO 10
	   INPUT = INFROM
	   I = INDEX(INPUT,'<')
	   IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN 
	       INPUT = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1)
	   ELSE IF (I.EQ.0.AND.INDEX(INPUT,'@').EQ.0) THEN
	       INPUT = INPUT(:TRIM(INPUT))//PATHNAME(:LPATH)
	   END IF
	   IF (.NOT.SMTP_WRITE_PACKET('MAIL FROM:<'//INPUT(:TRIM(INPUT))
     &	       //'>'//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (INPUT(:3).NE.'250') GOTO 10
	   SENDTO = SENDTO(INDEX(SENDTO,'"')+1:)
	   DO WHILE (INDEX(SENDTO,'"').GT.0)
	      SENDTO = SENDTO(:INDEX(SENDTO,'"')-1)//
     &			     SENDTO(INDEX(SENDTO,'"')+1:)
	   END DO
	   IF (.NOT.SMTP_WRITE_PACKET('RCPT TO:<'//SENDTO(:TRIM(SENDTO))
     &				   //'>'//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (INPUT(:3).NE.'250') GOTO 10
	   IF (.NOT.SMTP_WRITE_PACKET('DATA'//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (INPUT(:3).NE.'354') GOTO 10
	   HEADER_Q = HEADER_Q1
	   DO I=1,NHEAD
	      CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
	      IF (BTEST(FOLDER_FLAG,15).OR.INPUT(:8).NE.'Subject:') THEN
	         IF (.NOT.SMTP_WRITE_PACKET(INPUT(:TRIM(INPUT))//CRLF))
     &		    GOTO 10
	      ELSE
	         IF (.NOT.SMTP_WRITE_PACKET('Subject: '//
     &		    SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10
	      END IF
	   END DO
	   IF (NHEAD.EQ.0.AND.TRIM(SUBJECT).GT.0) THEN
	      IF (.NOT.SMTP_WRITE_PACKET('Subject: '//
     &		    SUBJECT(:TRIM(SUBJECT))//CRLF)) GOTO 10
	      NHEAD = 1
	   END IF
	   IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10
	   IF (NEWSBULL) THEN
	      IF (.NOT.SMTP_WRITE_PACKET('This message was posted via '//
     &		'a folder with a news group associated with it.'//CRLF))
     &		GOTO 10
	      IF (.NOT.SMTP_WRITE_PACKET('It will continue to attempt to'//
     &	   	' be posted to the news group using the file:'//CRLF))
     &		GOTO 10
	      IF (.NOT.SMTP_WRITE_PACKET(FILE(:TRIM(FILE))//CRLF)) GOTO 10
	      IF (.NOT.SMTP_WRITE_PACKET('If necessary, you can either'//
     &		' delete the file or edit it to fix it.'//CRLF)) GOTO 10
	      IF (.NOT.SMTP_WRITE_PACKET('If you edit it, '//
     &		'delete old versions.'//CRLF)) GOTO 10
	      IF (.NOT.SMTP_WRITE_PACKET(CRLF)) GOTO 10
	   END IF
	   OPEN (UNIT=3,FILE=FILE,STATUS='OLD',IOSTAT=IER2)
	   DO WHILE (IER2.EQ.0)
	      READ (3,'(Q,A)',IOSTAT=IER2) L,INPUT
	      IF (IER2.EQ.0) THEN
		 IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) IER2 = 2
	      END IF
	   END DO
	   CLOSE (UNIT=3)
	   IF (IER2.EQ.2) GOTO 10
	   IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IER2 = 1
	   GOTO 20
10	   IER2 = 2
20	   CALL SMTP_DISCONNECT()
	   IF (IER1.EQ.0) THEN
	      IF (IER2) THEN
		 CLOSE (UNIT=8,STATUS='DELETE')
	      ELSE
		 CLOSE (UNIT=8)
	      END IF
	   END IF
	   CALL ENABLE_PRIVS
	   STATUS = 1
	   RETURN
	END IF

	C = 0

	CALL LIB$ESTABLISH(MAIL_ERROR)

	IER = SYS_TRNLNM('BULL_PERSONAL_NAME',INPUT)
	IF (IER) THEN 
           CALL INIT_ITMLST
	   CALL ADD_2_ITMLST(TRIM(INPUT),MAIL$_SEND_PERS_NAME,
     &				%LOC(INPUT))
           CALL END_ITMLST(SEND_ITMLST)
	   STATUS = MAIL$SEND_BEGIN(C,%VAL(SEND_ITMLST),0)
	   IF (.NOT.STATUS) GO TO 100
	ELSE
	   STATUS = MAIL$SEND_BEGIN(C,0,0)
	   IF (.NOT.STATUS) GO TO 100
	END IF

	J = 1
	DO WHILE (J.LE.TRIM(SENDTO))
	   I = INDEX(SENDTO(J:),',') - 1
	   IF (I.EQ.-1) I = TRIM(SENDTO(J:))
           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)
           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))
        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)
        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
        END



	FUNCTION MAIL_ERROR(SIGARGS,MECHARGS)

	MAIL_ERROR = .TRUE.

	CALL SYS$PUTMSG(SIGARGS,,)

	RETURN
	END




        SUBROUTINE SET_NEWS

        IMPLICIT INTEGER (A-Z)

        INCLUDE '($SSDEF)'

        INCLUDE 'BULLUSER.INC'

        INCLUDE 'BULLFOLDER.INC'

        INCLUDE 'BULLFILES.INC'

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

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /NEXT/ NEXT

	COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE
	CHARACTER*80 BULLNEWSDIR_FILE

	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 IF

	ENTRY SHOW_NEWS

	LIMIT = -2
	IF (CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)) THEN
	   IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),LIMIT,,%VAL(1))
	   IF (.NOT.IER.OR.LIMIT.LT.-1) THEN
	      WRITE (6,'('' ERROR: Invalid value for LIMIT.'')')
	      RETURN
	   END IF   
	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))
	   IF (.NOT.IER.OR.(EXPIRE.LE.0.AND.CLI$PRESENT('DEFAULT'))) THEN
	      WRITE (6,'('' ERROR: Invalid value for EXPIRATION.'')')
	      RETURN
	   END IF   
        END IF

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

	IF (CLI$PRESENT('DEFAULT')) THEN
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)
	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
	      RETURN
	   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')) THEN
	      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)) THEN
		 OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),
     &					STATUS='OLD',IOSTAT=IER)
	     	 CLOSE (UNIT=3,DISPOSE='DELETE')
              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 DO
                 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)
              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_COUNT
	      FOLDER1 = BULL_PARAMETER
 	      FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)
	      CALL WRITE_FOLDER_FILE_TEMP(IER)
	      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 = TEMP
	      REWRITE (7) NEWS_FOLDER1_COM
 	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)
	   END IF	
 	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
	      RETURN
	   END IF
	END IF

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

	CLASS = CLI$PRESENT('CLASS')
	DEFAULT = CLI$PRESENT('DEFAULT')
	ALL = CLI$PRESENT('ALL')
 	IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE.
	DISABLE = CLI$PRESENT('DISABLE')
      	ENABLE = CLI$PRESENT('ENABLE')
     	PRIVATE = CLI$PRESENT('PRIVATE')
     	NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED)
	
	STORED = 0
	IF (CLI$PRESENT('STORED')) THEN
	   STORED = 1
	   IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN 
	      F1_LAST = 0
	      F1_COUNT = 0
	      F1_START = 0
	      F1_NBULL = 0
	      NEWS_F1_FIRST = 0
	      NEWS_F1_END = 0
           END IF
	   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
	      RETURN
           END IF
	   IF (DEFAULT) THEN
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))
     &			//'[.BULLNEWS*]*.*;*')
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))
     &			//'BULLNEWS*.DIR;*')
	   ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THEN
              CALL CLOSE_BULLNEWS
	      FOLDER_SAVE = FOLDER
	      IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN
                 FOLDER_NUMBER = FOLDER1_NUMBER
                 CALL SELECT_FOLDER(.FALSE.,IER)
	      END IF
	      FOLDER = FOLDER_SAVE
              CALL OPEN_BULLDIR
	      CALL CLOSE_BULLDIR_DELETE
              CALL OPEN_BULLNEWS_SHARED 
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER)
	      F1_START = 0
	      F1_NBULL = 0
	      F1_COUNT = 0 
              F1_LAST = 0
           END IF
           FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)
	   FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)
        END IF

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

	IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)
	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 
           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) THEN
              WRITE (6,'('' For class '',A,'':'')') GROUP(:LG)
	   END IF
           IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')')	
           IF (BTEST(FOLDER1_FLAG,8)) THEN
              WRITE (6,'('' Default is stored.'')')
           ELSE
              WRITE (6,'('' Default is not stored.'')')
           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) THEN
              WRITE (6,'('' Expiration is DEFAULT value.'')')
           ELSE
              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 
              WRITE (6,'('' Expiration limit is DEFAULT value.'')')
           ELSE
              WRITE (6,'('' There is no default expiration limit.'')')
           END IF
           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)
           WRITE (6,'('' For news group '',A,'':'')') 
     &			FOLDER1_NAME(:TRIM(FOLDER1_NAME))
           WRITE (6,'('' Disable is set.'')')
	ELSE
	   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,,,)
              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,,,)
           IF (F1_EXPIRE_LIMIT.GT.0) THEN
              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)) THEN
	      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.
           SET_FLAG_NEWS = .FALSE.
	   BRIEF_FLAG_NEWS = .FALSE.
 	   CALL OPEN_BULLINF_SHARED
           DO WHILE (REC_LOCK(IER1))
              READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC
       	   END DO
	   IF (IER1.EQ.0) THEN
	      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_FLAG_NEWS = BTEST(INF_REC2(2,I),13)
	         SET_FLAG_NEWS = BTEST(INF_REC2(2,I),14)
	         BRIEF_FLAG_NEWS = BTEST(INF_REC2(2,I),15)
		 WRITE (6,'('' This is a default news group.'')')
              ELSE
	         IER1 = 2
	      END IF
           END IF
           NOTIFY_PERM_FLAG_NEWS = .FALSE.
           SET_PERM_FLAG_NEWS = .FALSE.
	   BRIEF_PERM_FLAG_NEWS = .FALSE.
           DO WHILE (REC_LOCK(IER2))
              READ (9,KEY='*PERM',IOSTAT=IER2) TEMP_USER,INF_REC
       	   END DO
	   IF (IER2.EQ.0) THEN
	      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.'')')
	      END IF
           END IF
	   PERM = .FALSE.
	   IF (SET_FLAG_NEWS) THEN
	      IF (BRIEF_FLAG_NEWS) THEN
	         IF (SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN
	            PERM = .TRUE.
		    WRITE (6,'('' Default is BRIEF, which is permanent.'')')
		 ELSE
		    WRITE (6,'('' Default is BRIEF.'')')
		 END IF
	      ELSE
	        IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THEN
	           PERM = .TRUE.
		   WRITE (6,'('' Default is READNEW, which is permanent.'')')
		ELSE
		   WRITE (6,'('' Default is READNEW.'')')
		END IF
	      END IF
	   ELSE IF (BRIEF_FLAG_NEWS) THEN
	      IF (.NOT.SET_PERM_FLAG_NEWS.AND.BRIEF_PERM_FLAG_NEWS) THEN
	         PERM = .TRUE.
		 WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')
	      ELSE
		 WRITE (6,'('' Default is SHOWNEW.'')')
    	      END IF
	   END IF
	   IF (.NOT.PERM) THEN
	    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) THEN
		 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 = 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 IF

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

 	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) THEN
	      CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER)
	   END IF
	   FOUND = .FALSE.
	   MODALL = INDEX(GROUP,'.').NE.LG
           DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.
     &			GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))
 	      FOUND = .TRUE.
	      IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN 
	         CALL CLOSE_BULLNEWS
                 FOLDER_NUMBER = -1
                 CALL SELECT_FOLDER(.FALSE.,IER)
	         IF (IER) THEN
                    CALL OPEN_BULLDIR
                    CALL CLOSE_BULLDIR_DELETE
	         END IF
	         CALL OPEN_BULLNEWS_SHARED
           	 CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
                 F1_LAST = 0
                 F1_COUNT = 0
		 F1_START = 0
		 F1_NBULL = 0
	         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 = 0
		 F1_START = 0
		 F1_NBULL = 0
		 NEWS_F1_FIRST = 0
                 NEWS_F1_END = 0
	         FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8)
              END IF
              IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0
              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 DO
	   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)
              DELETE (7) 
	      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 = 0
	         CALL SELECT_FOLDER(.FALSE.,IER)
                 WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &              FOLDER(:TRIM(FOLDER))
	      END IF
	      RETURN
           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 = 0
              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 = 0
		 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)
	      IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)
	      IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9)
	      CALL REWRITE_FOLDER_FILE_TEMP(IER)
	   END DO	   
	END IF

	FOLDER_NUMBER = -1
	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))
	END IF

	CALL CLOSE_BULLNEWS

        RETURN
        END




	SUBROUTINE INCLUDE(EXCLUDE)

	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 /LAST_BUFFER/ OLD_BUFFER
 	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER TODAY*24

	DIMENSION BTIM(2)

	ALL = CLI$PRESENT('ALL')
	FULL = CLI$PRESENT('FULL')
	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
	      RETURN
	   END IF

	   CALL OPEN_BULLFIL_SHARED	! Open BULLETIN file

	   ILEN = LINE_LENGTH + 1

	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
	      IF (CLI$PRESENT('SUBJECT')) THEN
	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      ELSE
	         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:)
	      ELSE
		 INPUT = DESCRIP
	      END IF
	   END IF
	   LEN_P = TRIM(INPUT)
	   CALL CLOSE_BULLFIL
	END IF

	SUB = CLI$PRESENT('SUBJECT')
	DISABLE = CLI$PRESENT('DISABLE')
	EXC = 0

	GO TO 5

	ENTRY INCLUDE_SUBJECT(EXCLUDE)

	IF (REMOTE_SET.GE.3.AND.NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) RETURN

	LEN_P = TRIM(INPUT)
	ALL = .FALSE.
	DISABLE = .FALSE.
	SUB = .TRUE.
	EXC = -1

5	IF (SUB) THEN
	   IF (DISABLE) THEN
	      IF (STREQ(INPUT(:3),'RE:')) INPUT = INPUT(5:)
	      INPUT = INPUT(:MIN(LEN_P,LEN(DESCRIP)))
	      LEN_P = TRIM(INPUT)
	   END IF
	   INPUT = 'SUBJECT:'//INPUT
	   LEN_P = LEN_P + 8
	ELSE
	   INPUT = 'FROM:'//INPUT
	   LEN_P = LEN_P + 5
	END IF

	IF (EXCLUDE) THEN
	   INPUT = ':exclude:'//INPUT
	   LEN_P = LEN_P + 9
	ELSE
	   INPUT = ':include:'//INPUT
	   LEN_P = LEN_P + 9
	END IF

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

	FLEN = TRIM(FOLDER_NAME)
	INPUT = FOLDER_NAME(:FLEN)//INPUT
    	ILEN = FLEN + LEN_P

	IF (EXC.EQ.0) THEN
	   EXC = -1
	   IER = CLI$GET_VALUE('LIMIT',BULL_PARAMETER,LEN_P)
	   IF (IER) THEN
	      DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER,IOSTAT=IER) EXC
	      IF (EXC.LT.0.OR.EXC.GT.999.OR.IER.NE.0) THEN 
	         WRITE(6,'('' ERROR: Valid limit is 0-999.'')')
	         RETURN
	      END IF
	   END IF
	END IF

	CHECK_ONLY = .FALSE.

	GO TO 100

	ENTRY CHECK_EXCLUDES

	CHECK_ONLY = .TRUE.
	DISABLE = .TRUE.
	LEN_P = 0
	INPUT = ' '
	ILEN = 1

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

	CALL DISABLE_PRIVS

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

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

	CALL ENABLE_PRIVS

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

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

	IER = 0
	CONVERT = .FALSE.
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER
	   I = STRFIND(OLD_BUFFER,':RE: ')
	   IF (IER.EQ.0) THEN
	      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)
		    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(:ILEN),INPUT(:ILEN)).AND.
     &		OLD_BUFFER(ILEN+1:ILEN+1).EQ.':').OR.
     &		(OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND.
     &		 STREQ(OLD_BUFFER(:OLEN),INPUT(:OLEN))).OR.
     &	         (DISABLE.AND.I.GT.0.AND.
     &	         ((STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:MAX(I+5,ILEN+4)),
     &		   INPUT(:ILEN)).AND.OLD_BUFFER(ILEN+5:ILEN+5).EQ.':').OR.
     &		   (OLEN.LT.ILEN.AND.INPUT(OLEN+1:OLEN+1).EQ.':'.AND.
     &		    STREQ(OLD_BUFFER(:I)//OLD_BUFFER(I+5:OLEN),
     &		    INPUT(:OLEN)))))) THEN 
	         CONTINUE
 	      ELSE IF (.NOT.(ALL.AND.STREQ(INPUT(:FLEN+8),
     &		OLD_BUFFER(:MIN(FLEN+8,OLEN))))) THEN
		 IER2 = OLD_BUFFER(:1).EQ.':'.OR.
     &			INDEX(OLD_BUFFER,':defaults:').GT.0
		 IF (.NOT.IER2) THEN
		    CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC1,BLIMIT,BDATE,IER1)
		    IF (IER1) IER2 = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1)
     &		    		     ,' ').GT.-EXC1
		    CONVERT = .NOT.IER1
		 END IF
		 IF (.NOT.IER1.OR.EXC1.EQ.0.OR.IER2)
     &	            WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)
	      END IF
	   END IF
	END DO

	IF (.NOT.DISABLE) THEN
	   IF (FULL) THEN
	      WRITE (4,'(A)',IOSTAT=IER) FOLDER_NAME(:FLEN)//':defaults:kill'
	   ELSE
	      CALL ADD_EXCL(INPUT,ILEN,EXC)
	      WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)
	   END IF
	END IF

	IF (CONVERT) THEN 
	   WRITE (6,'('' NOTE: See help on the new SET EXLIMIT command.'')')
	END IF

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

	CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
     &			     BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1')
    
	IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM

	RETURN
	END



	SUBROUTINE UPDATE_EXCLUDE

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED
	DATA SCRATCH_B1/0/,NINCLUDE/0/,EXC_CHANGED/.FALSE./

	CHARACTER TODAY*24

	DIMENSION BTIM(2)

	IF (.NOT.EXC_CHANGED) RETURN
	EXC_CHANGED = .FALSE.

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

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

	CALL DISABLE_PRIVS

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

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

	CALL ENABLE_PRIVS

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

	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT
	   IF (.NOT.(IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.
     &		INPUT(:MIN(TRIM(FOLDER_NAME)+1,ILEN)).AND.INPUT(:1).NE.':'
     & 		.AND.INDEX(INPUT,':defaults:').EQ.0)) THEN 
	      IF (IER.EQ.0) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)
	   END IF
	END DO

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header
	DO I=1,NINCLUDE
	   CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)
	   WRITE (4,'(A)',IOSTAT=IER) INPUT(:TRIM(INPUT))
	END DO

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

	CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
     &			     BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1')

	IF (.NOT.CHECK_ONLY) CALL CHECK_CUSTOM

	RETURN
	END




	SUBROUTINE SET_CUSTOM(PARAM)
C
C  SUBROUTINE SET_CUSTOM
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT
	DATA EXCLUDE_LIMIT /0/

	CHARACTER*(*) PARAM

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

	CALL DISABLE_PRIVS

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

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

	CALL ENABLE_PRIVS

	IF (IER.NE.0) THEN
	   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 DO

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

	IF (PARAM.EQ.'exclude_limit')
     &		DECODE(ILEN,'(I<ILEN>)',INPUT(:ILEN)) EXCLUDE_LIMIT

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

	CALL LIB$RENAME_FILE(BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
     &			     BULL_PARAMETER(:TRIM(BULL_PARAMETER))//';1')

	CALL CHECK_CUSTOM

        RETURN
        END




	SUBROUTINE CHECK_CUSTOM

	IMPLICIT INTEGER (A-Z)

	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,NINCLUDE,EXC_CHANGED

	COMMON /FILE_DIRECTORY/ FILE_DIRECTORY
	CHARACTER*64 FILE_DIRECTORY

	COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT
	DATA EXCLUDE_LIMIT /0/

	DIMENSION BTIM(2)

	FILE_DIRECTORY = ' '

	IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THEN
	   BULL_USER_CUSTOM = .FALSE.
	ELSE
	   BULL_USER_CUSTOM = .FALSE.
	   BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4)
	END IF

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

	OPEN(UNIT=17,FILE=OLD_BUFFER(:TRIM(OLD_BUFFER)),
     &	    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)
	   SCRATCH_B1 = SCRATCH_B		! Init header pointer
	END IF

	NINCLUDE = 0
	OLD_FORMAT = .FALSE.
	FLEN = TRIM(FOLDER_NAME)
	DO WHILE (IER.EQ.0)
	   READ (17,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFER
	   IF (IER.EQ.0.AND.STREQ(FOLDER_NAME(:FLEN)//':',
     &		OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN
	      BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,1)
	      CALL LOWERCASE(OLD_BUFFER)
	      IF (INDEX(OLD_BUFFER(FLEN+2:),'defaults')
     &		.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 CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1)
		 OLD_FORMAT = OLD_FORMAT.OR.(.NOT.IER1)
		 IF (COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ').GT.-EXC
     &		     .OR.EXC.EQ.0) THEN
	            CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)
	            NINCLUDE = NINCLUDE + 1
		 ELSE
		    EXC_CHANGED = .TRUE.
		 END IF
	      END IF
	   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)
	      IF (INDEX(OLD_BUFFER,':file_directory').GT.0)
     &	                 FILE_DIRECTORY = OLD_BUFFER(17:)
	      IF (INDEX(OLD_BUFFER,':exclude_limit').GT.0) THEN 
	         DECODE(OLEN-15,'(I<OLEN-15>)',OLD_BUFFER(16:),IOSTAT=IER1)
     &	                EXCLUDE_LIMIT
	         EXCLUDE_LIMIT = MIN(999,EXCLUDE_LIMIT)
	      END IF
	   END IF
	END DO

	CLOSE (UNIT=17)
	
	IF (OLD_FORMAT) CALL CHECK_EXCLUDES

        RETURN
	END



	
	LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

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

	COMMON /DIRMODE/ DIRMODE

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED

	CHARACTER*(*) STRING,STRING1
	CHARACTER*132 ADDRESS

	CHARACTER*12 EXFROM

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

	MATCH_FROM = .FALSE.
	SYSTEM = IBCLR(SYSTEM,8)

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header

	FLEN = TRIM(FOLDER_NAME)

	DO I=1,NINCLUDE
	   OLD_SCRATCH_B = SCRATCH_B
	   CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)
	   OLEN = TRIM(OLD_BUFFER)
	   CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1)
	   IF (DIRMODE) BLIMIT = MIN(BLIMIT,FLEN+17+LEN(DESCRIP))
	   MATCH = .FALSE.
	   IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:')) THEN
	      CALL GET_FROM(EXFROM,OLD_BUFFER(FLEN+15:),
     &			    TRIM(OLD_BUFFER(FLEN+15:)))
	      IF (STREQ(ADDRESS(STRING),ADDRESS(OLD_BUFFER(FLEN+15:
     &		  TRIM(OLD_BUFFER(FLEN+15:BLIMIT))+FLEN+14))).OR.
     &		  (DIRMODE.AND.STREQ(FROM,EXFROM))) THEN
		 MATCH = .TRUE.
		 MATCH_FROM = .TRUE.
	      END IF
	   ELSE IF (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.
     &	       STRFIND(STRING1(:TRIM(STRING1)),
     &		       OLD_BUFFER(FLEN+18:BLIMIT)).GT.0) THEN
	      MATCH = .TRUE.
	   END IF
	   IF (MATCH) THEN
	      CDATE = COMPARE_DATE(OLD_BUFFER(BDATE:OLEN-1),' ')
	      IF (CDATE.NE.0.AND.EXC.NE.0) THEN
		 IF (OLD_BUFFER(BLIMIT+1:BLIMIT+1).EQ.':') EXC = -1
		 CALL ADD_EXCL(OLD_BUFFER,BLIMIT,EXC)
		 CALL WRITE_QUEUE(%VAL(OLD_SCRATCH_B),OLD_SCRATCH_B,
     &			     OLD_BUFFER)
		 EXC_CHANGED = .TRUE.
	      END IF
	      IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THEN
		 SYSTEM = IBSET(SYSTEM,8)
		 INCLUDE_MSG = .TRUE.
	      ELSE IF (.NOT.BTEST(SYSTEM,8).OR.MATCH_FROM) THEN
C
C  Only "from" matches override threads, but not subject matches.
C
		 INCLUDE_MSG = .FALSE.
		 SYSTEM = IBCLR(SYSTEM,8)
		 IF (MATCH_FROM) RETURN
	      END IF
	   END IF
	END DO

	RETURN
	END



	FUNCTION STRFIND(STRING,STRING1)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) STRING,STRING1

	L = LEN(STRING1)
	DO I=0,LEN(STRING)-L
	   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.OR..NOT.ALPHA(STRING1(J:J))
     &		  .OR..NOT.ALPHA(STRING(I+J:I+J)))) THEN
		 J = L + 1
	      ELSE IF (J.EQ.L) THEN
		 STRFIND = I + 1
		 RETURN
	      ELSE
	         J = J + 1
	      END IF
	   END DO
	END DO

	STRFIND = 0

	RETURN
	END




	SUBROUTINE SHOW_EXCLUDE(TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

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

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_CHANGED

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
	LOGICAL PAGING

	IF (.NOT.BTEST(BULL_USER_CUSTOM,1)) THEN
	   IF (TYPE.EQ.0) WRITE (6,'('' There are no excludes.'')')
	   IF (TYPE.EQ.1) WRITE (6,'('' There are no threads.'')')
	   RETURN
	END IF

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header

	FLEN = TRIM(FOLDER_NAME)

	FOUND = .FALSE.

	L = 1
	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)))
     &         .AND.((TYPE.EQ.1.AND.STREQ(OLD_BUFFER(FLEN+2:FLEN+8),
     &	       'INCLUDE')).OR.(TYPE.EQ.0.AND.STREQ(
     &	       OLD_BUFFER(FLEN+2:FLEN+8),'EXCLUDE')))) THEN
	      IF (.NOT.FOUND) THEN
	         IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'Excludes for '
		 IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'Threads for '
		 WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':'
	         FOUND = .TRUE.
 	      END IF
	      CALL CHECK_EXCL(OLD_BUFFER,OLEN,EXC,BLIMIT,BDATE,IER1)
	      IF (BLIMIT+5-FLEN.GT.PAGE_WIDTH.AND.L+2.GT.PAGE_LENGTH-1) THEN
	         L = L + 2
	      ELSE
		 IF (L.EQ.0) THEN 
	            WRITE (6,'(''+'',A,$)') OLD_BUFFER(FLEN+10:
     &		      MIN(BLIMIT,PAGE_WIDTH+FLEN+9))
		 ELSE
	            WRITE (6,'(1X,A,$)') OLD_BUFFER(FLEN+10:
     &		      MIN(BLIMIT,PAGE_WIDTH+FLEN+9))
		 END IF
		 IF (OLD_BUFFER(BDATE+1:BDATE+1).EQ.'-')
     &		     OLD_BUFFER(BDATE:) = ' '//OLD_BUFFER(BDATE:)
		 OUTLEN = MIN(BLIMIT,PAGE_WIDTH+FLEN+9)-FLEN-9
		 IF (OUTLEN.GT.PAGE_WIDTH-16) THEN
		    WRITE (6,'(1X,<PAGE_WIDTH-15>X,A,1X,I3)')
     &		       OLD_BUFFER(BDATE:INDEX(OLD_BUFFER
     &		       (BDATE:),':')+BDATE-2),EXC
		    L = L + 2
		 ELSE
		    WRITE (6,'(''+'',<PAGE_WIDTH-15-OUTLEN>X,A,1X,I3)')
     &		       OLD_BUFFER(BDATE:INDEX(OLD_BUFFER
     &		       (BDATE:),':')+BDATE-2),EXC
		    L = L + 1
		 END IF
	      END IF
              IF (PAGING.AND.L.EQ.PAGE_LENGTH-1) THEN
                 L = 0                        ! Reinitialize screen counter
	         CALL LIB$PUT_OUTPUT(' ')
		 CALL GET_INPUT_NOECHO_PROMPT(
     &				INPUT(:1),'Press key to continue ... ')
             	 IER = LIB$ERASE_PAGE(1,1)         ! Erase display
	      END IF
	   END IF
	END DO

	IF (.NOT.FOUND) THEN
	   IF (TYPE.EQ.0) WRITE (6,'(1X,A,$)') 'No excludes found for '
	   IF (TYPE.EQ.1) WRITE (6,'(1X,A,$)') 'No threads found for '
	   WRITE (6,'(A)') '+'//FOLDER_NAME(:FLEN)//':'
	END IF

	RETURN
	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)
	COMMON /USERINFO/ LAST(2,FOLDER_MAX)

	CHARACTER*12 NEW,OLD

	IF (.NOT.SETPRV_PRIV()) THEN
	   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_USER
        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 IF

	CALL OPEN_BULLINF_SHARED

        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)
	END DO 
	IF (IER.NE.0) THEN
	   WRITE (9,IOSTAT=IER) NEW,LAST
	ELSE
	   REWRITE (9,IOSTAT=IER) NEW,LAST
	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) THEN
           DO WHILE (REC_LOCK(IER))
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO 
	   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))
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO 
	   IF (IER.EQ.0) DELETE (9)
	END IF
	OLD(LENO:LENO) = CHAR(127.AND.ICHAR(OLD(LENO:LENO)))
	NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN)))

	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)))
	ELSE
	   OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2)))
	END IF
	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)))
	ELSE
	   NEW(2:2) = CHAR(128.OR.ICHAR(NEW(2:2)))
	END IF
        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))
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO 
	   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))
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO 
	   IF (IER.EQ.0) DELETE (9)
	END IF

	CALL CLOSE_BULLINF

        RETURN
        END


	SUBROUTINE CHECK_EXCL(BUFFER,L,EXC,BLIMIT,BDATE,IER)

        IMPLICIT INTEGER (A-Z)

	COMMON /EXCLUDE_LIMIT/ EXCLUDE_LIMIT

        CHARACTER*(*) BUFFER

	DIMENSION BTIM(2)

	BLIMIT = L
	BDATE = L+3

	IER = BUFFER(L:L).EQ.':'
	IF (IER) THEN
	   I = LAST_INDEX(BUFFER(:L-1),':')
	   IF (I.GT.0) THEN
	      J = LAST_INDEX(BUFFER(:I-1),':')
	      IF (J.GT.0) THEN
		 IF (J.LT.I-1) THEN
		    DECODE(I-J-1,'(I<I-J-1>)',BUFFER(J+1:I-1),IOSTAT=IER) EXC
		    IER = IER.EQ.0
		 ELSE
		    EXC = EXCLUDE_LIMIT
		 END IF
		 IF (IER) BLIMIT = J - 1
		 CALL STR$UPCASE(BUFFER(I+1:L-1),BUFFER(I+1:L-1))
		 IF (IER) IER = SYS_BINTIM(BUFFER(I+1:L-1),BTIM)
		 BDATE = I + 1
	      END IF
	   ELSE
	      IER = .FALSE.
	   END IF
	END IF

	IF (.NOT.IER) CALL ADD_EXCL(BUFFER,L,-1)

	RETURN
	END	



	SUBROUTINE ADD_EXCL(BUFFER,L,EXC)

        IMPLICIT INTEGER (A-Z)

	DIMENSION BTIM(2)

        CHARACTER*(*) BUFFER
	
	CHARACTER TODAY*24

	IF (EXC.EQ.-1) THEN
	   BUFFER = BUFFER(:L)//':'
	ELSE
	   BUFFER = BUFFER(:L)//':'
	   WRITE (BUFFER(L+2:),'(I3)') EXC
	   IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:)
	   IF (BUFFER(L+2:L+2).EQ. ' ') BUFFER(L+2:) = BUFFER(L+3:)
	END IF

	CALL SYS$ASCTIM(,TODAY,,)		! Get the present time
	IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)
	BUFFER = BUFFER(:TRIM(BUFFER))//':'//TODAY(:INDEX(TODAY,' ')-1)//':'

	L = TRIM(BUFFER)

	RETURN
	END	




	CHARACTER*(*) FUNCTION ADDRESS(INPUT)

	IMPLICIT INTEGER (A - Z)

	CHARACTER*(*) INPUT

	ADDRESS = INPUT

	IF (INDEX(INPUT,'@').EQ.0) RETURN

	I = INDEX(INPUT,'<')
	IF (I.GT.0.AND.INDEX(INPUT(I+1:),'@').GT.0) THEN ! Name may be of form
	   ADDRESS = INPUT(INDEX(INPUT,'<')+1:INDEX(INPUT,'>')-1)
						! personal-name <net-name>
	ELSE
	   ADDRESS = INPUT(:MINGT0(TRIM(INPUT),INDEX(INPUT,' ')-1))
	   IF (INDEX(ADDRESS,'(').GT.0)
     &	       ADDRESS = ADDRESS(:INDEX(ADDRESS,'(')-1)
	END IF

	RETURN
	END




	SUBROUTINE SEND_MAIL

	IMPLICIT INTEGER (A-Z)

	PARAMETER CRLF = CHAR(13)//CHAR(10)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFILES.INC'

	C = 0
	DO WHILE (LIB$FIND_FILE(FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &			//'*.SMTP',INPUT,C))
	   OPEN (UNIT=8,FILE=INPUT(:TRIM(INPUT)),IOSTAT=IER,RECL=256)
	   IF (IER.NE.0) GOTO 30
	   IF (.NOT.SMTP_CONNECT()) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (INPUT(:3).NE.'220') GOTO 10
	   DO I=1,3
	      READ (8,'(Q,A)',IOSTAT=IER) L,INPUT
	      IF (IER.NE.0) GOTO 10
	      IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10
	      IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	      IF (INPUT(:3).NE.'250') GOTO 10
	   END DO
	   READ (8,'(Q,A)',IOSTAT=IER) L,INPUT
	   IF (IER.NE.0) GOTO 10
	   IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (INPUT(:3).NE.'354') GOTO 10
	   DO WHILE (IER.EQ.0)
	      READ (8,'(Q,A)',IOSTAT=IER) L,INPUT
	      IF (IER.EQ.0) THEN
	         IF (.NOT.SMTP_WRITE_PACKET(INPUT(:L)//CRLF)) GOTO 10
	      END IF
	   END DO
	   IF (.NOT.SMTP_WRITE_PACKET('.'//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   IF (.NOT.SMTP_WRITE_PACKET('QUIT'//CRLF)) GOTO 10
	   IF (SMTP_READ_PACKET(INPUT).EQ.0) GOTO 10
	   CLOSE (UNIT=8,STATUS='DELETE')
	   GOTO 20
10	   CLOSE (UNIT=8)
20	   CALL SMTP_DISCONNECT()
30	   CONTINUE
	END DO

	CALL EXIT
	END
