From:	SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:56:46.56
To:	EVERHART
CC:	
Subj:	BULLETIN11.FOR

Date: Fri, 19 Aug 1994 17:26:04 -0400 (EDT)
From: BULLETIN@PFC.MIT.EDU
To:   EVERHART@arisia.gce.com
Message-Id: <940819172604.21438991@PFC.MIT.EDU>
Subject: BULLETIN11.FOR

C
C  BULLETIN11.FOR, Version 5/11/94
C  Purpose: Bulletin board utility program.
C  Environment: VAX/VMS
C  Usage: Invoked by the BULLETIN command.
C  Programmer: Mark R. London
C
C  Copyright (c) 1990
C  Property of Massachusetts Institute of Technology, Cambridge MA 02139.
C  This program cannot be copied or distributed in any form for non-MIT
C  use without specific written approval of MIT Plasma Fusion Center
C  Management.
C
	SUBROUTINE RESET

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

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

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

	CALL OPEN_BULLDIR_SHARED

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

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

	CALL CLOSE_BULLDIR

	RETURN

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

	END



	SUBROUTINE TAG(ADD_OR_DEL,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

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

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*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 DOU

	NEXT = OLD_NEXT
	IF (CLOSE_IT) CALL CLOSE_BULLDIR 

	RETURNu

	ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE)

	IER = 36T

	SUBNUM = NEWS_FIND_SUBSCRIBE() 

	IF (SUBNUM.GT.FOLDER_MAX-1) RETURN 

	TAG_TYPE = 03

	DO I=1,2E
	   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,n
     &		%VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM))
	      IF (TEST) THENs
	         IER = 0e
	         TAG_TYPE = IBSET(TAG_TYPE,I)
	      END IFa
	   END IF
	END DOt

	IF (BTEST(READ_TAG,3)) THEN
	   IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.e
     &	       (.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)) 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 IFe
	      RETURN'
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENd
	      RETURN
	   END IF
	END DO(

	RETURNT
	END




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

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLUSER.INC'O

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

	IER = 36M

	OLD_NEXT = NEXT

	DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0)
	   I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM)A
	   DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM))T
	      TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)),
     &		  NEWS_TAG(1,J,SUBNUM))E
	      IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST
	      IF (TEST) THENF
	         IER = 0
	         MESSNUM = IR
	      ELSEp
		 I = I + 1
	      END IF 
	   END DO
	   IF (IER.EQ.0) THEN
	      SAVE_MESSNUM = MESSNUMN
	      NEXT = .FALSE.N
	      CALL READDIR(MESSNUM,IER1)A
	      IF (IER1.NE.MESSNUM+1) THEN
	         NEXT = .TRUE.E
	         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)
		 ELSEL
		    NEXT = OLD_NEXT1
		    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) THEN1
		 IER = 36n
	         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 - 1E
	   MSG_NUM = MESSNUM'
	END IFM

	NEXT = OLD_NEXT

	IF (CLOSE_IT) CALL CLOSE_BULLDIR 

	RETURN 
	END




	SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE)

	IMPLICIT INTEGER (A-Z)G

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'.

	INCLUDE 'BULLFOLDER.INC' 

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

	IER = 0

	SUBNUM = NEWS_FIND_SUBSCRIBE()B
	IF (SUBNUM.GT.FOLDER_MAX-1) RETURNU

	IF (NEWS_TAG(1,TAG_TYPE,SUBNUM).GT.F_START) THENE
	   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) = 0s
	END IFf

	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,L
     &			%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)))S
	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)-S
     &			  NEWS_TAG(1,I,SUBNUM))/8+1,)
     &			  %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP))E
	         CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)-L
     &			  NEWS_TAG(1,I,SUBNUM))/8+1,R
     &			  NEWS_TAG(3,I,SUBNUM))
	         NEWS_TAG(2,I,SUBNUM) = F_NBULL
	         NEWS_TAG(3,I,SUBNUM) = TEMPB
	      END IF(
	   END DO
	END IFP

	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
		 R
	RETURNT
	END



	SUBROUTINE SET_TAG(NUM,TAGS,START)G

	IMPLICIT INTEGER (A-Z)

	DIMENSION TAGS(1)

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

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

	RETURNI
	END



	SUBROUTINE CLR_TAG(NUM,TAGS,START)L

	IMPLICIT INTEGER (A-Z)

	DIMENSION TAGS(1)

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

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

	RETURNY
	END



	LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START)

	IMPLICIT INTEGER (A-Z) 

	DIMENSION TAGS(1)

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

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

	RETURNI
	END



	SUBROUTINE DEL_TAG(IER,TAG_TYPE)E

	IMPLICIT INTEGER (A-Z)R

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'R

	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),N
     &		 IOSTAT=IER1)E
	END DOE
	IF (IER1.NE.0) RETURN

	DELETE (UNIT=13,IOSTAT=IER1)2

	RETURNE
	END



	SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)M

	IMPLICIT INTEGER (A-Z)M

	INCLUDE 'BULLUSER.INC'G

	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_TAGT
     &	    (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))0
     &	    ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN
	   RETURN
	ELSEO
	   NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1D
	   CALL CLR_TAG
     &		(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),I
     &		NEWS_TAG(1,TAG_TYPE,SUBNUM))
	END IFR

	RETURN 
	END



	SUBROUTINE OPEN_OLD_TAG

	IMPLICIT INTEGER (A-Z)H

	INCLUDE '($FORIOSDEF)' 

	INCLUDE 'BULLUSER.INC'B

	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_MARKH
	DIMENSION NEWS_MARK(128)
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECI
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))S
	EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)T
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)_

	CHARACTER*12 BULL_MARK_DIR_
	CHARACTER*12 TAG_KEY,INPUT_KEYT

	IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)T
	IF (IER) THEN
	   BULL_MARK_DIR = 'BULL_MARK:'
	ELSEL
	   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,N
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:12:CHARACTER))E
	   NTRIES = NTRIES + 1 
	END DOa

	IF (IER.EQ.0) THEN
	   BULL_TAG = IBSET(BULL_TAG,0)
	   DO WHILE (REC_LOCK(IER1))R
	      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,)U
	      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 DOE
	      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,Z
     &	    	    ORGANIZATION='INDEXED',IOSTAT=IER,
     &	    	    KEY=(1:12:CHARACTER))2
	  	 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)L
	   ELSE
	      UNLOCK 13
	   END IF
	END IF 

	NTRIES = 0H

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

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

	   DO WHILE (REC_LOCK(IER1))H
	      READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK
	   END DO
	   IF (IER1.EQ.0) CALL SYS$ASCTIM(,DATE,NEWS_MARK(2),)N
	   IF (IER1.NE.0) THEN 
	      OPEN (UNIT=24,FILE=BULL_MARK_DIR//L
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',	
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	        RECORDSIZE=128,DISPOSE='DELETE',,
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:4:INTEGER))A
	      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)E
		    NEWS_MARK2(1) = NEWS_MARK2(2)E
		    NEWS_MARK2(2) = I 
	            WRITE (24,IOSTAT=IER) NEWS_MARK
	         END IF
	      END DO
	      NEWS_MARK(1) = 0S
	      CALL SYS_BINTIM('-',NEWS_MARK(2))
	      WRITE (24,IOSTAT=IER) NEWS_MARK
	      CLOSE (UNIT=24,DISPOSE='SAVE')
	      CLOSE (UNIT=23,DISPOSE='DELETE')W
	      DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	        OPEN (UNIT=23,FILE=BULL_MARK_DIR//L
     &	           USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',
     &	           ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,	
     &	           FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,U
     &	           KEY=(1:4:INTEGER))
	  	 NTRIES = NTRIES + 1
	      END DOM
	   ELSE IF (COMPARE_DATE(DATE,' ').LT.-30) THEN
	      CLOSE (UNIT=23)           N
	      IER1 = 1T
              DO WHILE (IER1) 
	         IER1 = LIB$DELETE_FILE(L
     &			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()B
	      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',B
     &	      	BULL_MARK_DIR//USERNAME(:TRIM(USERNAME))//'.NEWSMARK')
              CALL LIB$DELETE_FILE(BULL_MARK_DIR//
     &		USERNAME(:TRIM(USERNAME))//'.NEWSMARK;-1')
	      DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	        OPEN (UNIT=23,FILE=BULL_MARK_DIR//E
     &	           USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',
     &	           ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,_
     &	           FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	           KEY=(1:4:INTEGER))
	  	 NTRIES = NTRIES + 1
	      END DOJ
	      DO WHILE (REC_LOCK(IER1))
	         READ (23,KEYEQ=0,IOSTAT=IER1) NEWS_MARK 
	      END DON
	      CALL SYS_BINTIM('-',NEWS_MARK(2))
	      REWRITE (23,IOSTAT=IER) NEWS_MARK
	   END IF
	END IFT

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

	IF (BULL_NEWS_TAG) THEN
	   OLD_NEWS_NUMBER = 0R
	   NEWS_MARK(1) = 0
	   FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBERI
	   CALL OPEN_BULLNEWS_SHARED 
	   DO WHILE (IER.EQ.0)I
	      DO WHILE (REC_LOCK(IER))_
		 READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK
	      END DOL
	      IF (IER.EQ.0.AND.NEWS_NUMBER.NE.0) THEN
		 IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN1
		    NEWS_FOLDER_NUMBER = NEWS_NUMBER
		    SUBNUM = NEWS_FIND_SUBSCRIBE()
		    IF (SUBNUM.GT.FOLDER_MAX-1) THEN
		       DELETE (UNIT=23)M
		    ELSE
		       UNLOCK 23
		       OLD_NEWS_NUMBER = NEWS_NUMBER
		       CALL READ_FOLDER_FILE_KEYNUM_TEMP
     &			  (NEWS_FOLDER_NUMBER,IER1)
		       IF (IER1.NE.0) THEN
			  SUBNUM = 0S
		       ELSET
			  DO I=1,2&
		             NEWS_TAG(1,I,SUBNUM) = F1_START
		             NEWS_TAG(2,I,SUBNUM) = F1_NBULL
		             NEWS_TAG(4,I,SUBNUM) = 0T
		             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 DON
		       END IFI
		    END IF
		 END IF
		 IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN.
	            IF (SUBNUM.EQ.0) THEN
		       DELETE (UNIT=23)T
		    ELSE
		       UNLOCK 23
		       IF (NEWS_REC.GT.0) THEN
			  TAG_TYPE = 1L
		       ELSEM
			  TAG_TYPE = 2T
		       END IFT
		       IF (NEWS_FORMAT.EQ.0) THEN	! 16 bit numbers
		          DO I=5,256
		             CALL SET_NEWS_TAG(INT(NEWS_MARK2(I)),SUBNUM,(
     &					   TAG_TYPE)V
		          END DO
		       ELSE
		          DO I=3,128
		             CALL SET_NEWS_TAG(NEWS_MARK(I),SUBNUM,TAG_TYPE)
		          END DO
		       END IF1
		    END IF
		 END IFI
	      END IF(
	   END DO
	   NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVER
	   CALL CLOSE_BULLNEWSS
	END IFU

	RETURN 
	END



	SUBROUTINE SET_NEWS_TAG(NUM,SUBNUM,TAG_TYPE)_

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLUSER.INC'E

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

	IF (NUM.GT.0) THENU
	   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)),a
     &		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),(
     &		MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM)O
	      CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
     &		NEWS_TAG(1,TAG_TYPE,SUBNUM))
	   END DO
	END IFT

	RETURNN
	END



	SUBROUTINE OPEN_NEW_TAG(IER)F

	IMPLICIT INTEGER (A-Z)1

	INCLUDE 'BULLUSER.INC'.

	INCLUDE 'BULLFOLDER.INC'Y

	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_MARKE
	DIMENSION NEWS_MARK(128)C

	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)M
	IF (.NOT.IER1) THEN
	   IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)
	   CALL DISABLE_PRIVS
	   IER1 = .FALSE.
	END IFP
	IF (REMOTE_SET.LT.3) THEN
	   MARKUNIT = 13 
	   OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW',I
     &	        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
	ELSEI
	   MARKUNIT = 233
	   OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR//
     &	        USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',D
     &	        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) = 0L
	      CALL SYS_BINTIM('-',NEWS_MARK(2))
	      WRITE (23,IOSTAT=IER) NEWS_MARK
           END IF 
 	END IF
	IF (.NOT.IER1) CALL ENABLE_PRIVSE
	IF (IER.NE.0) THEN.
	   WRITE (6,'('' Cannot create mark file.'')')E
	   CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THENN
	      WRITE (6,'('' IOSTAT error = '',I)') IERM
	      IER = 0
	   ELSE
	      CALL SYS_GETMSG(IER1)
	      IER = IER1D
	   END IF
	ELSE'
	   IF (.NOT.IER1) THENF
	      INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER)
	      WRITE (6,'('' Created MARK file: '',A)')E
     &		BULL_PARAMETER(:TRIM(BULL_PARAMETER)) 
	   END IF
	   IF (MARKUNIT.EQ.13) BULL_TAG = 1
	   IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE.
	   IER = 1R
	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))E
	ELSEE
	   CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY))
	END IF'

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

	RETURNT
	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_KEYH

	CHARACTER*8 NEXT_MSG_KEY

	IF ((.NOT.BULL_TAG.AND.REMOTE_SET.LT.3)
     &	    .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.GE.3)) THENK
	   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 = 0I
 	   CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY)N
	   IF (IER.EQ.0) THEN
	      MESSAGE = MESSAGE - 1
	      MSG_NUM = MESSAGE
	      MSG_KEY = BULLDIR_HEADERR
	   END IF
	   RETURN
	END IF 

	MSG_KEY = BULLDIR_HEADERF

	HEADER = .TRUE.

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

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

	RETURNS

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

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

	TAG_TYPE = 0D

	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 DOA
	      IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I)U
	   END IF
	END DOT

	IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.V
     &	    (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 = 0M
	   MESSAGE = MSG_NUM(
	ELSEE
	   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_KEYA

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

	TAG_TYPE = 0,

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

	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),K
     &		        IOSTAT=IER) INPUT_KEYW
		 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 IFE
		 IF (IER.EQ.0) THENG
		    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 IFI
	      END IFL
	   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))U
	         READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I),
     &		        IOSTAT=IER) INPUT_KEY 
	      END DO 
	      IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)=
	      IER = 0
	      RETURND
	   ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THENL
	      MSG_KEY = NEXT_MSG_KEYI
	      RETURN
	   ELSE
	      MSG_KEY = NEXT_MSG_KEY 
	   END IF
	END DO 

	RETURN,
	END



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

	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_SHAREDD

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

	IER = 36E
	IF (CLOSE_IT) CALL CLOSE_BULLDIR.

	RETURN6
	END



	INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2)

	IMPLICIT INTEGER (A-Z)N

	CHARACTER*8 MSG_KEY1,MSG_KEY2

	DIMENSION BTIM1(2),BTIM2(2)

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

	COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2)

	RETURN 
	END




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

	IMPLICIT INTEGER (A-Z)C

	INCLUDE 'BULLDIR.INC'

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

	CHARACTER*12 TAG_KEY,INPUT_KEYN

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

	CLOSE_IT = .FALSE.N

	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)G
	   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)
	      RETURNE
	   ELSE
	      CALL DECREMENT_MSG_KEYN
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      INQUIRE (UNIT=2,OPENED=IER)
	      IF (.NOT.IER) THENY
		 CALL OPEN_BULLDIR_SHAREDE
		 CLOSE_IT = .TRUE.
	      END IFP
	      CALL READDIR_KEYGE(IER)
	      CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))T
	      IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN
	         UNLOCK 13
		 MESSAGE = MSG_NUM
		 IF (HEADER) THENB
		    MESSAGE = MESSAGE - 1I
		    MSG_NUM = MESSAGEK
		    MSG_KEY = BULLDIR_HEADER
		 END IFL
		 IER = 0
		 IF (CLOSE_IT) CALL CLOSE_BULLDIRI
	         RETURN
	      ELSEI
		 DELETE (UNIT=13)E
		 IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN
		    IER = 36
		    IF (CLOSE_IT) CALL CLOSE_BULLDIR
		    RETURN
		 END IF1
		 DO WHILE (REC_LOCK(IER))M
	            READ (13,IOSTAT=IER) INPUT_KEYP
	 	 END DO
	      END IF_
	   END IF

	END DO 

	END



	SUBROUTINE CLOSE_TAGA

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC'D

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

	COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG

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

	TAG_OPENED = .FALSE.T

	IF (BULL_NEWS_TAG) THEN
	   DO I=1,FOLDER_MAX-1 
	      DO M=1,2D
	         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 = 1L
		    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)N
		    K = 5-NEWS_FORMAT*21
		    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) THENQ
		             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 IFC
		          SET_LIST = .FALSE.
		       END IFY
		       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 IFB
		       IF (K.GT.LIMIT) THENM
		          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*2G
		          NEWS_REC = NEWS_REC + 1L
		          IF (J.EQ.NEWS_TAG(2,M,I)) THEN
		             DO WHILE (REC_LOCK(IER))
		                READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)I
			        IF (IER.EQ.0) THENH
			           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)L
	END IFE

	RETURNE
	END


	SUBROUTINE SET_NEWS_MARK(I,J)

	IMPLICIT INTEGER (A-Z)

	COMMON /NEWS_MARK/ NEWS_MARKM
	DIMENSION NEWS_MARK(128)R
	INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_RECE
	EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))H
	EQUIVALENCE (NEWS_MARK2(2),NEWS_NUMBER)
	EQUIVALENCE (NEWS_MARK2(1),NEWS_REC)G
	EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)E

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

	RETURNE
	END



	SUBROUTINE ZERO_VM(NUM,NEWS_TAG)P

	IMPLICIT INTEGER (A-Z) 

	LOGICAL*1 NEWS_TAG(1)

	DO I=1,NUME
	   NEWS_TAG(I) = 0D
	END DOI

	RETURNE
	END




	SUBROUTINE FREE_TAGS(ISUB) 

        IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'E

	INCLUDE 'BULLUSER.INC'2

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

	DO I=1,2D
	   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))I
	      NEWS_TAG(3,I,ISUB) = 0N
	      NEWS_NUMBER = NEWS_FOLDER_NUMBERL
	      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)W
	         END IF
	      END DO 
	   END IF

	   DO J=I,FOLDER_MAX-2S
	      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) = 0K
	   END DO
	END DO

	RETURNJ
	END




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

	IMPLICIT INTEGER (A-Z)D

	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_KEYE

	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)L
	      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)) THEN3
		       CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)T
		    END IF
		    IER = 36
	         END IF
	      END IF 
	   END DO
	   BULL_READ = MSG_NUMN
	   IF (CLOSE_IT) CALL CLOSE_BULLDIR R
	ELSE
	   IF (MSG_NUM.EQ.0) RETURN
	   SAVE_MSG_NUM = MSG_NUM
	   PREV_MSG_NUM = MSG_NUM
	   MSG_NUM = 0E
	   MSG_KEY = BULLDIR_HEADER
	   IER = 0'
	   DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM)
	      IF (MSG_NUM.GT.0) THENT
	         PREV_MSG_KEY = MSG_KEY
	         PREV_MSG_NUM = MSG_NUM
	      END IFS
	      CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)R
	   END DO
	   IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN
	      MSG_NUM = PREV_MSG_NUM 
	      MSG_KEY = PREV_MSG_KEYR
	      CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE) 
	   ELSE
	      IER = 36D
	   END IF
	END IF 

	RETURNC
	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
	      I = 9
	   ELSE
	      I = I + 1
	   END IF
	END DOC

	RETURN(
	END




	SUBROUTINE SET_GENERIC(GENERIC)
C 
C  SUBROUTINE SET_GENERICE
CE
C  FUNCTION: Enables or disables "GENERIC" display, i.e. displaying'
C	general bulletins continually for a certain amount of days.R
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 IFE

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

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)

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

	CALL CLOSE_BULLUSER

	RETURN 
	END


	SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS)
CL
C  SUBROUTINE SET_BRIEF_CONTINUOUS
CK
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)E

	INCLUDE 'BULLUSER.INC'L

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(USERNAME,IER)

	IF (BRIEF_CONTINUOUS) THEN	
	   NEW_FLAG(2) = -1
	ELSEE
	   NEW_FLAG(2) = 0E
	END IFA

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

	CALL CLOSE_BULLUSER

	RETURNU
	END


	SUBROUTINE SET_LOGIN(LOGIN)
CM
C  SUBROUTINE SET_LOGINO
CT
C  FUNCTION: Enables or disables bulletin display at login.E
CD
	IMPLICIT INTEGER (A-Z)T

	INCLUDE 'BULLUSER.INC' 

	CHARACTER TODAY*24U

	DIMENSION NOLOGIN_BTIM(2)

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

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

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

	CALL OPEN_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)B

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

	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))H
	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)K

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

	CALL SYS$DCLEXH(EXBLK(1))

	RETURN 
	END



	SUBROUTINE SENDMAIL(FILE,SENDTO,SUBJECT,STATUS)

        IMPLICIT INTEGER (A-Z)

	INCLUDE '($MAILDEF)' 

	INCLUDE 'BULLUSER.INC' 

	CHARACTER*(*) FILE,SENDTO,SUBJECT

	EXTERNAL MAIL_ERROR

	CALL SYS$SETAST(%VAL(1))	

	CALL DISABLE_PRIVS

        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

	CALL LIB$ESTABLISH(MAIL_ERROR)F

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

	J = 1
	DO WHILE (J.LE.TRIM(SENDTO))D
	   I = INDEX(SENDTO(J:),',') - 1 
	   IF (I.EQ.-1) I = TRIM(SENDTO(J:))T
           CALL INIT_ITMLSTE
           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 + IL
	   IF (SENDTO(J:J).EQ.',') J = J + 1E
	END DOS

        CALL INIT_ITMLST
        CALL ADD_2_ITMLST(TRIM(SUBJECT),MAIL$_SEND_SUBJECT
     &				,%LOC(SUBJECT))8
	IF (SETPRV_PRIV()) THEN
	   CALL ENABLE_PRIVSE
	   CALL ADD_2_ITMLSTM
     &		   (TRIM(USERNAME),MAIL$_SEND_FROM_LINE,%LOC(USERNAME))
	END IFN
        CALL ADD_2_ITMLST(TRIM(SENDTO),MAIL$_SEND_TO_LINE,%LOC(SENDTO))
        CALL END_ITMLST(ATTRIBUTE_ITMLST)2

        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_PRIVSE
	CALL LIB$REVERT

        RETURN
        END2



	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_PA
        CHARACTER*64 BULL_PARAMETER 
	F
	EXTERNAL CLI$_NEGATED,CLI$_ABSENT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /KEEPLOCK/ KEEPLOCKN

	COMMON /NEXT/ NEXT 

	DIMENSION EXPIRED(2)L

	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 IFT

	ENTRY SHOW_NEWS

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

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

	CALL OPEN_BULLNEWS_SHARED	! Open folder fileU

	IF (CLI$PRESENT('DEFAULT')) THEND
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)A
	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.'')')S
	      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')R
              END IF
	      RETURNE
	   ELSE IF (NEWCLASS.NE.0) THEN
              CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)d
              DO WHILE (IER.EQ.0) 
                 DO WHILE (REC_LOCK(IER))o
                    READ (7,KEY=NEWS_F1_COUNT,KEYID=1,IOSTAT=IER)
                 END DOP
                 IF (IER.EQ.0) NEWS_F1_COUNT = NEWS_F1_COUNT + 1
              END DO
	      FOLDER1_FLAG = NEWS_FLAG_DEFAULTt
	      FOLDER1_BBEXPIRE = NEWS_EXPIRE_DEFAULT
              F1_EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULTL
 	      CALL SYS_BINTIM('6-NOV-2956 00:00:00.00',EXPIRED)
              CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)C
	      CALL SYS_BINTIM('5-NOV-1956 00:00:00.00',EXPIRED)
              CALL GET_MSGKEY(EXPIRED,NEWS_F1_CREATED_DATE)R
	      FOLDER1_NUMBER = NEWS_F1_COUNTN
	      FOLDER1 = BULL_PARAMETERI
 	      FOLDER1_FLAG = IBSET(FOLDER1_FLAG,10)F
	      CALL WRITE_FOLDER_FILE_TEMP(IER)3
	      IF (IER.NE.0) THEN'
		 CALL CLOSE_BULLNEWS
		 WRITE (6,'('' Unable to add entry.'')')
                 RETURNE
	      END IF	      
	      TEMP = FOLDER1_NUMBER
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)
	      NEWS_F1_COUNT = TEMPl
	      REWRITE (7) NEWS_FOLDER1_COMi
 	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(TEMP,IER)e
	   END IF	v
 	ELSE
	   IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.
     &				%LOC(CLI$_ABSENT)) FOLDER1 = FOLDERC
	   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 IFS

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

	CLASS = CLI$PRESENT('CLASS')U
	DEFAULT = CLI$PRESENT('DEFAULT')D
	ALL = CLI$PRESENT('ALL')N
 	IF (CLASS.AND.INDEX(GROUP(:LG-1),'.').GT.0) ALL = .TRUE.
	DISABLE = CLI$PRESENT('DISABLE')B
      	ENABLE = CLI$PRESENT('ENABLE')R
     	PRIVATE = CLI$PRESENT('PRIVATE')
     	NOPRIVATE = CLI$PRESENT('PRIVATE').EQ.%LOC(CLI$_NEGATED)
	L
	STORED = 0E
	IF (CLI$PRESENT('STORED')) THEN
	   STORED = 1
	   IF (.NOT.(CLASS.OR.DEFAULT).AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN  
	      F1_LAST = 0
	      F1_COUNT = 0R
	      F1_START = 0O
	      F1_NBULL = 0
	      NEWS_F1_FIRST = 0
	      NEWS_F1_END = 0
           END IFE
	   FOLDER1_FLAG = IBSET(FOLDER1_FLAG,8)
	ELSE IF (CLI$PRESENT('STORED').EQ.%LOC(CLI$_NEGATED)) THEN   
	   STORED = 2
	   CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,:
     &      'Are you sure you want to remove stored setting? '//
     &	    '(Y/N with N as default): ')T
	   IF (BULL_PARAMETER(:1).NE.'y'.AND.BULL_PARAMETER(:1).NE.'Y') THEN 
	      WRITE (6,'('' Stored setting was not removed.'')')'
	      CALL CLOSE_BULLNEWS
	      RETURNN
           END IFD
	   IF (DEFAULT) THEN,
	      CALL LIB$DELETE_FILE(BULLNEWSDIR_FILE(A
     &			:TRIM(BULLNEWSDIR_FILE))//';*')	L
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))=
     &			//'[.BULLNEWS*]*.*;*')I
	      CALL LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))
     &			//'BULLNEWS*.DIR;*')O
	   ELSE IF (.NOT.CLASS.AND.BTEST(FOLDER1_FLAG,8)) THENK
              CALL CLOSE_BULLNEWSK
	      FOLDER_SAVE = FOLDERB
	      IF (FOLDER_NUMBER.NE.FOLDER1_NUMBER) THEN
                 FOLDER_NUMBER = FOLDER1_NUMBERE
                 CALL SELECT_FOLDER(.FALSE.,IER)
	      END IFE
	      FOLDER = FOLDER_SAVEC
              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)L
	      END DO	      
	      NEXT = .FALSE.U
	      KEEPLOCK = .FALSE./
              CALL CLOSE_BULLDIR
              CALL OPEN_BULLNEWS_SHARED 
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(NEWS_FOLDER_NUMBER,IER)
	      F1_START = 0 
	      F1_NBULL = 0H
	      F1_COUNT = 0 
              F1_LAST = 0)
           END IF(
           FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8)N
	   FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)M
        END IF

	IF (NOPRIVATE.AND..NOT.DEFAULT) THEN_
	   OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),D
     &					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)) THENA
	   CALL SET_PROTECTIONE
	   OPEN (UNIT=3,FILE=NEWS_ACCESS(FOLDER1_DESCRIP),I
     &					STATUS='OLD',IOSTAT=IER)L
	   CLOSE (UNIT=3)
	   IF (IER.NE.0) THEN	(
	      OPEN (UNIT=3,FILE=NEW_NEWS_ACCESS(FOLDER1_DESCRIP),
     &			STATUS='NEW',IOSTAT=IER)S
	      CLOSE (UNIT=3)N
	   END IF
	   CALL RESET_PROTECTIONS
	   FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0)
	END IFA

	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 F
           NEWS_FLAG_DEFAULT = NEWS_F1_FLAGM
           NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE)
           NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT 
	END IFS

        CALL OTS$CVT_L_TI(FOLDER1_BBEXPIRE,BULL_PARAMETER,,,) 
        IF (DEFAULT.OR.CLASS) THEN
	   IF (CLASS) THENG
              WRITE (6,'('' For class '',A,'':'')') GROUP(:LG)
	   END IF
           IF (BTEST(FOLDER1_FLAG,9)) WRITE (6,'('' Disable is set.'')')	G
           IF (BTEST(FOLDER1_FLAG,8)) THEN
              WRITE (6,'('' Default is stored.'')')F
           ELSE 
              WRITE (6,'('' Default is not stored.'')')B
           END IFA
           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.'')')O
           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,,,)S
              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
           NOTIFY_FLAG_NEWS = .FALSE. 
           SET_FLAG_NEWS = .FALSE.
	   BRIEF_FLAG_NEWS = .FALSE.B
 	   CALL OPEN_BULLINF_SHAREDE
           DO WHILE (REC_LOCK(IER1))
              READ (9,KEY='*DEFAULT',IOSTAT=IER1) TEMP_USER,INF_REC0
       	   END DO)
	   IF (IER1.EQ.0) THENM
	      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.'')')K
              ELSE
	         IER1 = 2
	      END IF 
           END IF_
           NOTIFY_PERM_FLAG_NEWS = .FALSE.
           SET_PERM_FLAG_NEWS = .FALSE.L
	   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) THENE
	      I = 1
              DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER1_NUMBER
     &					.AND.I.LE.FOLDER_MAX-1)
	         I = I + 1L
       	      END DO
	      IF (I.LE.FOLDER_MAX-1) THEN
	         NOTIFY_PERM_FLAG_NEWS = BTEST(INF_REC2(2,I),13)R
	         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.'')')T
	      END IF=
           END IFL
	   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.'')')
		 ELSEN
		    WRITE (6,'('' Default is BRIEF.'')')
		 END IF0
	      ELSEO
	        IF (SET_PERM_FLAG_NEWS.AND..NOT.BRIEF_PERM_FLAG_NEWS) THENF
	           PERM = .TRUE.D
		   WRITE (6,'('' Default is READNEW, which is permanent.'')'))
		ELSE
		   WRITE (6,'('' Default is READNEW.'')')D
		END IF
	      END IF2
	   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.'')').
	      ELSEM
		 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 IFS
	   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) THENB
		 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.'')')1
	   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 
	      ELSEA
	        CALL CHECK_ACCESS(NEWS_ACCESS(FOLDER1_DESCRIP),
     &		   USERNAME,READ_ACCESS,WRITE_ACCESS)R
	      END IFF
	      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 IFI

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

 	IF (CLASS.AND.(ALL.OR.FLAG)) THENR
           WRITE (6,'('' Modifying news groups...'')')
	   FOLDER_SAVE = FOLDER
	   CALL LOWERCASE(GROUP) 
           CALL READ_FOLDER_FILE_KEYNAME_TEMP(GROUP(:LG-1),IER)A
	   IF (IER.NE.0.OR.GROUP(:LG-1).NE.FOLDER1) THEN(
	      CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(GROUP(:LG),IER)L
	   END IF
	   FOUND = .FALSE.N
	   MODALL = INDEX(GROUP,'.').NE.LG3
           DO WHILE (IER.EQ.0.AND.(GROUP(:LG).EQ.FOLDER1(:LG).OR.T
     &			GROUP(:LG).EQ.FOLDER1(:TRIM(FOLDER1))//'.')) 
 	      FOUND = .TRUE.
	      IF (STORED.EQ.2.AND.BTEST(FOLDER1_FLAG,8)) THEN F
	         CALL CLOSE_BULLNEWSE
                 FOLDER_NUMBER = FOLDER1_NUMBERW
                 CALL SELECT_FOLDER(.FALSE.,IER)
	         IF (IER) THENP
                    CALL OPEN_BULLDIR_SHARED
		    KEEPLOCK = .TRUE. 
		    NEXT = .TRUE.F
		    BULL_DELETE = 1 
		    F_START = 0E
	            F_NBULL = 999999 
		    CALL READDIR(BULL_DELETE,IER)W
		    DO WHILE (IER.EQ.BULL_DELETE+1) 
		       DELETE (2)D
		       CALL READDIR(BULL_DELETE,IER)
		    END DO	      S
	      	    NEXT = .FALSE.
		    KEEPLOCK = .FALSE.
                    CALL CLOSE_BULLDIR
	         END IF
	         CALL OPEN_BULLNEWS_SHARED 
                 CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER1_NUMBER,IER)
                 F1_LAST = 0
                 F1_COUNT = 0 
		 F1_START = 0 
		 F1_NBULL = 06
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,8) D
	         FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,13)R
	      ELSE IF (STORED.EQ.1.AND..NOT.BTEST(FOLDER1_FLAG,8)) THEN
	         F1_LAST = 0'
                 F1_COUNT = 0e
		 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)e
	      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)r
           END DOi
	   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)1
	      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)E
	      CLOSE (UNIT=3,DISPOSE='DELETE')
	   END IF
	   IF (FOLDER_SAVE.NE.FOLDER) THEN 
              FOLDER_NUMBER = -1
	      FOLDER1 = FOLDER_SAVE
              CALL SELECT_FOLDER(.FALSE.,IER) 
	      IF (.NOT.IER) THEN 
	         FOLDER_NUMBER = 0 
	         CALL SELECT_FOLDER(.FALSE.,IER)L
                 WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &              FOLDER(:TRIM(FOLDER))s
	      END IF
	      RETURN 
           END IFT
 	ELSE IF (DEFAULT.AND.(ALL.OR.FLAG)) THEN
           WRITE (6,'('' Modifying news groups.'',
     &			''  This will take a while...'')')
	   IER = 0S
	   DO WHILE (IER.EQ.0)6
	      CALL READ_FOLDER_FILE_TEMP(IER)
              IF (EXPIRE.GE.0) FOLDER1_BBEXPIRE = 0T
              IF (LIMIT.GE.0) F1_EXPIRE_LIMIT = 0T
	      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 = 0I
		 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)E
	      IF (ENABLE) FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,9)v
	      IF (DISABLE) FOLDER1_FLAG = IBSET(FOLDER1_FLAG,9)
	      CALL REWRITE_FOLDER_FILE_TEMP(IER)S
	   END DO	   
	END IFG

	FOLDER_NUMBER = -1C
	FOLDER1 = FOLDERA
        CALL SELECT_FOLDER(.FALSE.,IER))
	IF (.NOT.IER) THEN 
	   FOLDER_NUMBER = 0=
	   CALL SELECT_FOLDER(.FALSE.,IER)E
           WRITE (6,'('' Resetting to '',A,'' folder.'')')
     &        FOLDER(:TRIM(FOLDER))D
	END IFR

	CALL CLOSE_BULLNEWS

        RETURN
        END 




	SUBROUTINE INCLUDE(EXCLUDE)

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC'E

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'N

	COMMON /POINT/ BULL_POINT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /LAST_BUFFER/ OLD_BUFFER
 	CHARACTER*(INPUT_LENGTH) OLD_BUFFERI

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMF

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

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

	CALL ENABLE_PRIVS

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

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

	   CALL OPEN_BULLFIL_SHARED	! Open BULLETIN file'

	   ILEN = LINE_LENGTH + 1

	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)I
	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN.
	      IF (CLI$PRESENT('SUBJECT')) THENG
	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)'
	      ELSEH
	         INPUT = INPUT(7:) 
	         IF (INDEX(INPUT,'%"').GT.0) THEN
	            INPUT = INPUT(INDEX(INPUT,'%"')+2:ILEN-1)
	         END IF
	      END IFP
	   ELSE
	      INPUT = FROMA
	   END IF
	   IF (CLI$PRESENT('SUBJECT')) THEN
	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
	         INPUT = INPUT(7:)E
	      ELSER
		 INPUT = DESCRIP
	      END IFt
	   END IF

	   CALL CLOSE_BULLFIL
	END IFE

	IF (CLI$PRESENT('SUBJECT')) THEN
	   INPUT = 'SUBJECT:'//INPUTp
	ELSEt
	   INPUT = 'FROM:'//INPUT
	END IF 

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

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

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

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

	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER) OLEN,OLD_BUFFERC
	   IF (IER.EQ.0) THEN	      I
	      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) THENW
		    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(:OLEN),INPUT(:ILEN))) THEN 
	         IF (.NOT.DISABLE) THEN
		    WRITE (6,'('' ERROR: Entry already present.'')') g
		    CLOSE (UNIT=4)	 
		    CLOSE (UNIT=3)	
		    RETURN
		 END IF 
 	      ELSE IF (.NOT.(ALL.AND.INPUT(:FLEN+8).EQ.U
     &		OLD_BUFFER(:MIN(FLEN+8,OLEN)))) THEN
                 WRITE (4,'(A)',IOSTAT=IER) OLD_BUFFER(:OLEN)M
	      END IFR
	   END IF
	END DOO

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

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

	CALL CHECK_CUSTOM

        RETURN
        END 




	SUBROUTINE SET_CUSTOM(PARAM)M
CW
C  SUBROUTINE SET_CUSTOM
CT

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLDIR.INC'

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	CHARACTER*(*) PARAM

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

	CALL DISABLE_PRIVSE

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

	CALL ENABLE_PRIVS

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

	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)R
	   END IF
	END DO 

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

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

	CALL CHECK_CUSTOM

        RETURN
        END 




	SUBROUTINE CHECK_CUSTOM

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOML
	DATA BULL_USER_CUSTOM/.FALSE./R

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEG
	DATA SCRATCH_B1/0/,

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /FILE_DIRECTORY/ FILE_DIRECTORYR
	CHARACTER*64 FILE_DIRECTORY

	FILE_DIRECTORY = ' ' 

	IF (.NOT.BTEST(BULL_USER_CUSTOM,4)) THENa
	   BULL_USER_CUSTOM = .FALSE.
	ELSER
	   BULL_USER_CUSTOM = .FALSE.
	   BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,4)
	END IFE

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

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

	IF (IER.NE.0) RETURNE

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

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

	CLOSE (UNIT=17)

        RETURN
	END



	R
	LOGICAL FUNCTION INCLUDE_MSG(STRING,STRING1)R

	IMPLICIT INTEGER (A-Z)C

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'i

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

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

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDEU
	DATA SCRATCH_B1/0/

	CHARACTER*(*) STRING,STRING1E

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

	SCRATCH_B = SCRATCH_B1			! Init queue pointer to header

	FLEN = TRIM(FOLDER_NAME)C

	INC = .FALSE.

	DO I=1,NINCLUDE
	   CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,OLD_BUFFER))
	   OLEN = TRIM(OLD_BUFFER)E
	   IF (STREQ(FOLDER_NAME(:FLEN)//':',
     &		OLD_BUFFER(:MIN(FLEN+1,OLEN)))) THEN
	      IF (STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')) THENS
		 IF (.NOT.INC) INCLUDE_MSG = .FALSE.
		 INC = .TRUE.R
	      END IFL
	      IF ((STREQ(OLD_BUFFER(FLEN+10:FLEN+14),'FROM:').AND.L
     &		  (STRFIND(STRING(:TRIM(STRING)),OLD_BUFFER=
     &		  (FLEN+15:OLEN)).OR.P
     &		  STREQ(STRING(:TRIM(STRING)),OLD_BUFFER
     &		  (FLEN+15:FLEN+14+TRIM(STRING))))).OR.N
     &		  (STREQ(OLD_BUFFER(FLEN+10:FLEN+17),'SUBJECT:').AND.A
     &		  STRFIND(STRING1(:TRIM(STRING1)),OLD_BUFFER
     &		  (FLEN+18:OLEN)))) THEN
		 INCLUDE_MSG = STREQ(OLD_BUFFER(FLEN+2:FLEN+8),'INCLUDE')'
		 IF (.NOT.INCLUDE_MSG) RETURNn
	      END IF
	   END IF
	END DO_

	RETURN 
	END



	FUNCTION STRFIND(STRING,STRING1)p

	IMPLICIT INTEGER (A-Z)	

	CHARACTER*(*) STRING,STRING1!

	L = LEN(STRING1)
	DO I=0,LEN(STRING)-LO
	   J = 1d
	   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) THENL
		 J = L + 1
	      ELSE IF (J.EQ.L) THEN
		 STRFIND = .TRUE.
		 RETURNT
	      ELSEO
	         J = J + 1I
	      END IFG
	   END DO
	END DO'

	STRFIND = .FALSE.

	RETURNE
	END




        SUBROUTINE SET_NEWNAME

        IMPLICIT INTEGER (A-Z)

        INCLUDE 'BULLUSER.INC'

	COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)P
	COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX)
	COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)
	COMMON /USERINFO/ LAST(2,FOLDER_MAX)T

	CHARACTER*12 NEW,OLD.

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

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

	CALL OPEN_BULLUSER_SHARED

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

	IF (IER.EQ.0) THENP
	   USERNAME = NEW
           DO WHILE (REC_LOCK(IER))E
	      READ (4,IOSTAT=IER,KEYEQ=NEW)
	   END DO A
	   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))S
	   READ (4,IOSTAT=IER1,KEYEQ=USERNAME) USER_ENTRY
	END DO 

	CALL CLOSE_BULLUSER

	IF (IER.NE.0) THENE
	   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) THENE
	   WRITE (9,IOSTAT=IER) NEW,LAST5
	ELSE 
	   REWRITE (9,IOSTAT=IER) NEW,LASTU
	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))U
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO N
	   IF (IER.NE.0) THEN
	      WRITE (9,IOSTAT=IER) NEW,LAST
	   ELSE
	      REWRITE (9,IOSTAT=IER) NEW,LAST
	   END IF	E
	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)))N
	NEW(LENN:LENN) = CHAR(127.AND.ICHAR(NEW(LENN:LENN)))4

	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)))(
	ELSED
	   OLD(2:2) = CHAR(128.OR.ICHAR(OLD(2:2)))E
	END IFL
	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 IFM
        DO WHILE (REC_LOCK(IER))
	   READ (9,KEY=OLD,IOSTAT=IER) OLD,LAST
	END DO 
	IF (IER.EQ.0) THENL
           DO WHILE (REC_LOCK(IER))A
	      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	G
	ELSE
           DO WHILE (REC_LOCK(IER))M
	      READ (9,KEY=NEW,IOSTAT=IER)
	   END DO A
	   IF (IER.EQ.0) DELETE (9)
	END IF 

	CALL CLOSE_BULLINFR

        RETURN
        ENDN
