C
C  BULLETIN10.FOR, Version 5/5/93
C  Purpose: Contains subroutines for the BULLETIN utility program.
C  Environment: VAX/VMS
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
	INTEGER FUNCTION NEWS_READ()

	IMPLICIT INTEGER (A-Z)

	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280

	PARAMETER CR = CHAR(13), LF = CHAR(10)

	COMMON /NEWS_INIT/ END_READ

	NEWS_READ = 1

	IF (END_READ.EQ.0) THEN
	   IER = NEWS_READ_PACKET(BUFFER(:1024))
	   IF (IER.LE.0) THEN
	      CALL NEWS_LOGOUT
	      NEWS_READ = 0
	      RETURN
	   END IF
	   START_READ = 1
	   END_READ = IER
	END IF

	IF (END_READ.EQ.0) THEN
	   NEWS_READ = 0
	   RETURN
	END IF

	DO WHILE (NEWS_READ.GT.0)
	   END_LINE = INDEX(BUFFER(START_READ:END_READ),LF)
	   IF (END_LINE.GT.257.OR.
     &	       (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN
	      END_LINE = 255
	   END IF
	   IF (END_LINE.GT.0) THEN
	      SB = START_READ
	      END_LINE = END_LINE + SB - 1
	      EB = END_LINE - 2
	      IF (BUFFER(EB+2:EB+2).NE.LF) EB = EB + 2
	      IF (END_LINE.LT.END_READ) THEN
		 START_READ = END_LINE + 1
	      ELSE
		 END_READ = 0
	      END IF
	      RETURN
	   ELSE
	      BUFFER = BUFFER(START_READ:END_READ)
	      END_READ = END_READ - START_READ + 1
	      IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024))
	      IF (IER.LE.0) THEN
		 NEWS_READ = 0
		 RETURN
	      ELSE
		 START_READ = 1
		 END_READ = END_READ + IER
	      END IF
	   END IF
	END DO

	RETURN
	END




	INTEGER FUNCTION NEWS_WRITE(WRITE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	PARAMETER CR = CHAR(13), LF = CHAR(10)

	COMMON /NEWS_INIT/ END_READ

        COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
        COMMON /LOCALPOST/ LOCAL_POST

	CHARACTER*(*) WRITE

	LOGICAL TRY_RECONNECT/.FALSE./

	IF (LOCAL_POST) THEN
	   WRITE (8,'(A)') WRITE
	   DO I=1,LEN(INPUT),255
	      CALL COMPRESS(WRITE,INPUT,L)
	      LENGTH = LENGTH + MAX(1,L) + 1
	   END DO
	   NEWS_WRITE = .TRUE.
	   RETURN
	END IF

	END_READ = 0

	IF (WRITE.EQ.' ') THEN
	   NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF)
	ELSE
	   NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF)
	END IF

	IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN
	   TRY_RECONNECT = .TRUE.
	   CALL NEWS_RECONNECT(WRITE)
	   TRY_RECONNECT = .FALSE.
	END IF

	RETURN
	END




	SUBROUTINE NEWS_RECONNECT(WRITE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	COMMON /POINT/ BULL_POINT

	CHARACTER*(*) WRITE

	CHARACTER*8 NUMBER

	CHARACTER*(FOLDER_RECORD) FOLDER2_COM

	CALL NEWS_LOGOUT

	IF (.NOT.NEWS_LOGIN()) RETURN

	IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN
	   FOLDER2_COM = FOLDER1_COM
	   FOLDER1 = FOLDER
	   FOLDER1_DESCRIP = FOLDER_DESCRIP
	   CALL NEWS_GROUP(IER)
	   IF (IER.NE.0) RETURN
	   FOLDER1_COM = FOLDER2_COM

	   IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN
	   IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	END IF

	IF (.NOT.NEWS_WRITE(WRITE)) RETURN

	RETURN
	END



	SUBROUTINE NEWS_LOGOUT

	IMPLICIT INTEGER (A-Z)

	COMMON /NEWS_CONNECTED/ NEWS_CONNECTED

	CALL NEWS_DISCONNECT
	NEWS_CONNECTED = .FALSE.

	RETURN
	END



	SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*(*) SUBJ,FOLDER1_COM

	IF (REMOTE_SET.EQ.1) THEN
	   WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER)
     &			 4,SBULL,IMMEDIATE,SUBJ
	   IF (IER.EQ.0) THEN
	      READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM
	   END IF
	ELSE IF (REMOTE_SET.GE.3) THEN
	   IF (TEST_NEWS_OWNER()) THEN
	      CALL NEWS_POST('cancel',0,IER,'Delete news item.')
	   ELSE IF (REMOTE_SET.EQ.3) THEN
	      WRITE (6,'('' ERROR: Not owner of message.'')')
	   END IF
	   IER = 0
	END IF

	RETURN
	END




	LOGICAL FUNCTION TEST_NEWS_OWNER()

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME

	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*256 MESSAGE_ID

	CHARACTER*12 HIGHFROM

	CALL STR$UPCASE(HIGHFROM,FROM)
	IF (LPATH.EQ.0) CALL GET_PATHNAME
	TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR.
     &	    (HIGHFROM.EQ.USERNAME.AND.
     &	    MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'):
     &	    TRIM(MESSAGE_ID)).EQ.
     &	    PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH))

	RETURN
	END


	INTEGER FUNCTION FIRST_INDEX(INPUT,FIND)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) INPUT,FIND

	FIRST_INDEX = 0

	DO I=1,LEN(FIND)
	   J = INDEX(INPUT,FIND(I:I))
	   IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX))
     &		FIRST_INDEX = J
	END DO

	RETURN
	END



	SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /XHDR/ XHDR
	LOGICAL XHDR /.FALSE./

	COMMON /POINT/ BULL_POINT

	CHARACTER*8 NUMBER,NUMBER1

	CHARACTER*1024 TEMP

	DATA QXHDR1 /0/

	IF (XHDR) THEN
	   IF (QXHDR1.NE.0) THEN		! Is queue empty?
	      QXHDR = QXHDR1		! No, set queue pointer to head
	   ELSE				! Else if queue is empty
	      CALL INIT_QUEUE(QXHDR,TEMP)
	      QXHDR1 = QXHDR		! Init header pointer
	   END IF
	END IF

	SYSTEM = 0

	IF (REMOTE_SET.EQ.1) THEN
	   IF (REVERSE) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START
	   ELSE
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END
	   END IF
	ELSE
	   IER = 2
	   NUMDIR = END - START + 1
	   IF (START.LT.F_START) THEN
	      START = F_START
	      END = START + NUMDIR - 1
	   END IF
	END IF

	IF (REMOTE_SET.EQ.3.AND.XHDR) THEN
	   IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
	   IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN
	   DO WHILE (NUMBER1(1:1).EQ.' ')
	      NUMBER1 = NUMBER1(2:)
	   END DO
	   NUMDIR1 = 0
	   BACKSEARCH = END
	   DO WHILE (NUMDIR1.LT.NUMDIR)
	      IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1))
     &								RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	      IF (BUFFER(:2).NE.'22') THEN
		 IF (NUMDIR1.EQ.0) THEN
		    IER = 0
		    END = START - 1
		    RETURN
		 ELSE
		    NUMDIR = NUMDIR1
		 END IF
	      ELSE
		 IF (.NOT.NEWS_READ()) RETURN
		 IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN
		    IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')
     &		        +SB-2),START,,%VAL(1))) RETURN
		 END IF
		 DO WHILE (BUFFER(SB:EB).NE.'.')
		    IF (NUMDIR1.LT.NUMDIR) THEN
		       NUMDIR1 = NUMDIR1 + 1
		       TEMP = BUFFER(SB:EB)
		       CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
		    END IF
		    IF (.NOT.NEWS_READ()) RETURN
		 END DO
		 IF (NUMDIR1.EQ.0) THEN
		    IF (START.LE.F_START.OR.REALEND.EQ.0) THEN
		       IF (REALEND.GT.0) THEN
		          IF (REALEND.GE.F_NBULL) RETURN
			  END = REALEND
		          REALEND = 0
		       END IF
		       IF (END.GE.F_NBULL) RETURN
		       START = MIN(F_NBULL,END+1)
		    ELSE
		       START = MAX(F_START,START-NUMDIR)
	            END IF
		    END = START + NUMDIR - 1
		    IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
		    IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN
		    DO WHILE (NUMBER1(1:1).EQ.' ')
		       NUMBER1 = NUMBER1(2:)
		    END DO
		 ELSE IF (NUMDIR1.LT.NUMDIR) THEN
		    IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1)))
     &								 RETURN
		    IF (.NOT.NEWS_READ()) RETURN
		    IF (.NOT.NEWS_WRITE('NEXT')) RETURN
		    IF (.NOT.NEWS_READ()) RETURN
		    IF (BUFFER(:2).NE.'22') THEN
		       NUMDIR = NUMDIR1
		    ELSE
		       NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2)
		       IF (.NOT.OTS$CVT_TI_L(NUMBER,
     &						MSG_NUM,,%VAL(1))) RETURN
		       DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ')
			  NUMBER = ' '//NUMBER(1:)
		       END DO
		       MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1
		       IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN
		       DO WHILE (NUMBER1(1:1).EQ.' ')
			  NUMBER1 = NUMBER1(2:)
		       END DO
		    END IF
		 END IF
	      END IF
	   END DO
	   CALL OTS$CVT_L_TI(START,NUMBER,,,)
	   NUMBER1 = TEMP(:INDEX(TEMP,' ')-1)
	   END = START + NUMDIR - 1
	   DO I=1,2
	      IF (I.EQ.1) THEN
		 IF (.NOT.NEWS_WRITE
     &		('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN
              ELSE
	         IF (.NOT.NEWS_WRITE
     &		('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN
              END IF
	      IF (.NOT.NEWS_READ()) RETURN
	      IF (BUFFER(:2).EQ.'22') THEN
		 QXHDR = QXHDR1
		 IF (.NOT.NEWS_READ()) RETURN
		 NUMDIR1 = 0
		 DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR)
		    NUMDIR1 = NUMDIR1 + 1
		    CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP)
		    SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1
		    SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1
		    TEMP(I*256+1:) = BUFFER(SB1:EB)
		    CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
		    IF (.NOT.NEWS_READ()) RETURN
		 END DO
	      END IF
	   END DO
	   QXHDR = QXHDR1
	   IER = 0
	ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN
	   IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
	   IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   IF (BUFFER(:2).NE.'22') THEN
	      IF (.NOT.NEWS_WRITE('NEXT')) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	      IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4:
     &		  INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN
	      IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN
		 BUFFER(:3) = '500'
		 DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22')
		    START = START + 1
		    IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
		    IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
		    IF (.NOT.NEWS_READ()) RETURN
		 END DO
		 IF (BUFFER(:2).NE.'22') THEN
		    IER = 0
		    END = START - 1
		    RETURN
		 END IF
	      END IF
	      IF (.NOT.NEWS_WRITE('HEAD')) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	      IER = OTS$CVT_TI_L(BUFFER(SB+4:
     &			INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
	      END = START + NUMDIR - 1
	   END IF
	   IER = 0
	END IF

	IF (IER.EQ.0) THEN
	   I = START
	   DO WHILE (IER.EQ.0.AND.I.LE.END)
	      IF (REMOTE_SET.EQ.1) THEN
		 READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY
	      ELSE IF (XHDR) THEN
		 CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
		 LTEMP = INDEX(TEMP,' ')
		 CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1))
		 CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM)
		 DESCRIP = TEMP(257:512)
		 CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768)))
	      ELSE
		 IER = OTS$CVT_TI_L(BUFFER(SB+4:
     &			INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1))
		 CALL NEWS_HEADER(IER)
		 IF (IER.NE.0) RETURN
	      END IF
	      CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)
	      I = I + 1
	      IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN
		 IER = 2
		 IF (.NOT.NEWS_WRITE('NEXT')) RETURN
		 IF (.NOT.NEWS_READ()) RETURN
		 IF (BUFFER(:3).NE.'223') THEN
		    END = I - 1
		    IER = 0
		    RETURN
		 END IF
		 IF (.NOT.NEWS_WRITE('HEAD')) RETURN
		 IF (.NOT.NEWS_READ()) RETURN
		 IER = 0
	      END IF
	   END DO
	END IF

	IF (REMOTE_SET.EQ.3) THEN
	   IER = 1
	   IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN
	   IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   IER = 0
	END IF

	RETURN
	END



	INTEGER FUNCTION NEWS_LOGIN

	IMPLICIT INTEGER (A-Z)

	COMMON /NEWS_CONNECTED/ NEWS_CONNECTED
	LOGICAL NEWS_CONNECTED /.FALSE./

	COMMON /XHDR/ XHDR
	LOGICAL XHDR /.FALSE./

	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280

	IF (.NOT.NEWS_CONNECTED) THEN
	   NEWS_LOGIN = .FALSE.
	   CALL START_NEWS_TIMER()
	   NEWS_CONNECTED = NEWS_CONNECT()
	   CALL CANCEL_NEWS_TIMER()
	   IF (.NOT.NEWS_CONNECTED) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   IF (.NOT.NEWS_WRITE('XHDR')) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   XHDR = BUFFER(:3).NE.'500'
	END IF

	NEWS_LOGIN = .TRUE.

	RETURN
	END


	SUBROUTINE CONVERT_TO_GMT(BTIM)

	IMPLICIT INTEGER (A-Z)

	COMMON /MONTHS/ MONTH
	CHARACTER*36 MONTH

	DIMENSION GMT_DIFF(2),BTIM(2)

	CHARACTER HOUR*4
	DATA HOUR /' '/

	PARAMETER NZONES = 4

	COMMON /ZONE/ ZONE,LZONE

	CHARACTER ZONES*(NZONES*4)
	CHARACTER*4 ZONE
	DATA ZONES /'EST CST MST PST '/

	CHARACTER TIME*12

	TO_GMT = .TRUE.

	ENTRY CONVERT_FROM_GMT(BTIM)

	IF (HOUR.EQ.' ') THEN
	   IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN
	      IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE)
     &	       .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN
	         HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)
	      ELSE
	         HOUR = '00'
	      END IF
	   END IF
	   ZONE = 'GMT'
	   IER = OTS$CVT_TI_L(HOUR(:TRIM(HOUR)),DIFF,,%VAL(1))
	   IF (DIFF.GE.5.AND.DIFF.LE.8) THEN
C
C  Following computes DST based on US formula
C
	      IER = SYS$ASCTIM(,TIME,BTIM,)
	      IER = OTS$CVT_L_TI(DATE,TIME(:2),,,)
	      CALL LIB$DAY_OF_WEEK(BTIM,DAY)
	      M = (INDEX(MONTH,TIME(4:6))+2)/3
	      IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE)
     &			.AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN
		 DIFF = DIFF - 1
	         IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,)
	      END IF
           END IF
	   IF (DIFF.LT.0) THEN
	      PAST = .TRUE.
	      HOUR = HOUR(2:)
	   ELSE IF (DIFF.GT.12) THEN
	      PAST = .TRUE.
	      DIFF = 24 - DIFF
	      IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,)
	      IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:)
	   ELSE
	      PAST = .FALSE.
	   END IF
	   LZONE = TRIM(ZONE)
	   IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR))//':00',GMT_DIFF)
	END IF

	IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN
	   IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM)
	ELSE
	   IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM)
	END IF

	TO_GMT = .FALSE.

	RETURN
	END




	SUBROUTINE START_NEWS_TIMER()

	IMPLICIT INTEGER (A-Z)

	INTEGER TIMADR(2)			! Buffer containing time
						! in desired system format.
	CHARACTER TIMBUF*16,SEC*4
	DATA TIMBUF/'0 00:00:00.00'/

	EXTERNAL KILL_NEWS_CONNECT

	IF (TIMBUF(9:10).EQ.'00') THEN
	   CALL LIB$GET_EF(WAITEFN)
	   TIMBUF(9:10) = '30'
	   IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN
	      IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1))
	      IF (IER.AND.I.GT.0) THEN
		 IF (TRIM(SEC).EQ.1) THEN
		    TIMBUF(9:10) = '0'//SEC(:1)
		 ELSE
		    TIMBUF(9:10) = SEC
		 END IF
	      END IF
	   END IF
	   IER = SYS$BINTIM(TIMBUF(:13),TIMADR)
	END IF

	IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,)

	RETURN

	ENTRY CANCEL_NEWS_TIMER()

	IER = SYS$CANCEL(%VAL(WAITEFN))

	RETURN
	END


	SUBROUTINE KILL_NEWS_CONNECT()

	IMPLICIT INTEGER (A-Z)

	COMMON /NEWS_CONNECTED/ NEWS_CONNECTED

	IF (NEWS_CONNECTED) RETURN

	NLUN = NEWS_GET_CHAN()

	IER = SYS$CANCEL(%VAL(NLUN))

	CALL NEWS_DISCONNECT()

	RETURN
	END



	SUBROUTINE NEWS_HEADER(IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280

	COMMON /REF/ REFERENCES,LREF
	CHARACTER*256 REFERENCES

	COMMON /NEWSGROUPS/ NEWSGROUPS
	CHARACTER*256 NEWSGROUPS

	COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE
	CHARACTER*256 FROM_LINE,SUBJECT_LINE
	CHARACTER*12 MSGNUM

	EX_BTIM(1) = 0
	EX_BTIM(2) = 0

	DESCRIP = ' '
	FROM = ' '
	SUBJECT_LINE = ' '
	FROM_LINE = ' '
	NEWSGROUPS = ' '
	LREF = 0

	MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4)

	DO WHILE (BUFFER(SB:EB).NE.'.')
	   IER = NEWS_READ()
	   IF (.NOT.IER) RETURN
	   IF (BUFFER(SB:EB).NE.'.') THEN
	      IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN
		 SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8
		 SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB)
		 DESCRIP = BUFFER(SB1:EB)
	      ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN
		 CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM)
	      ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN
		 CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM)
	      ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN
		 SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5
		 FROM_LINE = 'From: '//BUFFER(SB1:EB)
		 CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1)
              ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND.
     &                                              EB.GT.SB+11) THEN
                 NEWS_MSGID = BUFFER(SB+13:EB-1)
		 IF (LREF.EQ.0) THEN
		    REFERENCES = BUFFER(SB+12:EB)
		 ELSE
		    REFERENCES = REFERENCES(:LREF)//' '//
     &				BUFFER(SB+12:EB)
		 END IF
		 LREF = TRIM(REFERENCES)
	      ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND.
     &						    EB.GT.SB+11) THEN
		 SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11
		 NEWSGROUPS = BUFFER(SB1:EB)
	      ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND.
     &						    EB.GT.SB+11) THEN
		 IF (LREF.EQ.0) THEN
		    REFERENCES = BUFFER(SB+12:EB)
		 ELSE
	            REFERENCES = BUFFER(SB+12:EB)//' '//
     &				REFERENCES(:LREF)
	   	 END IF
	         LREF = TRIM(REFERENCES)
	      END IF
	   END IF
	END DO

	IER = 0

	RETURN
	END



	INTEGER FUNCTION FIRST_ALPHA(INPUT)

	CHARACTER*(*) INPUT

	DO I=1,LEN(INPUT)
	   IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' '
	END DO

	DO FIRST_ALPHA=1,LEN(INPUT)
	   IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN
	END DO

	RETURN
	END




	SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280

	CHARACTER*8 NUMBER

	IF (REMOTE_SET.EQ.1) THEN
	   WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH
	ELSE
	   IER = 2
	   IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START
	   IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN
	   IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   IF (BUFFER(:2).NE.'22') RETURN
	   IER = 0
	END IF

	RETURN
	END



	SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	COMMON /READIT/ READIT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280

	DIMENSION IN_BTIM(2)

	CHARACTER TIME*20,FIRST*80

	CHARACTER*8 NUMBER

	IF (REMOTE_SET.EQ.1) THEN
	   WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2)
	   IF (IER.EQ.0) THEN
	      READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START
	   END IF
	ELSE IF (READIT.EQ.1) THEN
	   I = NEWS_FIND_SUBSCRIBE()
	   START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) +
     &			LAST_NEWS_READ(2,I) + 1
	   IF (START.GT.F_NBULL) THEN
	      START = -1
	   ELSE
	      LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I))
     &			.OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)
	   END IF
	ELSE
	   START = -1
	   IER = SYS$ASCTIM(,TIME,IN_BTIM,)
	   CALL DATE_TIME(TIME)
	   SKIP = 0
	   DO WHILE (SKIP.GE.0)
	      IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM(
     &		  FOLDER_NAME))//' '//TIME)) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	      IF (BUFFER(:2).EQ.'23') THEN
		 IF (.NOT.NEWS_READ()) CALL EXIT
		 DO I=1,SKIP
		    IF (.NOT.NEWS_READ()) CALL EXIT
		 END DO
		 FIRST = BUFFER(SB:EB)
		 IF (FIRST.EQ.'.') RETURN
		 DO WHILE (BUFFER(SB:EB).NE.'.')
		    IF (.NOT.NEWS_READ()) CALL EXIT
		 END DO
		 IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST))))
     &					  CALL EXIT
		 IF (.NOT.NEWS_READ()) CALL EXIT
		 IF (BUFFER(:2).EQ.'22') THEN
		    IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN
		       I = F_NBULL + 1
		       DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE.
     &			   BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))
     &			   .OR.I.GT.F_NBULL))
			  I = I - 1
			  IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN
			  IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
			  IF (.NOT.NEWS_READ()) RETURN
		       END DO
		       IF (I.GE.F_START) START = I
		    ELSE
		       IER = OTS$CVT_TI_L(BUFFER(SB+4:
     &			  INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
		    END IF
		    RETURN
		 END IF
	      END IF
	      SKIP = SKIP + 1
	   END DO
	END IF

	RETURN
	END



	SUBROUTINE REMOTE_COPY_BULL(IER)

	IMPLICIT INTEGER (A-Z)

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	IF (REMOTE_SET.EQ.1) THEN
	   WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2
	ELSE
	END IF

	RETURN
	END



	SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT)

	IMPLICIT INTEGER (A-Z)

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*(*) OUTPUT

	IF (REMOTE_SET.EQ.1) THEN
	   WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT
	ELSE
	END IF

	RETURN
	END



	SUBROUTINE GET_REMOTE_MESSAGE(IER)
C
C  SUBROUTINE GET_REMOTE_MESSAGE
C
C  FUNCTION:
C	Gets remote message.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE '($RMSDEF)'

	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1
	DATA SCRATCH_R1 /0/

	COMMON /REF/ REFERENCES,LREF
	CHARACTER*256 REFERENCES

	COMMON /NEWSGROUPS/ NEWSGROUPS
	CHARACTER*256 NEWSGROUPS

	COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE
	CHARACTER*256 FROM_LINE,SUBJECT_LINE
	CHARACTER*12 MSGNUM

	COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1

	CHARACTER*256 TEMP,TEMP1

	IF (SCRATCH_R1.NE.0) THEN		! Is queue empty?
	   SCRATCH_R = SCRATCH_R1		! No, set queue pointer to head
	ELSE					! Else if queue is empty
	   CALL INIT_QUEUE(SCRATCH_R,INPUT)
	   SCRATCH_R1 = SCRATCH_R		! Init header pointer
	END IF

	ILEN = 128
	IER = 0
	LENGTH = 0
	LTEMP = 0
	HEADER_SEEN = .FALSE.

        IF (REMOTE_SET.EQ.3) THEN
	   LSUB = TRIM(SUBJECT_LINE)
	   LFRO = TRIM(FROM_LINE)
	   IF (LOCAL_UPDATE1.NE.0) THEN
              ILEN = 1
	      INPUT(:1) = CHAR(0)
           END IF
	END IF

	DO WHILE (ILEN.GT.0.AND.IER.EQ.0)
	   IF (REMOTE_SET.EQ.1) THEN
	      READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT
	   ELSE
	      IF (ILEN.EQ.128) ILEN = 0
	      IF (LTEMP.GT.0) THEN
		 ILEN = MIN(128,LTEMP)
		 INPUT = TEMP(:ILEN)
		 LTEMP = LTEMP - ILEN
	      END IF
	      IF (ILEN.LT.128) THEN
		 IF (LFRO.GT.0) THEN
                    IF (LOCAL_UPDATE1.NE.0) THEN
	               CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO)
	            END IF
		    LTEMP = LFRO
		    LFRO = 0
		    IER = 0
		    TEMP = CHAR(LTEMP)//FROM_LINE
		    LTEMP = LTEMP + 1
		    LINP = MIN(LTEMP,128-ILEN)
		    INPUT = INPUT(:ILEN)//TEMP(:LINP)
		    ILEN = ILEN + LINP
		    LTEMP = LTEMP - LINP
		    TEMP = TEMP(LINP+1:)
		 ELSE IF (LSUB.GT.0) THEN
                    IF (LOCAL_UPDATE1.NE.0) THEN
	               CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB)
	            END IF
		    LTEMP = LSUB
		    LSUB = 0
		    IER = 0
		    TEMP = CHAR(LTEMP)//SUBJECT_LINE
		    LTEMP = LTEMP + 1
		    LINP = MIN(LTEMP,128-ILEN)
		    INPUT = INPUT(:ILEN)//TEMP(:LINP)
		    ILEN = ILEN + LINP
		    LTEMP = LTEMP - LINP
		    TEMP = TEMP(LINP+1:)
		 ELSE
		  IER = NEWS_READ()
		  IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN
		    IER = 0
		    LTEMP = EB-SB+1
		    IF (LTEMP.GT.0) THEN
		       TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1)
		       IF (.NOT.HEADER_SEEN) THEN
	                  IF (TRIM(TEMP).EQ.0) THEN
			     HEADER_SEEN = .TRUE.
 			  ELSE IF (INDEX(TEMP,': ').EQ.0.AND.
     &	 			INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR(
     &				TEMP(2:2)).GT.32.AND.LTEMP.LT.255) THEN
			     TEMP = CHAR(LTEMP+1)
     &					//' '//BUFFER(SB:SB+LTEMP-1)
   			     LTEMP = LTEMP + 1
			  END IF
		       END IF 
                       IF (LOCAL_UPDATE1.NE.0) THENs
	                  CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP)
		          TEMP(:1) = CHAR(LTEMP)
	               END IF	1
		    ELSE
		       HEADER_SEEN = .TRUE.e
		       TEMP = CHAR(1)//' '
		       LTEMP = 1
		    END IF
		    LTEMP = LTEMP + 1a
		    LINP = MIN(LTEMP,128-ILEN)
		    INPUT = INPUT(:ILEN)//TEMP(:LINP)a
		    ILEN = ILEN + LINP
		    LTEMP = LTEMP - LINP
		    TEMP = TEMP(LINP+1:)
		  ELSE IF (IER) THEN
		    IER = 0,
		    INPUT = INPUT(:ILEN)//CHAR(0)R
		    ILEN = -128)
		  ELSE
		    ILEN = 128
		  END IF
		 END IF
	      ELSE1
		 TEMP = TEMP(129:)
	      END IF 
	   END IF
	   IF (IER.NE.0.AND.ILEN.GT.0) THEN
	      CALL ERRSNS(IDUMMY,IER1)
	      IF (IER1.EQ.RMS$_RER) THEN	! Ignore this error 
		 IER = 0
		 ILEN = 0E
	      ELSED
		 CALL SYS_GETMSG(IER1)
		 LENGTH = 0S
		 IER1 = IER 
		 CALL DISCONNECT_REMOTEL
		 IER = IER1	! IER is set to 0 by DISCONNECT_REMOTE
	      END IFL
	   ELSE IF (ABS(ILEN).EQ.128) THEN 
	      CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT)
	      LENGTH = LENGTH + 1
	   END IF
	END DO(

	RETURN.
	END




	SUBROUTINE REMOTE_REMOVE_FOLDER(IER)N

	IMPLICIT INTEGER (A-Z) 

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	RETURN 
	END



	SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
CI
C  SUBROUTINE CONNECT_REMOTE_FOLDER
C 
C  FUNCTION: Connects to folder that is located on other DECNET node.A
CN
	IMPLICIT INTEGER (A-Z) 

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
	DATA REMOTE_UNIT /15/

	COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH_
	COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) 
	COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE
	CHARACTER*4 SEPARATE

	COMMON /READIT/ READITT

	COMMON /NEWS_INIT/ END_READ

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFILES.INC'

	CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE
	CHARACTER*44 FOLDER_SAVE

	DIMENSION DUMMY(4)S

	IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN
	   END_READ = 0
	   IF (.NOT.NEWS_LOGIN()) THENR
	      IER = 2
	      RETURN1
	   END IF
	   CALL NEWS_GROUP(IER)
	   IF (IER.NE.0) RETURN
	   IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT)
	   RETURN
	END IF 

	REMOTE_UNIT = 31 - REMOTE_UNIT

	SAME = .TRUE.
	LEN_BBOARD = TRIM(FOLDER1_BBOARD)
	IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN  ! Remote folder name differentF
	   SAME = .FALSE.			  ! from local?  Yes.
	   LEN_BBOARD = LEN_BBOARD - 1E
	END IF 

	OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,E
     &		FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"')

	IF (IER.EQ.0) THENN
	   IF (.NOT.SAME) THEN'
	      FOLDER1_FILE = FOLDER_FILE 
	      FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER1C
	      REMOTE_SET_SAVE = REMOTE_SET
	      REMOTE_SET = .FALSE.E
	      CALL OPEN_BULLDIR
	      CALL READDIR(0,IER)
	      CALL CLOSE_BULLDIRD
	      REMOTE_SET = REMOTE_SET_SAVEO
	      FOLDER_FILE = FOLDER1_FILE 
	      FOLDER_SAVE = FOLDER1
	      FOLDER1 = BULLDIR_HEADER(13:)
	      IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25)
	   END IF
	   SYSLOG = .FALSE.
	   IF (READIT.EQ.1) THENM
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?'
	      READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1
	      IF (IER1) THENT
		 WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+'N
		 SYSLOG = .TRUE.
	      END IFC
	   END IF
	   IF (.NOT.SYSLOG) THEN 
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1
	   END IF
	   FOLDER_OWNER_SAVE = FOLDER1_OWNERP
	   FOLDER_BBOARD_SAVE = FOLDER1_BBOARDR
	   FOLDER_NUMBER_SAVE = FOLDER1_NUMBERS
	   IF (IER.EQ.0) THEN
	      IF (SYSLOG) THEN
		 READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY,(
     &		   DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM
	      ELSEN
		 READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,_
     &		   DUMMY(1),DUMMY(2),FOLDER1_COM
	      END IFF
	   END IF
	   IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE
	   FOLDER1_BBOARD = FOLDER_BBOARD_SAVEE
	   FOLDER1_NUMBER =  FOLDER_NUMBER_SAVE
	   FOLDER1_OWNER = FOLDER_OWNER_SAVE)
	END IF 

	IF (IER.NE.0.OR..NOT.IER1) THEN
	   CLOSE (UNIT=REMOTE_UNIT)
	   REMOTE_UNIT = 31 - REMOTE_UNIT
	   IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND.U
     &	       TEST_BULLCP().NE.2) THEN			! Not BULLCP processR
	      IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)A
     &		  .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN
		 CALL OPEN_BULLUSER_SHARED
		 CALL READ_USER_FILE_KEYNAME(USERNAME,IER)
		 CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)I
		 CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE)E
		 IF (IER.EQ.0) REWRITE (4) USER_ENTRY&
		 CALL CLOSE_BULLUSER
	      END IFP
	   END IF
	   IER = 2A
	ELSE)
	   CLOSE (UNIT=31-REMOTE_UNIT)I
CG
C  If remote folder has returned a last read time for the folder,
C  and if in /LOGIN mode, or last selected folder was a different
C  folder, or folder specified with "::", then update last read time.O
C.
	   IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)T
     &		.AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0))
     &		.OR.FOLDER1_NUMBER.EQ.-1) THEN
	      CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY)U
	      IF (SYSLOG) THENC
		 CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3))M
	      END IFD
	   END IF
	   IER = 0T
	END IFO

	RETURND
	END



	SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)

	IMPLICIT INTEGER (A-Z)C

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'E

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /BUFFER/ BUFFER,SB,EBe
	CHARACTER BUFFER*1280

	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*256 MESSAGE_IDi

	COMMON /NEXT/ NEXTI
	LOGICAL NEXT /.FALSE./ 

	COMMON /NEWGROUP/ NEWGROUP(

	CHARACTER*8 NUMBERW

	DIMENSION IN_BTIM(2)O

	IF (REMOTE_SET.EQ.1) THEN
	   IF (ICOUNT.GE.0) THENT
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT 
	   ELSE
	      WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEYH
	   END IF
	   IF (IER.EQ.0) THEN
	      IF (ICOUNT.EQ.0) THEN
		 READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADERF
	      ELSE IF (ICOUNT.EQ.-1) THEN
		 READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY
		 IF (IER1.GT.0) THEN
		    CALL ERROR_AND_EXIT1
		 ELSE IF (IER.NE.0) THEN
		    CALL CONVERT_ENTRY_FROMBIN
		 END IFO
		 RETURND
	      ELSE)
		 READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY
	      END IF	
	   END IF
	   IF (IER.GT.0) THEN
	      CALL ERROR_AND_EXIT
	   ELSE IF (ICOUNT.EQ.1) THEN
	      CALL CONVERT_HEADER_FROMBIN
	   ELSE
	      CALL CONVERT_ENTRY_FROMBIN
	   END IF
	ELSE IF (REMOTE_SET.EQ.3) THENE
	   IF (ICOUNT.EQ.0) THEN(
	      NBULL = F_NBULL
	      ICOUNT = 1S
	      RETURNH
	   ELSE IF (ICOUNT.EQ.-1) THENU
	      IER = 2
	      CALL GET_MSGBTIM(MSG_KEY,IN_BTIM)
	      CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)
	      IF (START.EQ.-1) RETURN
	      IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT
	      IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
	   ELSE
	      IER = 2
	      IF (NEXT.AND..NOT.NEWGROUP) THEN_
		 IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT
		 IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
		 IF (BUFFER(:3).NE.'223') RETURN
		 IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXITE
		 IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
	      ELSE	
		 IF (ICOUNT.LT.F_START) ICOUNT = F_START
		 IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL
		 IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN
		 IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))
     &						CALL ERROR_AND_EXITR
		 IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
	      END IF,
	      IF (BUFFER(:2).NE.'22') THEN(
		 DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) 
		    ICOUNT = ICOUNT - 1N
		    IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURNI
		    IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))
     &						CALL ERROR_AND_EXITN
		    IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT 
		    IF (BUFFER(:2).EQ.'22') THEN
		       NEXT = .FALSE. 
		       DO WHILE (BUFFER(SB:EB).NE.'.')
	                  IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
	               END DO
	            END IF 
		 END DOS
		 IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN
		    IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT
		    IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITR
		    IF (BUFFER(:3).NE.'223') RETURN$
		    IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT
		    IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT)
		 ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THENE
		    IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT
		    IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXITN
		    IF (BUFFER(:3).NE.'223') RETURN 
		    IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT
		    IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
		 END IF 
	      END IF 
	      IF (BUFFER(:2).NE.'22') RETURNF
	      IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3),
     &							ICOUNT,,%VAL(1))R
	      IF (.NOT.IER) RETURN'
	      START = ICOUNTQ
	      BULLETIN_NUM = START(
	   END IF
	   NEWGROUP = .FALSE.
	   MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1)
	   IER = 0
	   CALL NEWS_HEADER(IER)Q
	   IF (IER.GT.0) THEN
	      CALL ERROR_AND_EXIT
	   ELSE
	      CALL CONVERT_ENTRY_FROMBIN1
	   END IF
	   BLOCK = START1
	   MSG_NUM = START
	   SYSTEM = 0
	   IF (ICOUNT.NE.-1) THEN
	      ICOUNT = ICOUNT + 1
	   ELSE
	      IER = START
	   END IF
	END IF

	RETURN 
	END





	SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM)T

	IMPLICIT INTEGER (A-Z)O

	INTEGER BTIM(2)

	CHARACTER*8 MSG_KEY,INPUT

	INPUT = MSG_KEY

	DO I=1,8U
	   INPUT(9-I:9-I) = MSG_KEY(I:I)N
	END DO(

	CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1))

	RETURN'
	END



	SUBROUTINE NEWS_GROUP(IER)(

	IMPLICIT INTEGER (A-Z).

	INCLUDE 'BULLFOLDER.INC' 

	COMMON /BUFFER/ BUFFER,SB,EBS
	CHARACTER BUFFER*1280

	COMMON /NEWGROUP/ NEWGROUP.

	IER = NEWS_WRITE('GROUP '//
     &			 FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1))N
	IF (.NOT.IER) RETURN 

	IER = NEWS_READ()
	IF (.NOT.IER) RETURN,

	IF (BUFFER(:3).EQ.'411') RETURN

	NEWGROUP = .TRUE.

	BUFFER = BUFFER(5:)

	IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1))
	IF (.NOT.IER) RETURNN
	BUFFER = BUFFER(INDEX(BUFFER,' ')+1:)
	IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))I
	IF (.NOT.IER) RETURNT
	BUFFER = BUFFER(INDEX(BUFFER,' ')+1:)
	IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) 
	IF (.NOT.IER) RETURN 
	BUFFER = BUFFER(INDEX(BUFFER,' ')+1:)

	IER = NEWS_WRITE('STAT') 
	IF (.NOT.IER) RETURN(

	IER = NEWS_READ()
	IF (.NOT.IER) RETURN.

	IER = OTS$CVT_TI_L(BUFFER(SB+4:
     &			   INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
	IF (IER.AND.START.GT.F1_START) F1_START = START

	IF (F1_START.EQ.0) F1_NBULL = 0

	IER = 0

	RETURN_
	END



	SUBROUTINE NEWS_TIME(INTIME,BTIM)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) INTIME)

	CHARACTER*20 TIME

	I = 1
	LTIME = TRIM(INTIME)
	DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR.B
     &			ICHAR(INTIME(I:I)).GT.ICHAR('9')))	
	   I = I + 1E
	END DO	

	IF (I.GT.LTIME) THEN 
	   CALL SYS_BINTIM('-',BTIM)_
	   RETURN
	END IFL

	CALL STR$UPCASE(TIME,INTIME(I:))1

	DO J = 1,2M
	   I = 13
	   DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME))
	      I = I + 1
	   END DO
	   TIME(I:I) = '-'S
	END DOR

	IF (I.EQ.LEN(TIME)) RETURN2

	IF (TIME(I+3:I+3).EQ.' ') THEN 
	   IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN
	      TIME = TIME(:I)//'19'//TIME(I+1:)
	   ELSE
	      TIME = TIME(:I)//'20'//TIME(I+1:)
	   END IF
	END IFE

	I = 1
	DO J = 1,2 
	   DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME))
	      I = I + 1
	   END DO
	   I = I + 1M
	END DOU

	IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURN 

	CALL SYS_BINTIM(TIME(:I-2),BTIM)
                                                  
	IF (INDEX(INTIME,'GMT').GT.0) CALL CONVERT_FROM_GMT(BTIM)

	RETURNC
	END



	SUBROUTINE NEWS_LISTD

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'B

	COMMON /BUFFER/ BUFFER,SB,EBI
	CHARACTER BUFFER*1280

	COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1
	DATA LOCAL_UPDATE1/0/

	CHARACTER TODAY*24_

	DIMENSION EXPIRED(2)E

	CALL LIB$DATE_TIME(TODAY)

	IF (.NOT.NEWS_LOGIN()) RETURN

	IF (.NOT.NEWS_WRITE('LIST')) RETURN
	IF (.NOT.NEWS_READ()) RETURNF
	IF (BUFFER(:3).NE.'215') RETURN

	SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR.R
     &	 (INDEX(TODAY,' 03:').NE.0)	! Delete non-existant groups at 3

        CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER))T

        LOCAL_UPDATE = LOCAL_UPDATE1

	CALL OPEN_BULLNEWS_SHARED	! Open folder fileM

	NEWS_FOLDER1_BBOARD = '::'A

	CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) 
	IF (IER1.NE.0) THEN
	   NEWS_FOLDER1 = 'a'
	   NEWS_FOLDER1_NUMBER = 1000
	   NEWS_F1_COUNT = 1001
	   NEWS_F1_EXPIRE = 14
	   NEWS_F1_EXPIRE_LIMIT = 0
	   NEWS_F1_FLAG = 0
	   CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)N
           CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)
	   WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COMA
	END IFN
	NEWS_FLAG_DEFAULT = NEWS_F1_FLAG
	NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE
	NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMITI
	IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001
	NEWS_F_COUNT = NEWS_F1_COUNT
	DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.')
	   FLEN = INDEX(BUFFER(SB:),' ') - 1
	   NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) 
	   IF (IER1.EQ.0) THENT
	      CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) 
	   END IF
	   SP = FLEN+SB+1
	   EP = INDEX(BUFFER(SP:),' ')+SP-2
	   IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) 
	   SP = EP + 2F
	   EP = INDEX(BUFFER(SP:),' ')+SP-2
	   IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) 
	   IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0T
	   CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)
	   SP = EP + 1R
	   IF (IER.NE.0.OR.IER1.NE.0) THEN 
	      CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1)
	      IER2 = 1 
	      I = FLEN 
	      DO WHILE (IER2.NE.0.AND.I.GT.1)
		 IF (NEWS_FOLDER(I:I).EQ.'.') THEN ,
		    NEWS_FOLDER = NEWS_FOLDER1(:I)
		    DO WHILE (REC_LOCK(IER))
	               READ (7,KEY=NEWS_FOLDER,
     &		   	     KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COMB
		    END DO
	         END IF
	         IF (IER2.NE.0) I = I - 1
	      END DOE
	      IF (FLEN.GT.44) THENE
		 NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)//t
     &					BUFFER(SP:EB)
	      ELSE
		 NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)F
	      END IF'
	      IER = 0
	      DO WHILE (IER.EQ.0.AND.IER1.EQ.0)
		 DO WHILE (REC_LOCK(IER))T
		    READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER)
		 END DOL
		 IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1
	      END DO)
	      NEWS_FOLDER1_NUMBER = NEWS_F_COUNTT
	      IF (IER2.EQ.0) THEN T
	         NEWS_F1_FLAG = NEWS_F_FLAG
		 IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THENE
	            NEWS_F1_EXPIRE = NEWS_F_EXPIRE 
	            NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMITT
	         END IF
	      ELSEE
	         NEWS_F1_FLAG = NEWS_FLAG_DEFAULT
	         NEWS_F1_EXPIRE = 0
	         NEWS_F1_EXPIRE_LIMIT = 0
	      END IF 
              CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE)E
              CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)S
              CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)D
	      NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1))
	      IF (BTEST(NEWS_F1_FLAG,8)) THEN '
		 NEWS_F1_COUNT = 0
		 NEWS_F1_START = 0
		 NEWS_F1_NBULL = 0
	         NEWS_F1_FIRST = 0C
	         NEWS_F1_LAST = 0
	      END IFM
	      WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	      IF (IER.EQ.0) THEN 
	  	 NEWS_F_COUNT = NEWS_F_COUNT + 1
		 IF (BTEST(NEWS_F1_FLAG,8).AND.E
     &			.NOT.BTEST(NEWS_F1_FLAG,9)) THEN1
	            CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,
     &                                  %DESCR(NEWS_FOLDER1_NUMBER))
	         END IF
	      END IF,
	   ELSE IF (BTEST(NEWS_F1_FLAG,8).AND..
     &			.NOT.BTEST(NEWS_F1_FLAG,9)) THENI
	      IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND.
     &		  NEWS_F1_START.LE.NEWS_F1_NBULL) THEN
		 IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND.
     &		     NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THENR
		    NEWS_F1_LAST = 0
		    NEWS_F1_START = F1_START
		    NEWS_F1_NBULL = F1_NBULL
		    REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM 
		 END IFF
		 IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN
	            CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,
     &					%DESCR(NEWS_FOLDER1_NUMBER))     
	         END IF
	      END IFF
	   ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN 
	      UPDATE = .FALSE._
	      IF (FLEN.GT.44) THEN
		 IF (NEWS_FOLDER1_DESCRIP.NE.B
     &		     BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN 
		    NEWS_FOLDER1_DESCRIP =
     &			BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)R
		    UPDATE = .TRUE.E
		 END IFN
	      ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THENE
		 NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)	
		 UPDATE = .TRUE.
	      END IFL
	      IF (SPECIAL) THEN
		 IF (UPDATE) THENS
		    NEWS_F1_START = F1_START
		    NEWS_F1_NBULL = F1_NBULL
		 END IF=
	      ELSE IF (.NOT.UPDATE) THEN1
		 UPDATE = F1_START.NE.NEWS_F1_START.OR.S
     &			  F1_NBULL.NE.NEWS_F1_NBULL
	      END IF	
	      IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	   END IF
	END DO1

	CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)R
	NEWS_F1_COUNT = NEWS_F_COUNTE
	REWRITE (7) NEWS_FOLDER1_COM

	IF (SPECIAL) THEN
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)
           LAST = FOLDER1_NUMBER
	   DO WHILE (IER.EQ.0)S
	      CALL READ_FOLDER_FILE_TEMP(IER)
	      DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops
		 DELETE (7)D
		 CALL READ_FOLDER_FILE_TEMP(IER)
	      END DO(
	      LAST = FOLDER1_NUMBER
	      IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THENO
		 NEWS_F1_NBULL = F1_NBULLL
		 NEWS_F1_START = F1_STARTE
	         NEWS_F1_COUNT = F1_COUNT
 		 CALL NEWS_GROUP(IER)
		 IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN
                    IF (BTEST(NEWS_F1_FLAG,8)) THEN 
                       IF (NEWS_F1_LAST.NE.F1_NBULL.AND.
     &		           F1_START.LE.F1_NBULL) THENE
	    	    	  IF (NEWS_F1_FIRST.GT.F1_START.AND.C
     &		     	      NEWS_F1_FIRST.GT.F1_NBULL) THENU
			     NEWS_F1_LAST = 0
			     REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM 
			  END IF_
                          IF (NEWS_F1_LAST.LT.F1_NBULL) THEN
                             CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),_
     &                        LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER))C
			  END IF 
                       END IFA
 		    ELSE IF (((F1_START.NE.NEWS_F1_START.OR.T
     &			F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR.
     &			NEWS_F1_COUNT.NE.F1_COUNT) THEN
		       CALL SYS_BINTIM('-',F1_NEWEST_BTIM)
		       CALL REWRITE_FOLDER_FILE_TEMP(IER1)
		    END IF
		 ELSE IF (IER.NE.0.AND.(.NOT.BTEST(NEWS_F1_FLAG,8).OR.
     &			  NEWS_F1_NBULL.LT.NEWS_F1_START)) THEN
		    DELETE (UNIT=7)E
		    IER = 0E
		 END IF
	      END IFN
	   END DO
	END IFT

	CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0))

	CALL CLOSE_BULLNEWS

	RETURNU
	END


	SUBROUTINE LOWERCASE(INPUT)

	CHARACTER*(*) INPUT

	DO I=1,LEN(INPUT)
	   IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN,
	      INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a'))T
	   END IF
	END DO 

	RETURN_
	END



	SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT)

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLNEWS.INC' 

	INCLUDE 'BULLFOLDER.INC'T

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC' 

        INCLUDE 'BULLFILES.INC'.

	COMMON /BUFFER/ BUFFER,SB,EB 
	CHARACTER BUFFER*1280

	COMMON /REF/ REFERENCES,LREFD
	CHARACTER*256 REFERENCES)

	COMMON /PATH/ PATHNAME,LPATH	
	CHARACTER*132 PATHNAMEN

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*256 MESSAGE_ID)

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /NEWSGROUPS/ NEWSGROUPS'
	CHARACTER*256 NEWSGROUPSR

        COMMON /ZONE/ ZONE,LZONE
	CHARACTER ZONE*4F

        COMMON /LOCALPOST/ LOCAL_POSTR
	DATA LOCAL_POST /.FALSE./

	COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE
	CHARACTER*256 FROM_LINE,SUBJECT_LINEI
	CHARACTER*12 MSGNUM

	CHARACTER*(*) FILENAME,SUBJECT

	CHARACTER TODAY*24,UNAME*132'
	DATA UNAME /'()'/

	DIMENSION NOW(2)A

	IER = 1

	CREATE = FILENAME(:8).EQ.'newgroup'

	IF (FILENAME.NE.'cancel') THEN 
	   IF (.NOT.FILEOPEN) THENS
	      OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1))
	      IF (IER1.NE.0) RETURN
	   END IF

	   IER1 = 0
	   DO WHILE (IER1.EQ.0)
	      READ (3,'(A)',IOSTAT=IER1) BUFFER
	      IF (IER1.NE.0) GO TO 900I
	      IF (TRIM(BUFFER).GT.0) IER1 = 1
	   END DO

	   REWIND (UNIT=3)T
	END IF

	IER = SYS$GETTIM(NOW)
	CALL CONVERT_TO_GMT(NOW)A
	IER = SYS$ASCTIM(,TODAY,NOW,)

	NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'//
     &		TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23)
	IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) 

	IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THENT
	   IF (.NOT.NEWS_LOGIN()) GO TO 900
	   IF (.NOT.NEWS_WRITE('POST')) GO TO 900
	   IF (.NOT.NEWS_READ()) GO TO 900B
	   IF (BUFFER(:3).NE.'340') THENF
	      WRITE (6,'('' ERROR: Posting not allowed.'')')E
	      GO TO 900
	   END IF
	ELSE
	   I = INDEX(NEWS_MSGID,'.') 
	   LENGTH = 0
	   OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//E
     &	        NEWS_MSGID(:I-1)//_
     &		NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, 
     &		STATUS='NEW',DISPOSE='DELETE',RECL=256)C
           IF (IER.NE.0) RETURNC
	   LOCAL_POST = .TRUE.
           CALL INIT_QUEUE(GROUP_LIST1,FOLDER)
           GROUP_LIST = GROUP_LIST1S
 	END IF

	IF (LPATH.EQ.0) CALL GET_PATHNAME

	IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN
	   IF (CREATE) THEN
	      INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME))
           ELSE IF (NEWS_FEED()) THEN	
              INPUT = 'Newsgroups: '//FOLDER1_DESCRIP_
	   ELSE IF (.NOT.BTEST(FOLDER_FLAG,8).AND.h
     &		TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN 
	      INPUT = 'Newsgroups: '//NEWSGROUPS
	   ELSE
	      INPUT = 'Newsgroups: '//FOLDER_NAME
	   END IF
	   IF (FILENAME.NE.'cancel'.AND..NOT.CREATE) THEN
	      NGROUPS = 0
              IF (BTEST(FOLDER_FLAG,8)) THEN
		 CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER)R
		 NGROUPS = NGROUPS + 1
              END IF
	      IF (CLI$PRESENT('GROUPS')) THEN
		 CALL OPEN_BULLNEWS_SHARED
		 FLEN = 0 
		 DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN)
     &			.AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT))P
		    CALL LOWERCASE(FOLDER1_NAME)
		    CALL READ_FOLDER_FILE_KEYNAME_TEMP
     &			(FOLDER1_NAME(:FLEN),IER1)E
		    IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)) THEN )
		       INPUT = INPUT(:TRIM(INPUT))//
     &			','//FOLDER1_NAME(:TRIM(FOLDER1_NAME))
                       IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN 
                          CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST, 
     &				FOLDER1)
		          NGROUPS = NGROUPS + 1 
	               END IF
	            END IFT
		 END DO 
		 CALL CLOSE_BULLNEWS
	      END IFH
	   END IF
	   IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900U
	END IF 
	ATSIGN = INDEX(PATHNAME,'@')S
	PCSIGN = INDEX(PATHNAME,'%') 
	CALL LOWERCASE(USERNAME))
	IF (PCSIGN.GT.0) THEN
	   IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' 
     &	       //PATHNAME(PCSIGN+1:ATSIGN-1)//'!'
     &	       //USERNAME(:TRIM(USERNAME)))) GO TO 9001
	ELSEE
	   IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!''
     &	       //USERNAME(:TRIM(USERNAME)))) GO TO 900F
	END IFT
	IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME)E

	FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)//
     &			UNAME(:TRIM(UNAME))
	IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE))))
     &	   GO TO 900
	CALL STR$UPCASE(FROM_LINE,FROM_LINE)0
	FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME))
	CALL STR$UPCASE(USERNAME,USERNAME)	
	SUBJECT_LINE = SUBJECTP
	IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT))))D
     &	   GO TO 900 

	IF (INCMD(:2).EQ.'RE') THEN
	   IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))):
     &	      GO TO 900
	END IFC

	IF (NGROUPS.GT.0) THEN 
	   FROM = USERNAME
	   DESCRIP = SUBJECT.
	END IF	

        NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH)
	IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(:
     &	   TRIM(NEWS_MSGID))//'>')) GO TO 900

	TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20)
	IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)	

	IF (LORGAN.EQ.0) THEN
	   IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN
	      IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)1
	   END IF
	   LORGAN = TRIM(ORGANIZATION).
	END IFI

	IF (LORGAN.GT.0) THEN
	   IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))t
     &		GO TO 900=
	END IFE

	IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//S
     &		ZONE(:LZONE))) GO TO 900

        IF (REMOTE_SET.EQ.4.AND..NOT. 
     &		(CREATE.OR.FILENAME.EQ.'cancel')) THEN
	   IF (CLI$PRESENT('EXPIRATION')) THEN   
       	      IF (.NOT.NEWS_WRITE('Expires: '//EXDATE(
     &		   FIRST_ALPHA(EXDATE):2)(
     &		   //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE))I
     &		   //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900E
	   ELSE
	      IF ( FOLDER_BBEXPIRE.GT.0) THEN
                 CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
              ELSE
	         CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT)o
              END IF
	      EXTIME = '00:00:00.00'A
	   END IF
	END IFT

	IF (CREATE) THENR
	   IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME))))
     &		 RETURNM
	END IF

	IF (FILENAME.EQ.'cancel') THENO
	   IF (.NOT.NEWS_WRITE('Control: cancel <'R
     &		//MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURNR
	   IF (.NOT.NEWS_WRITE('.')) RETURN
	   IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN
	      IF (.NOT.NEWS_READ()) RETURNL
	      IF (BUFFER(:3).EQ.'240') IER = 0C
	   ELSE
	      CLOSE (UNIT=8,STATUS='SAVE')E
	      IER = 0
	   END IF
	   LOCAL_POST = .FALSE.
	   RETURN
	END IF.

	IF (.NOT.NEWS_WRITE(' ')) GO TO 900

	IER1 = 0 
	DO WHILE (IER1.EQ.0))
	   READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER
	   IF (BUFFER(:ILEN).EQ.'.') THEN
	      BUFFER = '..'
	      ILEN = 2T
	   END IF
	   IF (IER1.EQ.0) THENE
	      IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900
	   END IF
	END DOB

	IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THENE
    	   IF (.NOT.NEWS_WRITE('.')) GO TO 900m
	   IF (.NOT.NEWS_READ()) GO TO 900!
	   IF (BUFFER(:3).EQ.'240') THEN=
	      IER = 0
	   ELSE
	      WRITE (6,'('' ERROR: Server rejected your posting:'')')
	      WRITE (6,'(1X,A)') BUFFER(SB:EB)A
	   END IF
	ELSET
	   LENGTH = (LENGTH+127)/128
           GROUP_LIST = GROUP_LIST1E
	   FOLDER_NUMBER_SAVE = FOLDER_NUMBER
	   DO I=NGROUPS,1,-1T
	      CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1)_
	      FOLDER_NUMBER = -1R
              CALL SELECT_FOLDER(.FALSE.,IER)
	      IF (IER) THEN E
	         CALL ADD_LOCAL_NEWS(8)
	      END IF 
	   END DO
	   IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN 
	      FOLDER_NUMBER = FOLDER_NUMBER_SAVED
	      CALL SELECT_FOLDER(.FALSE.,IER)
	   END IF
    	   IF (.NOT.NEWS_WRITE('.')) GO TO 900
	   CLOSE (UNIT=8,STATUS='SAVE')
	   IER = 0E
	END IFA

900	IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3)

	LOCAL_POST = .FALSE.)

	RETURNW
	END



	SUBROUTINE GET_PATHNAME

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC' 

	COMMON /PATH/ PATHNAME,LPATH 
	CHARACTER*132 PATHNAMEI

	IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN 
	   IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME)=
	   IF (.NOT.IER) 
     &		IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME)
	   IF (.NOT.IER) 
     &		IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME)
	   IF (.NOT.IER) THEN
	      WRITE (6,'('' ERROR: Cannot find local host name.'')')E
	      RETURN'
	   END IF
	END IF_

	IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME

	CALL LOWERCASE(PATHNAME)F
	LPATH = TRIM(PATHNAME)L

	RETURN 
	END



	LOGICAL FUNCTION TEST_NEWS(NAME)D

	IMPLICIT INTEGER (A-Z)_

	CHARACTER*(*) NAME 

	TEST_NEWS = .FALSE.

	DO I=1,LEN(NAME).
 	   IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN
	END DOI

	TEST_NEWS = .TRUE. 

	RETURNQ
	END



	SUBROUTINE UPDATE_LOCAL_NEWS 

        IMPLICIT INTEGER (A-Z)

        INCLUDE 'BULLDIR.INC' 

        INCLUDE 'BULLFOLDER.INC'

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

        COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1D

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

        EXTERNAL BULLETIN_SUBCOMMANDS   

	CHARACTER CNUM*4,NUMBER*8
	EQUIVALENCE (CNUM,NUM)(

        CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM)E

        LOCAL_UPDATE = LOCAL_UPDATE1

        CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM)e
	IF (NUM.EQ.0) RETURN 
  
	CALL OPEN_BULLNEWS_SHARED

	DO WHILE (NUM.GT.0)
           CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER)i
	   IF (IER.EQ.0) THEN
	      CALL CLOSE_BULLNEWS
	      CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
              LAST = F1_NBULLN
	      FIRST = F1_START 
              IF (IER.EQ.0) THEN
	         FOLDER_COM = FOLDER1_COM
                 CALL OTS$CVT_L_TI(F_LAST+1,NUMBER,,,)
		 REMOTE_SET = 3S
                 INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM(
     &                  FOLDER))//' '//NUMBER//'-LAST'
                 CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)I
                 CALL MOVE(.FALSE.)I
		 CALL OPEN_BULLNEWS_SHARED
		 IF (REMOTE_SET.EQ.4) THEN
		    NEW_F_COUNT = F_COUNTD
		    NEW_NEWS_F_END = NEWS_F_ENDS
	            CALL READ_FOLDER_FILE_KEYNUM(NUM,IER)
                    CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE)
	            CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) 
	            IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1
	            IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN
 	               NEWS_F_END = NEW_NEWS_F_END
	               F_NBULL = NEW_NEWS_F_END
		       F_COUNT = NEW_F_COUNT
	            END IF-
	            F_LAST = LAST
	            NEWS_F_FIRST = FIRSTN
	            CALL REWRITE_FOLDER_FILE(IER)
	         END IF
              END IF
  	   END IF
           CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM)
	   IF (NUM.EQ.0) THEN
              CALL CLOSE_BULLNEWS  
	      RETURN.
	   END IF
	END DOL

	RETURNT
	END




	SUBROUTINE NEWS2BULL 

	IMPLICIT INTEGER (A-Z)_

	INCLUDE 'BULLFOLDER.INC'T

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	COMMON /BUFFER/ BUFFER,SB,EBN
	CHARACTER BUFFER*1280

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	EXTERNAL BULLETIN_SUBCOMMANDS

	CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*44,BBOARD_SAVE*12 

	CHARACTER*8 NUMBER(

	DIMENSION SAVE_F_NEWEST_BTIM(2),NOW(2)S

	IER = SYS$GETTIM(NOW)

	CALL ALLPRIV)

	CALL NEWS_LIST=

	CALL UPDATE_LOCAL_NEWS(

	CALL SEND_POST 

	CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM)

	FOLDER_Q = FOLDER_Q1.

	CALL OPEN_BULLFOLDER_SHARED		! Get folder fileL

	NUM_FOLDERS = 0
	IER = 0
	DO WHILE (IER.EQ.0)			! Find folders with news feed
	   CALL READ_FOLDER_FILE(IER)
	   IF (IER.EQ.0) THEN
	      SLIST = INDEX(FOLDER_DESCRIP,'<')
	      ELIST = INDEX(FOLDER_DESCRIP,'>')
	      IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN
		 IF (FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR.E
     &		     TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))) THEN	
		    NUM_FOLDERS = NUM_FOLDERS + 1A
		    CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
		 END IFI
	      END IF,
	   END IF
	END DOO

	CALL CLOSE_BULLFOLDER			! We don't need file anymoreD

	IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT 

	FOLDER_Q = FOLDER_Q1F
	POINT_FOLDER = 0E
	DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)O
	   POINT_FOLDER = POINT_FOLDER + 1N
	   CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)T
	   CALL SELECT_FOLDER(.FALSE.,IER) 
	   FOLDER_SAVE = FOLDER
	   BBOARD_SAVE = FOLDER_BBOARDN
	   FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) 
	   FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1).
	   IF (IER) THEN 
	      SAVE_LAST = F_LASTC
	      CALL OPEN_BULLNEWS_SHARED
	      FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP))
	      CALL READ_FOLDER_FILE_KEYNAME
     &		(FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER)N
	      CALL CLOSE_BULLNEWS
	      FOLDER1_DESCRIP = FOLDER_DESCRIPU
              IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)O
              IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM
	      IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN)
	         SAVE_LAST = F_NBULLT
		 CALL OPEN_BULLFOLDER_
	         CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) 
		 F_LAST = SAVE_LAST3
                 FOLDER_BBOARD = 'NONEFEED')
	         CALL REWRITE_FOLDER_FILE(IER1)
	         CALL CLOSE_BULLFOLDERE
	      ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND.
     &		F_NBULL.GE.F_START) THEN
                 REMOTE_SET = 3,
		 IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1)O
     &			SAVE_LAST = F_START-1
		 SAVE_LAST = MAX(F_START-1,SAVE_LAST) 
	         CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,)
	         INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM(
     &			FOLDER_SAVE))//' '//NUMBER//'-LAST'
		 SAVE_LAST = F_NBULL
	         CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
		 CALL MOVE(.FALSE.) 
		 CALL OPEN_BULLFOLDERT
	         CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)O
		 IF (IER1.EQ.0) THEN
		    F_LAST = SAVE_LAST
	            CALL REWRITE_FOLDER_FILE(IER1)
		 END IFN
		 CALL CLOSE_BULLFOLDER
	      END IF 
	   END IF
	END DOT

	CALL EXIT
	END



	SUBROUTINE DATE_TIME(TIME)M

	IMPLICIT INTEGER (A-Z)N

	COMMON /MONTHS/ MONTH
	CHARACTER*36 MONTH 
	DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/

	CHARACTER*(*) TIMEO

	NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3

	IF (TIME(1:1).EQ.' ') TIME(1:1) = '0'

	TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+U
     &		 MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//C
     &		 TIME(16:17)//TIME(19:20)N

	RETURN.
	END



	SUBROUTINE ALLPRIV)

	IMPLICIT INTEGER (A-Z)

	COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)

	PROCPRIV(1) = -1U
	PROCPRIV(2) = -1O
	NEEDPRIV(1) = -1:
	NEEDPRIV(2) = -1)

	RETURN%
	END



	SUBROUTINE NEWS_NEW_FOLDER 

	IMPLICIT INTEGER (A-Z)1

	INCLUDE 'BULLFOLDER.INC'R

	READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COMR

	NEWS_FOLDER1 = FOLDER1D
	NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:)

	DO WHILE (IER.EQ.0)
	   READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1)
	   IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1(
	END DO

	NEWS_FOLDER1_NUMBER = NEWS_F_COUNTE
	CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)C
	WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM

	READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COMR
	NEWS_F1_COUNT = NEWS_F_COUNTT
	REWRITE (7) NEWS_FOLDER1_COM 

	RETURN0
	END



	SUBROUTINE SUBSCRIBE

	IMPLICIT INTEGER (A-Z)I

	INCLUDE 'BULLUSER.INC'E

	INCLUDE 'BULLFOLDER.INC'T

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	IF (REMOTE_SET.LT.3) THEN
	   WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')(
	   RETURN
	END IF	

	I = 1
	DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND.
     &		LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1)
	   I = I + 11
	END DO 

	IF (I.GT.FOLDER_MAX-1) THEN
	   WRITE (6,'('' ERROR: Cannot subscribe.  You have '',
     &		    '' reached the news folder limit of '',I,''.'')')E
     &		    FOLDER_MAX-1
	   RETURN
	ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN
	   WRITE (6,'('' You are already subscribed to '',A,''.'')') 
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))
	   RETURN
	ELSE
	   WRITE (6,'('' You are now subscribed to '',A,''.'')')I
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))
	END IF 

	CALL OPEN_BULLNEWS_SHARED
	DO J=I,1,-1
	   IF (J.GT.1) THEN
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP( 
     &	         ZEXT(LAST_NEWS_READ2(1,J-1)),IER)I
	      IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN
	         CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1))E
	      END IFI
	   END IF
	   IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THENB
	      LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER
	      IF (F_START.LE.F_NBULL) THENR
		 LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))M
		 LAST_NEWS_READ(2,J) = F_START - 1
	      ELSE.
		 LAST_NEWS_READ2(2,J) = 0N
		 LAST_NEWS_READ(2,J) = F_NBULL
	      END IF.
	      CALL CLOSE_BULLNEWS
	      RETURNB
	   END IF
	END DOT

	END





	SUBROUTINE UNSUBSCRIBE0

	IMPLICIT INTEGER (A-Z)s

	INCLUDE 'BULLUSER.INC' 

	INCLUDE 'BULLFOLDER.INC',

	I = NEWS_FIND_SUBSCRIBE()

	IF (I.GT.FOLDER_MAX-1) THEN
	   WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')')
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))
	   RETURN
	ELSE1
	   WRITE (6,'('' You are now no longer subscribed to '',A,''.'')')L
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))
	END IFE

	DO J=I,FOLDER_MAX-2
	   CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))S
	END DO5

	LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 
	LAST_NEWS_READ(2,FOLDER_MAX-1) = 0E

	CALL FREE_TAGS(I)

	RETURN=
	END



	SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER)

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'N

	I = NEWS_FIND_SUBSCRIBE()

	IER = LAST_NEWS_READ(2,I) + 1

	IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN
	   IER = 0A
	   RETURN
	END IF.

	RETURNN
	END



	SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER)E

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC' 

	INCLUDE 'BULLFOLDER.INC'A

	I = NEWS_FIND_SUBSCRIBE1() 

	IER = LAST_NEWS_READ(2,I) + 1

	IF (I.GT.FOLDER_MAX-1) THEN
	   IER = 0S
	   RETURN
	END IFP

	RETURNB
	END



	SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER)

	IMPLICIT INTEGER (A-Z)C

	INCLUDE 'BULLUSER.INC'F

	INCLUDE 'BULLFOLDER.INC'E

	I = NEWS_FIND_SUBSCRIBE()

	IF (I.GT.FOLDER_MAX-1) RETURN

	IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.
     &	    (LAST_NEWS_READ(2,I).GT.F_NBULL.AND.F_START.LE.F_NBULL)) THEN
	   LAST_NEWS_READ(2,I) = NUMBER
	   LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)	
     &			.OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)F
	END IFE

	RETURN:
	END





	SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)=

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC'S

	IF (SUBNUM.EQ.0) THEN
	   COUNT = 0 
	   SUBMSG = LAST_NEWS_READ(2,1)
	   RETURN
	ELSE IF (SUBNUM.EQ.-1) THEN
	   DO J=COUNT,FOLDER_MAX-1C
	      CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))
	   END DO

	   LAST_NEWS_READ(1,FOLDER_MAX-1) = 0
	   LAST_NEWS_READ(2,FOLDER_MAX-1) = 0
	ELSE IF (SUBNUM.GT.0) THEN.
	   COUNT = COUNT + 1C
	END IF

	IF (COUNT.LE.FOLDER_MAX-1) THEN
	   SUBNUM = LAST_NEWS_READ2(1,COUNT)E
	   SUBMSG = LAST_NEWS_READ(2,COUNT)
	ELSEE
	   SUBNUM = 0
	END IFR

	RETURNN
	END




	SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)F
CL
C  SUBROUTINE NEWS_NEW_NOTIFICATIONE
CF

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLFOLDER.INC'E

	INCLUDE 'BULLUSER.INC'1

	COMMON /READIT/ READITR

	COMMON /POINT/ BULL_POINT

	COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)L

	MESSAGES = .FALSE.E

	IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN

	CALL NEWS_GET_SUBSCRIBE(0,MSGNUM)

	CALL OPEN_BULLNEWS_SHARED
	SUBNUM = 1

	FOLDER_DESCRIP = ' 'N
	REORDER = 0
	DO WHILE (SUBNUM.GT.0)
	   IER = 1 
	   DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)A
	      CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)L
	      FOLDER1_DESCRIP = FOLDER_DESCRIPN
	      IF (SUBNUM.NE.0) THEN
		 CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)_
		 UNLOCK 7
		 IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 10
		 IF (IER.EQ.0.AND.
     &			MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THENE
		    CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1)
		 ELSE IF (IER.NE.0) THEN
		    SUBNUM = -1O
		 ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.R
     &			  F_START.GT.F_NBULL) THEND
		    IER = 1 
		 END IF 
	      END IF 
	      IF (IER.EQ.0.AND.SUBNUM.GT.0) THENN
		 IF (READIT.EQ.1) THEN
		    IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.(
     &			.NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN_
		       IER = 1
		    ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.
     &			.NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. 
     &			NEW_FLAG(2).NE.-1) THEN
		       DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)T
		       IF (DIFF.GT.0) IER = 1
		    END IF
		 END IFE
	      END IF_
	   END DO
	   IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN 
	      WRITE (6,'('' There are new messages in folder '',L
     &		  A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) 
	      MESSAGES = .TRUE.
	   ELSE IF (SUBNUM.GT.0) THEN
	      IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)
     &		  .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN
		 WRITE (6,'('' There are new messages in folder ''
     &		  A,''.'',$)') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1)F
	      ELSE	
		 CALL CLOSE_BULLNEWS
		 CALL SELECT_FOLDER(.FALSE.,IER1)1
		 IF (IER1) THENS
		    CALL LOGIN_FOLDERD
		    IF (BULL_POINT.NE.-1) THEN
		       IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THENI
			  SAVE_BULL_POINT = BULL_POINTR
			  REDO = .TRUE.
			  DO WHILE (REDO)
			     REDO = .FALSE.
			     CALL READNEW(REDO)
			     IF (REDO) CALL REDISPLAY_DIRECTORY
			     BULL_POINT = SAVE_BULL_POINT
			  END DO	
		       END IFT
		    END IF
		 END IF 
		 CALL OPEN_BULLNEWS_SHARED
	      END IFL
	   END IF
	END DOY

	IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE_

	CALL CLOSE_BULLNEWS

	RETURNO
	END


	SUBROUTINE REORDER_SUBSCRIBEO

	IMPLICIT INTEGER (A-Z)I

	INCLUDE 'BULLFOLDER.INC'R

	INCLUDE 'BULLUSER.INC'.

	I = 1
	DO WHILE (LAST_NEWS_READ2(1,I).NE.0) 
	   I = I + 1I
	END DON

	I = I - 1

	DO I1=1,I-1
	   DO J=1,I-I1D
	      K = J + 1
	      S1 = LAST_NEWS_READ2(1,J)
	      S2 = LAST_NEWS_READ2(1,K)
	      CALL READ_FOLDER_FILE_KEYNUM(S1,IER),
	      CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1)1
	      IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN
		 DO L=1,2	
	            TEMP = LAST_NEWS_READ(L,J),
		    LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K)L
		    LAST_NEWS_READ(L,K) = TEMP
		 END DO_
	      END IFB
	   END DO
	END DO 

	RETURNT
	END




	LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)G

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC'F

	IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENR
	   TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER)
	   RETURN
	END IF 

	I = NEWS_FIND_SUBSCRIBE()

	TEST_SET_FLAG = .FALSE.

	IF (I.GT.FOLDER_MAX-1) RETURN

	TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) 

	RETURNA
	END




	LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) 

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC'S

	IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENN
	   TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER)
	   RETURN
	END IF 

	I = NEWS_FIND_SUBSCRIBE()

	TEST_BRIEF_FLAG = .FALSE.

	IF (I.GT.FOLDER_MAX-1) RETURN

	TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)A

	RETURN 
	END




	LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER)

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLUSER.INC'N

	IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THENL
	   TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER)
	   RETURN
	END IFE

	I = NEWS_FIND_SUBSCRIBE()

	TEST_NOTIFY_FLAG = .FALSE.

	IF (I.GT.FOLDER_MAX-1) RETURN

	TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13)

	RETURNH
	END



	INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() 

	IMPLICIT INTEGER (A-Z)_

	INCLUDE 'BULLUSER.INC'E

	INCLUDE 'BULLFOLDER.INC',

	I = 1
	DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER
     &					.AND.I.LE.FOLDER_MAX-1)
	   I = I + 1N
	END DOC

	NEWS_FIND_SUBSCRIBE = I

	RETURN 
	END



	INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1()

	IMPLICIT INTEGER (A-Z)M

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	I = 1
	DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER
     &					.AND.I.LE.FOLDER_MAX-1)
	   I = I + 1M
	END DOD

	NEWS_FIND_SUBSCRIBE1 = IM

	RETURN
	END




	SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF)

	IMPLICIT INTEGER (A-Z)R

	INCLUDE 'BULLUSER.INC' 

	I = NEWS_FIND_SUBSCRIBE()

	IF (I.GT.FOLDER_MAX-1) THEN
	   WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')')
	   RETURN
	END IFM

	IF (NOTIFY.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13)A
	IF (NOTIFY.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13),
	IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14)
	IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14)
	IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15)
	IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15)

	CALL UPDATE_USERINFO

	RETURN 
	END



        SUBROUTINE ADD_LOCAL_NEWS(UNIT)O

        IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

        COMMON /LAST_RECORD_WRITTEN/ OCOUNTS

	COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE
	CHARACTER*256 FROM_LINE,SUBJECT_LINE/
	CHARACTER*12 MSGNUM

	REWIND UNIT
		
	CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)(

	CALL OPEN_BULLDIR
	CALL OPEN_BULLFIL
	CALL SET_BULLFIL_UPDATE
	OBLOCK = NBLOCK + 1
	CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '//)
     &		    FROM_LINE(:TRIM(FROM_LINE)),OBLOCK)O
	IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN 
	   CALL STORE_BULL(TRIM(SUBJECT_LINE)+6,E
     &		'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK)
	END IFF
	CALL COPY_BULL(UNIT,1,OBLOCK,IER)
	IF (IER.NE.0) THEN
	   CALL CLOSE_BULLFIL
	   CALL CLOSE_BULLDIR
	   RETURN
        END IF
   	LENGTH = OCOUNT - (NBLOCK + 1) + 1
	NBLOCK = NBLOCK + LENGTH + 1T
	SYSTEM = 0 
	CALL ADD_ENTRY'
        CALL CLOSE_BULLFIL
	CALL UPDATE_NEWS_FOLDER
        CALL CLOSE_BULLDIR

        RETURN
        ENDT



	SUBROUTINE UPDATE_NEWS_FOLDER
CO
C  SUBROUTINE UPDATE_NEWS_FOLDER
CI
C  FUNCTION: Updates folder info due to new message.
CO

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'/

	NEW_NEWS_F_END = NEWS_F_END
	NEW_F_COUNT = F_COUNT

	CALL OPEN_BULLNEWS_SHARED

	CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)

	IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN 
	   CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWS_F_NEWEST_BTIM)'
	   F_NBULL = NEW_NEWS_F_END
	   NEWS_F_END = NEW_NEWS_F_ENDs
	   F_COUNT = NEW_F_COUNTF
	END IF(

	IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1N

	CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))T
	IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0)
     &		NEWS_F_EXPIRED_DATE = NEWS_NEWEST_EX_BTIM_KEY(5:)I

	CALL REWRITE_FOLDER_FILE(IER)

	CALL CLOSE_BULLFOLDER

	RETURN	
	END



	SUBROUTINE SEND_POSTO

        IMPLICIT INTEGER (A-Z) M

	INCLUDE 'BULLFILES.INC'
        INCLUDE 'BULLDIR.INC' 

        COMMON /BUFFER/ BUFFER,SB,EB
        CHARACTER BUFFER*1280E
	L
	CHARACTER FILE*132	
	1
	C = 0
	N
        IF (.NOT.NEWS_LOGIN()) RETURN 
	DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))
     &			//'*.POST',FILE,C))	 
           IF (.NOT.NEWS_WRITE('POST')) RETURN
           IF (.NOT.NEWS_READ()) RETURNL
           IF (BUFFER(:3).NE.'340') RETURN
  
           OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD')
	   DO WHILE (IER.EQ.0) 
	      READ (3,'(Q,A)',IOSTAT=IER) I,INPUT
              IF (IER.EQ.0) THEN  
           	 IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100
	      END IF 
           END DO'
	   IF (INPUT.NE.'.') THEN '
	      IF (.NOT.NEWS_WRITE('.')) GO TO 100
	   END IF
           IF (.NOT.NEWS_READ()) GO TO 100
	   CLOSE (UNIT=3,STATUS='DELETE')   /
	END DOP

100	CLOSE (UNIT=3)

	RETURN 
	END



	SUBROUTINE GET_UNAME(UNAME)

        IMPLICIT INTEGER (A-Z) (

	INCLUDE '($MAILDEF)'+

	CHARACTER*(*) UNAME

	CALL DISABLE_PRIVSU

	C = 0

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

        CALL INIT_ITMLST
        CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME,
     &				%LOC(UNAME))
        CALL END_ITMLST(GET_USER_ITMLST)

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

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

100	CALL ENABLE_PRIVSS

	IF (UNAME.EQ.'()') THEN
	   UNAME = ' '1
	ELSE IF (TRIM(UNAME).GT.0) THEN
	   UNAME = ' ('//UNAME(:TRIM(UNAME))//')'
	END IF 

	RETURN1
	END
