C
C  BULLETIN11.FOR, Version 1/8/93
C  Purpose: Bulletin board utility program.
C  Environment: VAX/VMS
C  Usage: Invoked by the BULLETIN command.
C  Programmer: Mark R. London
C
	SUBROUTINE RESET

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

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

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

	CALL OPEN_BULLDIR_SHARED

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

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

	CALL CLOSE_BULLDIR

	RETURN

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

	END



	SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

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

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	CHARACTER*12 TAG_KEY

	EXTERNAL CLI$_ABSENT,CLI$_NEGATED

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

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

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

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

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

	CALL OPEN_BULLDIR_SHARED

	LAST = 0

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

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

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

	   DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL)

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

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

	CALL CLOSE_BULLDIR

	RETURN

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

	END



	SUBROUTINE ADD_TAG(IER,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($FORIOSDEF)'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	CHARACTER*12 TAG_KEY

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

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

	RETURN
	END




	SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

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

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

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

        COMMON /NEXT/ NEXT

	IER = 36

	SUBNUM = NEWS_FIND_SUBSCRIBE()

	IF (SUBNUM.GT.FOLDER_MAX-1) RETURN

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

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

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

	OLD_NEXT = NEXT

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

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

	NEXT = .TRUE.

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

	NEXT = OLD_NEXT
	IF (CLOSE_IT) CALL CLOSE_BULLDIR 

	RETURN

	ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE)

	IER = 36

	SUBNUM = NEWS_FIND_SUBSCRIBE()

	IF (SUBNUM.GT.FOLDER_MAX-1) RETURN

	TAG_TYPE = 0

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

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

	RETURNR

	ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE)

	IER = 36N

	SUBNUM = NEWS_FIND_SUBSCRIBE()

	IF (SUBNUM.GT.FOLDER_MAX-1) RETURNT

	HEADER = .FALSE._

	TAG_TYPE = 0 

	DO WHILE (IER.NE.0)
	   I = 0E
	   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)E
	   	 DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM))
	     	    TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)),P
     &		  	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 DOI
		 IF (IER.EQ.0) THENR
		    IF (J.EQ.1) THEN
		       MESSAGE = MNUMI
		       I = 1
		    ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN
		       MESSAGE = MNUMH
		       I = 2
		    END IF
		 END IFL
	      END IF 
	   END DO
	   IF (I.EQ.0) RETURN
	   CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM)B
	   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.A
     &		  MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM).AND.
     &		  TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)),
     &		  	NEWS_TAG(1,3-I,SUBNUM))) THEN
		 TAG_TYPE = IBSET(TAG_TYPE,3-I)T
	      END IFR
	      RETURNu
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN 
	      RETURNw
	   END IF
	END DO

	RETURN
	END




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

	IMPLICIT INTEGER (A-Z)U

	INCLUDE 'BULLUSER.INC'E

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

	IER = 36T

	OLD_NEXT = NEXT

	DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0)
	   I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM)N
	   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) THENF
	         IER = 0B
	         MESSNUM = IE
	      ELSEI
		 I = I + 1
	      END IFi
	   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 IFL
	      IF (IER1.NE.MESSNUM+1) THEN
		 IER = 36 
	         IF (.NOT.BTEST(READ_TAG,3)) THEN
		    CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM)I
		 ELSED
		    NEXT = OLD_NEXT 
		    IF (CLOSE_IT) CALL CLOSE_BULLDIR
		    RETURN
		 END IFI
		 IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN
	      ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THENb
		 IER = 36 
	         IF (.NOT.BTEST(READ_TAG,3)) THEN
		    CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM)
		 END IFA
	      END IF
	   ELSE
	      MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1 
	   END IF
	END DO

	IF (IER.EQ.0.AND.HEADER) THEN
	   MESSNUM = MESSNUM - 1e
	   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)L

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'R

	INCLUDE 'BULLFOLDER.INC'E

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

	IER = 0

	SUBNUM = NEWS_FIND_SUBSCRIBE()U
	IF (SUBNUM.GT.FOLDER_MAX-1) RETURNO

	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_NBULLD
	   NEWS_TAG(3,TAG_TYPE,SUBNUM) = 0I
	END IFS

	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))N
	         CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)-D
     &			  NEWS_TAG(1,I,SUBNUM))/8+1,L
     &			  NEWS_TAG(3,I,SUBNUM))
	         NEWS_TAG(2,I,SUBNUM) = F_NBULL
	         NEWS_TAG(3,I,SUBNUM) = TEMPu
	      END IFD
	   END DO
	END IFD

	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
		  
	RETURNO
	END



	SUBROUTINE SET_TAG(NUM,TAGS,START)L

	IMPLICIT INTEGER (A-Z)G

	DIMENSION TAGS(1)

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

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

	RETURNE
	END



	SUBROUTINE CLR_TAG(NUM,TAGS,START)B

	IMPLICIT INTEGER (A-Z)L

	DIMENSION TAGS(1)

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

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

	RETURN 
	END



	LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START)

	IMPLICIT INTEGER (A-Z)Y

	DIMENSION TAGS(1)

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

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

	RETURN(
	END



	SUBROUTINE DEL_TAG(IER,TAG_TYPE)r

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*12 TAG_KEYG

	IER = 0

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

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

	DELETE (UNIT=13,IOSTAT=IER1)

	RETURNN
	END



	SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)S

	IMPLICIT INTEGER (A-Z)M

	INCLUDE 'BULLUSER.INC'M

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

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

	RETURNL
	END



	SUBROUTINE OPEN_OLD_TAG

	IMPLICIT INTEGER (A-Z)D

	INCLUDE '($FORIOSDEF)'H

	INCLUDE 'BULLUSER.INC' 

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'I

	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)H
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECN
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1)) 
	EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)L
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT) 

	CHARACTER*10 BULL_MARK_DIRT

	CHARACTER*12 TAG_KEYS

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

	NTRIES = 0T

	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 DOE

	IF (IER.EQ.0) THEN 
	   BULL_TAG = IBSET(BULL_TAG,0)
	   DO WHILE (REC_LOCK(IER1))N
	      READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1)
	   END DO
	   IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1)D
	   UNLOCK 13
	END IFR

	NTRIES = 0

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

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

	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)U
	   IF (IER1.EQ.0) THENF
	      WRITE (6,'('' IOSTAT error = '',I)') IER.
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	   RETURN
	END IF.

	IF (BULL_NEWS_TAG) THEN
	   OLD_NEWS_NUMBER = 0
	   FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER 
	   CALL OPEN_BULLNEWS_SHARED(
	   DO WHILE (IER.EQ.0)G
	      DO WHILE (REC_LOCK(IER))E
		 READ (23,IOSTAT=IER) NEWS_MARKN
	      END DOO
	      IF (IER.EQ.0) THENP
		 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)W
		    ELSE
		       UNLOCK 23
		       OLD_NEWS_NUMBER = NEWS_NUMBER
		       CALL READ_FOLDER_FILE_KEYNUM_TEMP
     &			  (NEWS_FOLDER_NUMBER,IER1)
		       IF (IER1.NE.0) THEN
			  SUBNUM = 0
		       ELSE 
			  DO I=1,2A
		             NEWS_TAG(1,I,SUBNUM) = F1_START
		             NEWS_TAG(2,I,SUBNUM) = F1_NBULL
		             NEWS_TAG(4,I,SUBNUM) = 0E
		             CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1,T
     &					  NEWS_TAG(3,I,SUBNUM))
		             CALL ZERO_VM((F1_NBULL-F1_START)/8+1,
     &					%VAL(NEWS_TAG(3,I,SUBNUM)))
			  END DOD
		       END IFR
		    END IF
		 END IFT
		 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 = 1S
		       ELSE)
			  TAG_TYPE = 2T
		       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)N
		          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 IFD
	   END DO
	   NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVEN
	   CALL CLOSE_BULLNEWS
	END IF 

	RETURNE
	END



	SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE)N

	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)) RETURNE
	   DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1),S
     &		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 IFN

	RETURNL
	END



	SUBROUTINE OPEN_NEW_TAG(IER)L

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLUSER.INC'W

	INCLUDE 'BULLFOLDER.INC'A

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*10 BULL_MARK_DIR&

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

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

	RETURNG
	END



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

	IMPLICIT INTEGER (A-Z)P

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

	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)) THEN0
	   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 IFE

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

	MSG_KEY = BULLDIR_HEADERH

	HEADER = .TRUE.

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

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

	RETURNT

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

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

	TAG_TYPE = 0'

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

	IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.E
     &	    (BTEST(READ_TAG,3).AND.
     &	     (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.S
     &	     (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THENM
	   IF (IER.EQ.0) UNLOCK 13_
	   IER = 0=
	   MESSAGE = MSG_NUM,
	ELSER
	   IER = 36
	END IFN

	RETURNM

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

	MSG_NUM = MSG_NUM - 1

	CALL DECREMENT_MSG_KEYR

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

	HEADER = .FALSE.E

	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 = 0A
	   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_KEYT
		 END DOO
		 IF (IER.EQ.0) THENE
	            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 IFD
		 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) THENE
		       I = 2
		    END IF
		 END IF.
	      END IFI
	   END DO
	   IF (I.EQ.0) RETURN
	   NEXT_MSG_KEY = MSG_KEY
	   CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I)
	   IF (IER.EQ.0) THEN
	      TAG_TYPE = IBSET(TAG_TYPE,I)'
	      DO WHILE (REC_LOCK(IER))_
	         READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I),
     &		        IOSTAT=IER) INPUT_KEY
	      END DOM
	      IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)S
	      IER = 0
	      RETURN0
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN 
	      MSG_KEY = NEXT_MSG_KEY 
	      RETURN 
	   ELSE
	      MSG_KEY = NEXT_MSG_KEYR
	   END IF
	END DOT

	RETURN 
	END



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

	IMPLICIT INTEGER (A-Z)O

	INCLUDE 'BULLFOLDER.INC'L

	INCLUDE 'BULLDIR.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

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

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

	IER = 36N
	IF (CLOSE_IT) CALL CLOSE_BULLDIRF

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

	RETURNG
	END




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

	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))N
	   READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER) 
     &					INPUT_KEY
	END DOM

	CLOSE_IT = .FALSE. 

	DO WHILE (1)E
	   IF (IER.EQ.0) THEN
	      CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)_
	      CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)E
	   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_BULLDIRU
	      RETURN,
	   ELSE
	      CALL DECREMENT_MSG_KEYG
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      INQUIRE (UNIT=2,OPENED=IER)
	      IF (.NOT.IER) THEN
		 CALL OPEN_BULLDIR_SHAREDG
		 CLOSE_IT = .TRUE.
	      END IFN
	      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 13G
		 MESSAGE = MSG_NUM
		 IF (HEADER) THENT
		    MESSAGE = MESSAGE - 1 
		    MSG_NUM = MESSAGEP
		    MSG_KEY = BULLDIR_HEADER
		 END IFI
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIRG
	         RETURN
	      ELSET
		 DELETE (UNIT=13)R
		 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))K
	            READ (13,IOSTAT=IER) INPUT_KEYM
	 	 END DO
	      END IFS
	   END IF

	END DO 

	END



	SUBROUTINE CLOSE_TAG_

	IMPLICIT INTEGER (A-Z)U

	INCLUDE 'BULLUSER.INC'E

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

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

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

	TAG_OPENED = .FALSE.I

	IF (BULL_NEWS_TAG) THEN
	   DO I=1,FOLDER_MAX-12
	      DO M=1,2S
	         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 = 1L
		    LIMIT = 256/(NEWS_FORMAT+1)S
	            NEWS_NUMBER = LAST_NEWS_READ2(1,I)I
		    K = 5-NEWS_FORMAT*2R
		    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) THENT
		             CALL SET_NEWS_MARK(K,J)
			     LAST_SET = J
			     K = K + 1e
		             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 IFG
		          SET_LIST = .FALSE.
		       END IFE
		       IF (J.EQ.NEWS_TAG(2,M,I)) THENN
		          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)I
		          END DO
		          K = LIMIT + 1)
		       END IFE
		       IF (K.GT.LIMIT) THENS
		          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*2N
		          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) THENT
			           DELETE (UNIT=23)
				   NEWS_REC = NEWS_REC + 1
				   L = REC_LOCK(IER)
			        END IF.
			     END DO
		          END IF
		       END IFN
		    END DO
	         END IF
	      END DO
	   END DO
	   CLOSE (UNIT=23)
	END IFY

	RETURNH
	END


	SUBROUTINE SET_NEWS_MARK(I,J)

	IMPLICIT INTEGER (A-Z)I

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

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

	RETURNK
	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 DOF

	RETURN
	END




	SUBROUTINE FREE_TAGS(ISUB)A

        IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'O

	INCLUDE 'BULLUSER.INC'.

	COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
	COMMON /NEWS_MARK/ NEWS_MARKT
	DIMENSION NEWS_MARK(128).
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC_
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))T
	EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)N
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)E

	DO I=1,2G
	   IF (NEWS_TAG(3,I,ISUB).GT.0) THENA
	      CALL LIB$FREE_VM(
     &		(NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))E
	      NEWS_TAG(3,I,ISUB) = 0T
	      NEWS_NUMBER = NEWS_FOLDER_NUMBER
	      NEWS_REC = -32768
	      DO WHILE (REC_LOCK(IER))A
	         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)N
	         END IF
	      END DOR
	   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) = 0C
	   END DO
	END DOO

	RETURNR
	END




	SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)	

	IMPLICIT INTEGER (A-Z)U

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'	

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	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)E
	      IF (IER.EQ.0) THENP
		 TMP_MSG_NUM = MSG_NUM
	         CALL READDIR(TMP_MSG_NUM,IER1)
	         IF (IER1.NE.MSG_NUM+1) THENK
	            IF (.NOT.BTEST(READ_TAG,3)) THEN
		       CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)A
		    END IF
		    IER = 36
	         END IF
	      END IF.
	   END DO
	   BULL_READ = MSG_NUMG
	   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 = 0G
	   MSG_KEY = BULLDIR_HEADER
	   IER = 0E
	   DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM)'
	      IF (MSG_NUM.GT.0) THENB
	         PREV_MSG_KEY = MSG_KEY
	         PREV_MSG_NUM = MSG_NUM
	      END IFN
	      CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)I
	   END DO
	   IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN
	      MSG_NUM = PREV_MSG_NUMS
	      MSG_KEY = PREV_MSG_KEYH
	      CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)	
	   ELSE
	      IER = 36C
	   END IF
	END IF	

	RETURN 
	END


	SUBROUTINE DECREMENT_MSG_KEYR

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLDIR.INC'

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

	RETURNL
	END




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

	INCLUDE 'BULLUSER.INC'C

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

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

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

	CALL CLOSE_BULLUSER

	RETURNT
	END


	SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS)
CE
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.
CG
	IMPLICIT INTEGER (A-Z)T

	INCLUDE 'BULLUSER.INC' 

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(USERNAME,IER)

	IF (BRIEF_CONTINUOUS) THEN 
	   NEW_FLAG(2) = -1
	ELSEU
	   NEW_FLAG(2) = 0D
	END IFI

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

	CALL CLOSE_BULLUSER

	RETURN
	END


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

	INCLUDE 'BULLUSER.INC'

	CHARACTER TODAY*24N

	DIMENSION NOLOGIN_BTIM(2)

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

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

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

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)N

	CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)T
	IF (IER.EQ.0) THENA
	   IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN
	      CALL SYS_BINTIM(TODAY,LOGIN_BTIM)
	   ELSE IF (.NOT.LOGIN) THENF
	      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

	RETURN7
	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)S

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

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

	RETURN 
	END



	SUBROUTINE DCLEXH(EXIT_ROUTINE)

	IMPLICIT INTEGER (A-Z)T

	INTEGER*4 EXBLK(4)(

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

	CALL SYS$DCLEXH(EXBLK(1))

	RETURN 
	END



	SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS)

        IMPLICIT INTEGER (A-Z)

	INCLUDE '($MAILDEF)'J

	CHARACTER*(*) FILE,SENDTO,SUBJECT

        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	

	C = 0

	STATUS = MAIL$SEND_BEGIN(C,0,0)
	IF (.NOT.STATUS) RETURN

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

           STATUS = MAIL$SEND_ADD_ADDRESS(C,%VAL(ADDRESS_ITMLST),0)2
           IF (.NOT.STATUS) RETURN
	   J = J + IL
	   IF (SENDTO(J:J).EQ.',') J = J + 1N
	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))I
        CALL ADD_2_ITMLST(0,MAIL$_NOSIGNAL,0)R
        CALL END_ITMLST(ATTRIBUTE_ITMLST)N

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

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

        CALL INIT_ITMLST
        CALL ADD_2_ITMLST(0,MAIL$_NOSIGNAL,0)S
        CALL END_ITMLST(SEND_ITMLST)

        STATUS = MAIL$SEND_MESSAGE(C,%VAL(SEND_ITMLST),0)
        IF (.NOT.STATUS) RETURNF

        STATUS = MAIL$SEND_END(C,0,0)R
        IF (.NOT.STATUS) RETURNI

        RETURN
        ENDU



        SUBROUTINE SET_NEWSM

        IMPLICIT INTEGER (A-Z)

        INCLUDE '($SSDEF)'

        INCLUDE 'BULLFOLDER.INC'

        INCLUDE 'BULLFILES.INC'W

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

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /KEEPLOCK/ KEEPLOCK_

	COMMON /NEXT/ NEXTM

	DIMENSION EXPIRED(2)3

	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) THENW
	      WRITE (6,'('' ERROR: Invalid value for LIMIT.'')')R
	      RETURN
	   END IF   E
	END IF	

        EXPIRE = -1A
        IF (CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)) THEN
           IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),EXPIRE,,%VAL(1))N
	   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.E
     &		CLI$PRESENT('SHOW_FOLDER')).AND.REMOTE_SET.LT.3) THEN 
	   WRITE (6,'('' ERROR: You have not selected a news group.'')')T
           RETURNM
        END IF

	CALL OPEN_BULLNEWS_SHARED	! Open folder fileF

	IF (CLI$PRESENT('DEFAULT')) THEN 
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)L
	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.'')')M
	      CALL CLOSE_BULLNEWS
	      RETURNE
	   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.'')')
	      ELSEH
	         DELETE (7)
		 WRITE (6,'('' Class deleted.'')')
	      END IFC
              IF (BTEST(FOLDER1_FLAG,0)) THENY
		 OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),
     &					STATUS='OLD',IOSTAT=IER) 
	     	 CLOSE (UNIT=3,DISPOSE='DELETE')A
              END IF
	      RETURN=
	   ELSE IF (NEWCLASS.NE.0) THEN
              CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)G
              DO WHILE (IER.EQ.0)I
                 DO WHILE (REC_LOCK(IER))F
                    READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER)I
                 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_DEFAULTT
 	      CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED)P
              CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)s
	      CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED)
              CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE)R
	      FOLDER1_NUMBER = NEWS_F1_COUNT_
	      FOLDER1 = BULL_PARAMETER
 	      FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)T
	      CALL WRITE_FOLDER_FILE_TEMP(IER)A
	      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 = TEMP6
	      REWRITE (7) NEWS_FOLDER1_COMo
 	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)R
	   END IF	
 	ELSE
	   IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.
     &				%LOC(CLI$_ABSENT)) FOLDER1 = FOLDERO
	   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
	      RETURND
	   END IF
	END IFE

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

	CLASS = CLI$PRESENT('CLASS')W
	DEFAULT = CLI$PRESENT('DEFAULT')_
	ALL = CLI$PRESENT('ALL')
 	IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE.
	DISABLE = CLI$PRESENT('DISABLE')a
      	ENABLE = CLI$PRESENT('ENABLE')I
     	PRIVATE = CLI$PRESENT('PRIVATE')
     	NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED)
	
	STORED = 0T
	IF (CLI$PRESENT('STORED')) THEN
	   STORED = 1
	   IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN t
	      F1_LAST = 0
	      F1_COUNT = 0W
	      F1_START = 0L
	      F1_NBULL = 0E
	      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,L
     &      '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') THENE
	      WRITE (6,'('' Stored setting was not removed.'')')i
	      CALL CLOSE_BULLNEWS
	      RETURNC
           END IF
	   IF (DEFAULT) THEN
	      CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE(O
     &			:TRIM(BULLNEWSDIR_FILE))//';*')	
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))I
     &			//'[.BULLNEWS*]*.*;*')M
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))L
     &			//'BULLNEWS*.DIR;*')O
	   ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THENC
              CALL CLOSE_BULLNEWSI
	      FOLDER_SAVE = FOLDERA
	      IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN
                 FOLDER_NUMBER = FOLDER1_NUMBERH
                 CALL SELECT_FOLDER(.FALSE.,IER)
	      END IF(
	      FOLDER = FOLDER_SAVE
              CALL OPEN_BULLDIR_SHARED
	      KEEPLOCK = .TRUE.
	      NEXT = .TRUE.
	      BULL_DELETE = 1
	      F_START = 0
	      F_NBULL = 999999 
	      CALL READDIR(BULL_DELETE,IER)
	      DO WHILE (IER.EQ.BULL_DELETE+1)
	         DELETE (2)
	         CALL READDIR(BULL_DELETE,IER) 
	      END DO	      
	      NEXT = .FALSE. 
	      KEEPLOCK = .FALSE.T
              CALL CLOSE_BULLDIR
              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),O
     &					STATUS='OLD',IOSTAT=IER)0
	   CLOSE (UNIT=3,DISPOSE='DELETE')N
	   FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0)
	END IFL

	IF (PRIVATE.AND..NOT.BTEST(FOLDER1_FLAG,0)) THEN 
	   CALL SET_PROTECTIONN
	   OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP), 
     &					STATUS='OLD',IOSTAT=IER)L
	   CLOSE (UNIT=3)
	   IF (IER.NE.0) THEN	A
	      OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),
     &			STATUS='NEW',IOSTAT=IER)_
	      CLOSE (UNIT=3)
	   END IF
	   CALL RESET_PROTECTIONN
	   FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0)
	END IF

	IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)R
	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_FLAGB
           NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRER
           NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITA
	END IFN

        CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,)M
        IF (DEFAULT.OR.CLASS) THEN
	   IF (CLASS) THENT
              WRITE (6,'('' For class '',A,'':'')') GROUP(:LG)
	   END IF
           IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')')	S
           IF (BTEST(FOLDER1_FLAG,8)) THEN
              WRITE (6,'('' Default is stored.'')')F
           ELSE 
              WRITE (6,'('' Default is not stored.'')')B
           END IFU
           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):)W
           ELSE IF (CLASS) THENE
              WRITE (6,'('' Expiration is DEFAULT value.'')')O
           ELSEa
              WRITE (6,'('' Default expiration for stored groups is ''
     &			 ,''14.'')')I
           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.'')')N
           ELSER
              WRITE (6,'('' There is no default expiration limit.'')')
           END IFu
           IF (BTEST(FOLDER1_FLAG,0)) THEN
              WRITE (6,'('' Private is set.'')')
           END IFI
        ELSE IF (BTEST(FOLDER1_FLAG,9)) THEN
	   FOLDER1_NAME = FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)Y
           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)F
           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,,,)M
              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) THENE
              WRITE (6,'('' Expiration limit is '',A,''.'')')I
     &                  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 IFE
 	END IF

	IF (CLI$PRESENT('FULL').AND.BTEST(FOLDER1_FLAG,0)) THEN
	   CALL CHKACL(NEWS_ACCESS(FOLDER1_DESCRIP),IER)2
	   IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THENX
	      IF (SETPRV_PRIV()) THEN
	         READ_ACCESS = 1-
		 WRITE_ACCESS = 1I
	      ELSE 
	        CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP),
     &		   USERNAME,READ_ACCESS,WRITE_ACCESS)E
	      END IFE
	      IF (WRITE_ACCESS) CALL SHOWACL(NEWS_ACCESS(FOLDER1_DESCRIP))T
	   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_BULLNEWSW
	   RETURN
	END IF 

 	IF (CLASS.AND.(ALL.OR.FLAG)) THEN 
           WRITE (6,'('' Modifying news groups...'')')
	   FOLDER_SAVE = FOLDER
	   CALL LOWERCASE(GROUP)O
           CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)F
	   IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN
	      CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER) 
	   END IF
	   FOUND = .FALSE.E
	   MODALL = INDEX(GROUP,'.').NE.LG)
           DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.E
     &			GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.'))L
 	      FOUND = .TRUE.
	      IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN =
	         CALL CLOSE_BULLNEWS=
                 FOLDER_NUMBER = FOLDER1_NUMBER(
                 CALL SELECT_FOLDER(.FALSE.,IER)
	         IF (IER) THENE
                    CALL OPEN_BULLDIR_SHARED
		    KEEPLOCK = .TRUE.
		    NEXT = .TRUE.$
		    BULL_DELETE = 1L
		    F_START = 0
	            F_NBULL = 999999T
		    CALL READDIR(BULL_DELETE,IER) 
		    DO WHILE (IER.EQ.BULL_DELETE+1)E
		       DELETE (2)H
		       CALL READDIR(BULL_DELETE,IER)
		    END DO	      R
	      	    NEXT = .FALSE.
		    KEEPLOCK = .FALSE.
                    CALL CLOSE_BULLDIR
	         END IF
	         CALL OPEN_BULLNEWS_SHAREDF
                 CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER)
                 F1_LAST = 0
                 F1_COUNT = 0 
		 F1_START = 0 
		 F1_NBULL = 0o
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) u
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)U
	      ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN
	         F1_LAST = 0i
                 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 = 0I
              IF (EXPIRE.GE.0.AND.MODALL) FOLDER1_BBEXPIRE = EXPIRED
              IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0E
              IF (LIMIT.GE.0.AND.MODALL) F1_EXPIRE_LIMIT = LIMIT
	      IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)A
	      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)T
           END DOE
	   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)I
	      IF (.NOT.IER) THEN 
	         FOLDER_NUMBER = 0L
	         CALL SELECT_FOLDER(.FALSE.,IER)&
                 WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &              FOLDER(:TRIM(FOLDER)))
	      END IFI
	      RETURN.
           END IFL
 	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 = 0O
	      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 = 0B
		 F1_START = 0S
		 F1_NBULL = 0V
		 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)1
	      IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9)
	      CALL REWRITE_FOLDER_FILE_TEMP(IER)F
	   END DO	   
	END IF

	FOLDER_NUMBER = -1 
	FOLDER1 = FOLDER6
        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
        ENDs




	SUBROUTINE INCLUDE(EXCLUDE)

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLUSER.INC'R

	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 

	IER = SYS_TRNLNM_SYSTEM('BULL_USER_CUSTOM',BULL_PARAMETER)a
	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) THENi
	   WRITE(6,'('' ERROR: Error in opening custom file.'')')
	   RETURN
	END IF'

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

	   CALL OPEN_BULLDIR_SHARED

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

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

	   CALL OPEN_BULLFIL_SHARED	! Open BULLETIN file1

	   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')) THENE
	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)E
	      ELSE
	         INPUT = INPUT(7:) 
	         IF (INDEX(INPUT,'%"').GT.0) THEN
	            INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1)
	         END IF
	      END IF 
	   ELSE
	      INPUT = FROMD
	   END IF
	   IF (CLI$PRESENT('SUBJECT')) THEN
	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
	         INPUT = INPUT(7:) 
	      ELSE 
		 INPUT = DESCRIP
	      END IFA
	   END IF

	   CALL CLOSE_BULLFIL
	END IF.

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

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

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

    	ILEN = TRIM(INPUT)T
	ALL = CLI$PRESENT('ALL')a
	DISABLE = CLI$PRESENT('DISABLE')=

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

	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERC
	   IF (IER.EQ.0) THEN	      L
	      IF (STREQ(OLD_BUFFER(:OLEN),INPUT(:ILEN))) THEN
	         IF (.NOT.DISABLE) THEN
		    WRITE (6,'('' ERROR: Entry already present.'')') R
		    CLOSE (UNIT=4)	 
		    CLOSE (UNIT=3)	W
		    RETURN
		 END IFE
 	      ELSE IF (.NOT.(ALL.AND.INPUT(:TRIM(FOLDER_NAME)+8).EQ.
     &		OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+8,OLEN)))) THENI
                 WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)E
	      END IFL
	   END IF
	END DOL

	IF (.NOT.DISABLE) WRITE (4,'(A)',IOSTAT=IER) INPUT(:ILEN)

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

	CALL CHECK_CUSTOM

        RETURN
        ENDR




	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./A

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

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

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	BULL_USER_CUSTOM = .FALSE.I

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

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

	IF (IER.NE.0) RETURN 

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

	NINCLUDE = 0N
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERE
	   IF (IER.EQ.0.AND.FOLDER_NAME(:TRIM(FOLDER_NAME))//':'.EQ.I
     &		OLD_BUFFER(:MIN(TRIM(FOLDER_NAME)+1,OLEN))) THEN
	      BULL_USER_CUSTOM = .TRUE.
	      CALL LOWERCASE(OLD_BUFFER)B
	      CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)
	      NINCLUDE = NINCLUDE + 1
	   END IF
	END DOL

	CLOSE (UNIT=3) 

        RETURN
	END



	 
	LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)F

	IMPLICIT INTEGER (A-Z)D

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'L

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

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

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE=
	DATA SCRATCH_B1/0/N

	CHARACTER*(*) STRING,STRING1_

	INCLUDE_MSG = .TRUE.,
	IF (.NOT.BULL_USER_CUSTOM) RETURN

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header

	FLEN = TRIM(FOLDER_NAME)D

	INC = .FALSE.

	CALL LOWERCASE(STRING)I
	CALL LOWERCASE(STRING1)
	DO I=1,NINCLUDE
	   CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER)I
	   OLEN = TRIM(OLD_BUFFER)L
	   IF (STREQ(FOLDER_NAME(:FLEN)//':',
     &		OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN
	      IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THENN
		 IF (.NOT.INC) INCLUDE_MSG = .FALSE.
		 INC = .TRUE. 
	      END IFE
	      IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.E
     &		  INDEX(STRING(:TRIM(STRING)),OLD_BUFFER
     &		  (FLEN+15:OLEN)).GT.0).OR.(
     &		  (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.I
     &		  INDEX(STRING1(:TRIM(STRING1)),OLD_BUFFER
     &		  (FLEN+18:OLEN)).GT.0)) THENC
		 INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')Y
		 IF (.NOT.INCLUDE_MSG) RETURN 
	      END IF(
	   END IF
	END DOS

	RETURN
	END
