C
C  BULLETIN10.FOR, Version 2/27/97
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

	COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN
	COMMON /HEADER_SEEN/ HEADER_SEEN

	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)
	   LAST_LF_SEEN = LF_SEEN
	   LAST_REAL_LF_SEEN = REAL_LF_SEEN
	   END_LINE = INDEX(BUFFER(START_READ:END_READ),LF)
	   CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR)
	   IF (CR_SEEN.GT.0) THEN
	      IF (END_LINE.GT.0) THEN
		 IF (CR_SEEN.EQ.END_LINE-2.AND.BUFFER(START_READ+CR_SEEN:
     &		     START_READ+CR_SEEN).EQ.CR) CR_SEEN = CR_SEEN + 1
	      ELSE
		 IF (START_READ+CR_SEEN.EQ.END_READ.AND.
     &		     BUFFER(END_READ:END_READ).EQ.CR) CR_SEEN = 0
	      END IF
	   END IF
	   IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ.AND.
     &			CR_SEEN.GT.0).OR.CR_SEEN.LT.END_LINE-1) THEN
	      END_LINE = CR_SEEN
	      CR_SEEN = 1
	   ELSE
	      CR_SEEN = 0
	   END IF
	   LF_SEEN = END_LINE.GT.0
	   IF (END_LINE.GT.257-CR_SEEN.OR.
     &	       (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN
	      END_LINE = 255
	      IF (.NOT.HEADER_SEEN) END_LINE = 254
	   END IF
	   REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE
	   IF (END_LINE.GT.0) THEN
	      SB = START_READ
	      END_LINE = END_LINE + SB - 1
	      EB = END_LINE
	      IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1
	      IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1
	      IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1
	      IF (END_LINE.LT.END_READ) THEN
		 START_READ = END_LINE + 1
	      ELSE
		 END_READ = 0
	      END IF
	      IF (EB.GT.0.OR.LAST_LF_SEEN) 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(:MIN(LEN(WRITE),256))
	   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.
	   NEWS_WRITE = NEWS_RECONNECT(WRITE)
	   TRY_RECONNECT = .FALSE.
	END IF

	RETURN
	END





	LOGICAL FUNCTION NEWS_RECONNECT(WRITE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	COMMON /POINT/ BULL_POINT

	CHARACTER*(*) WRITE

	CHARACTER*8 NUMBER

	CHARACTER*(FOLDER_RECORD) FOLDER2_COM

	NEWS_RECONNECT = .FALSE.

	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

	NEWS_RECONNECT = .TRUE.

	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'

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*256 MESSAGE_ID

	COMMON /HEADER/ HEADER

	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().OR.SETPRV_PRIV()) THEN
	      IF (REMOTE_SET.EQ.4) THEN
		 HEADER_SAVE = HEADER
		 HEADER = .TRUE.
		 CALL OPEN_BULLFIL_SHARED
		 ILEN = LINE_LENGTH + 1
		 DO WHILE (ILEN.GT.0)
		    CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
		    IF (INPUT(:11).EQ.'Message-ID:') THEN
		       MESSAGE_ID = INPUT(14:ILEN-1)
		       ILEN = 0
		    END IF
		 END DO
		 CALL CLOSE_BULLFIL
		 HEADER = HEADER_SAVE
	      END IF
	      CALL NEWS_POST('cancel',0,IER,SUBJ)
	   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

	STAT = .TRUE.

	IF (REMOTE_SET.EQ.3.AND.XHDR) THEN
	   STAT = .FALSE.
	   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
	   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) THEN
		       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
		    STAT = .TRUE.
		    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)
		    DO WHILE (BUFFER(SB:EB).NE.'.'.AND.
     &			.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(
     &			BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1)))
		       IF (.NOT.NEWS_READ()) RETURN
		    END DO
		    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
	   STAT = .TRUE.
	   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)
		 DO J=257,512
		    IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126)
     &			TEMP(J:J) = ' '
		 END DO
		 DESCRIP = TEMP(257:512)
		 CALL GET_FROM(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 (STAT) THEN
	      IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN
	      IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	   END IF
	   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

	COMMON /HEADER_SEEN/ HEADER_SEEN
	COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN

	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 (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN
	      IF (.NOT.NEWS_WRITE('mode reader')) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	   END IF
	   IF (.NOT.NEWS_WRITE('XHDR')) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   XHDR = BUFFER(:3).NE.'500'
	   HEADER_SEEN = .FALSE.
	   LF_SEEN = .FALSE.
	   LAST_LF_SEEN = .FALSE.
	   REAL_LF_SEEN = .FALSE.
	   LAST_REAL_LF_SEEN = .FALSE.
	END IF

	NEWS_LOGIN = .TRUE.

	RETURN
	END


	SUBROUTINE CONVERT_TO_GMT(BTIM)

	IMPLICIT INTEGER (A-Z)

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

	DIMENSION GMT_DIFF(2),BTIM(2)

	CHARACTER HOUR*8
	DATA HOUR /' '/

	PARAMETER NZONES = 5

	COMMON /ZONE/ ZONE,LZONE
	CHARACTER*4 ZONE

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

	CHARACTER*8 TIMES(1)
	DATA TIMES /'-5:30'/

	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
		 IF (INDEX(ZONES,ZONE)/4.LT.4) THEN
		    HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00'
		 ELSE
		    HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4)
		 END IF
	      ELSE
		 HOUR = '00:00'
	      END IF
	   ELSE
	      HOUR = HOUR(:TRIM(HOUR))//':00'
	   END IF
	   ZONE = 'GMT'
	   IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),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_TI_L(TIME(:2),DATE,,%VAL(1))
	      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(:1),,,)
	      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
	      HOUR(3:) = HOUR(INDEX(HOUR,':'):)
	      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)),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 /FOLLOWUP/ FOLLOWUP
	CHARACTER*128 FOLLOWUP

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

	COMMON /SENDER/ SENDER_LINE
	CHARACTER*256 SENDER_LINE

	COMMON /HEADER_SEEN/ HEADER_SEEN
	COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN

	COMMON /NEWS2BULL/ NEWS2BULL

	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME

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

	DESCRIP = ' '
	FROM = ' '
	SUBJECT_LINE = ' '
	FROM_LINE = ' '
	SENDER_LINE = ' '
	NEWSGROUPS = ' '
	FOLLOWUP = ' '
	LREF = 0
	NEWS2BULL = .FALSE.

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

	DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN)
	   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
		 DO I=SB1,EB
		    IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126)
     &			BUFFER(I:I) = ' '
		 END DO
		 SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB)
		 DESCRIP = BUFFER(SB1:EB)
		 LAST_FROM = .FALSE.
	      ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN
		 CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM)
		 LAST_FROM = .FALSE.
	      ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN
		 CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM)
		 LAST_FROM = .FALSE.
	      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(FROM,BUFFER(SB1:EB),EB-SB1+1)
		 LAST_FROM = .TRUE.
	      ELSE IF (BUFFER(SB:SB+6).EQ.'Sender:'.AND.EB.GE.SB+8) THEN
		 SB1 = FIRST_ALPHA(BUFFER(SB+8:EB))+SB+7
		 SENDER_LINE = ': '//BUFFER(SB1:EB)
		 LAST_FROM = .TRUE.
	      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)
		 LAST_FROM = .FALSE.
	      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)
		 LAST_FROM = .FALSE.
	      ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND.
     &						    EB.GT.SB+12) THEN
		 SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12
		 FOLLOWUP = BUFFER(SB1:EB)
		 LAST_FROM = .FALSE.
	      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)
		 LAST_FROM = .FALSE.
	      ELSE IF (INDEX(BUFFER(SB:),
     &		       'X-Newsreader: News2bull').EQ.1) THEN 
	         NEWS2BULL = .TRUE.
	         IF (LPATH.EQ.0) CALL GET_PATHNAME
		 I = INDEX(BUFFER(SB:),'@')
		 IF (I.GT.0) THEN
	            SAMEHOST = STREQ(PATHNAME(2:LPATH),BUFFER(SB+I:EB))
		 END IF
	      ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN
		 IF (SENDER_LINE(:1).EQ.':') THEN 
		    SENDER_LINE = SENDER_LINE(:TRIM(SENDER_LINE))//' '//
     &				BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB)
		 ELSE
		    FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '//
     &				BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB)
		    CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE))
		 END IF
		 LAST_FROM = .TRUE.
	      ELSE
		 LAST_FROM = .FALSE.
	      END IF
	      IF (.NOT.LAST_FROM.AND.SENDER_LINE(:1).EQ.':') THEN
		 SENDER_LINE = 'From'//SENDER_LINE
	      END IF
	   END IF
	END DO

	NEWS2BULL = NEWS2BULL.AND.SAMEHOST

	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.'1FFF'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.'E000'X)
	   END IF
	ELSE
	   START = -1
	   CALL NEWNEWS(IN_BTIM,IER)
	   IF (IER.NE.0) START = IER
C
C   The following code makes use of the NNTP command NEWNEWS, but is
C   known to be slow and buggy in many servers.
C
C          IER = SYS$ASCTIM(,TIME,IN_BTIM,)
C          CALL DATE_TIME(TIME)
C          SKIP = 0
C          DO WHILE (SKIP.GE.0)
C             IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM(
C     &           FOLDER_NAME))//' '//TIME)) RETURN
C             IF (.NOT.NEWS_READ()) RETURN
C             IF (BUFFER(:2).EQ.'23') THEN
C                IF (.NOT.NEWS_READ()) CALL EXIT
C                DO I=1,SKIP
C                   IF (.NOT.NEWS_READ()) CALL EXIT
C                END DO
C                IF (FIRST.EQ.'.') RETURN
C                DO WHILE (BUFFER(SB:EB).NE.'.')
C                   IF (.NOT.NEWS_READ()) CALL EXIT
C                END DO
C                IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST))))
C     &                                   CALL EXIT
C                IF (.NOT.NEWS_READ()) CALL EXIT
C                IF (BUFFER(:2).EQ.'22') THEN
C                   IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN
C                      I = F_NBULL + 1
C                      DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE.
C     &                    BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))
C     &                    .OR.I.GT.F_NBULL))
C                         I = I - 1
C                         IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN
C                         IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
C                         IF (.NOT.NEWS_READ()) RETURN
C                      END DO
C                      IF (I.GE.F_START) START = I
C                   ELSE
C                      IER = OTS$CVT_TI_L(BUFFER(SB+4:
C     &                   INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
C                   END IF
C                   RETURN
C                END IF
C             END IF
C             SKIP = SKIP + 1
C          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=IER1) 2
	   IER = IER1
	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

	COMMON /HEADER_SEEN/ HEADER_SEEN
	COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN

	CHARACTER*256 TEMP

	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.'.'
     &			.OR..NOT.LAST_REAL_LF_SEEN)) 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).OR.
     &				   (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN
				TEMP = CHAR(LTEMP+1)
     &					   //' '//BUFFER(SB:SB+LTEMP-1)
				LTEMP = LTEMP + 1
			     END IF
			  ELSE IF (BUFFER(SB:SB).EQ.'.') THEN
			     TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1)
			     LTEMP = LTEMP - 1
			  END IF
			  IF (LOCAL_UPDATE1.NE.0) THEN
			     CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP)
			     TEMP(:1) = CHAR(LTEMP)
			  END IF
		       ELSE
			  HEADER_SEEN = .TRUE.
			  TEMP = CHAR(1)//' '
			  LTEMP = 1
		       END IF
		       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 (IER) THEN
		       IER = 0
		       INPUT = INPUT(:ILEN)//CHAR(0)
		       ILEN = -128
		    ELSE
		       ILEN = 128
		    END IF
		 END IF
	      ELSE
		 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 = 0
	      ELSE
		 CALL SYS_GETMSG(IER1)
		 LENGTH = 0
		 IER1 = IER
		 CALL DISCONNECT_REMOTE
		 IER = IER1     ! IER is set to 0 by DISCONNECT_REMOTE
	      END IF
	   ELSE IF (ABS(ILEN).EQ.128) THEN
	      CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT)
	      LENGTH = LENGTH + 1
	   END IF
	END DO

	HEADER_SEEN = .TRUE.

	RETURN
	END




	SUBROUTINE REMOTE_REMOVE_FOLDER(IER)

	IMPLICIT INTEGER (A-Z)

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	RETURN
	END



	SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
C
C  SUBROUTINE CONNECT_REMOTE_FOLDER
C
C  FUNCTION: Connects to folder that is located on other DECNET node.
C
	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/ READIT

	COMMON /NEWS_INIT/ END_READ

	COMMON /ALT_FOUND/ ALT_FOUND
	CHARACTER*128 ALT_FOUND

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFILES.INC'

	CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE
	CHARACTER*44 FOLDER_SAVE
	CHARACTER*64 ALT_SAVE

	DIMENSION DUMMY(4)

	IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN
	   ALT_SET_SAVE = ALT_SET()
	   IF (ALT_SET_SAVE) CALL UNSET_ALT
	   END_READ = 0
	   IER = 0
	   IF (.NOT.NEWS_LOGIN()) THEN
	      IER = 2
	      IF (.NOT.TEST_ALT(FOLDER1)) RETURN
	      IER = 1
	   END IF
	   IF (IER.NE.1) CALL NEWS_GROUP(IER)
	   IF (IER.EQ.1) THEN
	      IF (TEST_ALT(FOLDER1)) THEN
		 IER1 = SET_ALT(ALT_FOUND)
		 IF (IER1) CALL NEWS_GROUP(IER)
		 IF (.NOT.IER1.OR.IER.NE.0) THEN
		    CALL UNSET_ALT
	   	    IF (ALT_SET_SAVE) CALL SET_ALT(ALT_SAVE)
		    RETURN
		 END IF
		 ALT_SAVE = FOLDER1(INDEX(':',FOLDER1)+1:)
	         IER = 0
	      ELSE IF (ALT_SET_SAVE) THEN
	         CALL SET_ALT(ALT_SAVE)
		 IER = 1
	      END IF
	      RETURN
	   END IF
	   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 different
	   SAME = .FALSE.                         ! from local?  Yes.
	   LEN_BBOARD = LEN_BBOARD - 1
	END IF

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

	IF (IER.EQ.0) THEN
	   IF (.NOT.SAME) THEN
	      FOLDER1_FILE = FOLDER_FILE
	      FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER1
	      REMOTE_SET_SAVE = REMOTE_SET
	      REMOTE_SET = .FALSE.
	      CALL OPEN_BULLDIR
	      CALL READDIR(0,IER)
	      CALL CLOSE_BULLDIR
	      REMOTE_SET = REMOTE_SET_SAVE
	      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) THEN
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?'
	      READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1
	      IF (IER1) THEN
		 WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+'
		 SYSLOG = .TRUE.
	      END IF
	   END IF
	   IF (.NOT.SYSLOG) THEN
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1
	   END IF
	   FOLDER_OWNER_SAVE = FOLDER1_OWNER
	   FOLDER_BBOARD_SAVE = FOLDER1_BBOARD
	   FOLDER_NUMBER_SAVE = FOLDER1_NUMBER
	   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
	      ELSE
		 READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,
     &		   DUMMY(1),DUMMY(2),FOLDER1_COM
	      END IF
	   END IF
	   IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE
	   FOLDER1_BBOARD = FOLDER_BBOARD_SAVE
	   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.
     &	       TEST_BULLCP().NE.2) THEN                 ! Not BULLCP process
	      IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)
     &		  .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)
		 CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE)
		 IF (IER.EQ.0) REWRITE (4) USER_ENTRY
		 CALL CLOSE_BULLUSER
	      END IF
	   END IF
	   IER = 2
	ELSE
	   CLOSE (UNIT=31-REMOTE_UNIT)
C
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.
C
	   IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)
     &		.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)
	      IF (SYSLOG) THEN
		 CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3))
	      END IF
	   END IF
	   IER = 0
	END IF

	RETURN
	END



	SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

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

	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*256 MESSAGE_ID

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

	COMMON /NEWGROUP/ NEWGROUP

	CHARACTER*8 NUMBER

	DIMENSION IN_BTIM(2)

	IF (REMOTE_SET.EQ.1) THEN
	   IF (ICOUNT.GE.0) THEN
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT
	   ELSE
	      WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY
	   END IF
	   IF (IER.EQ.0) THEN
	      IF (ICOUNT.EQ.0) THEN
		 READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER
	      ELSE IF (ICOUNT.EQ.-1) THEN
		 READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY
		 IF (IER1.GT.0) THEN
		    CALL ERROR_AND_EXIT
		 ELSE IF (IER.NE.0) THEN
		    CALL CONVERT_ENTRY_FROMBIN
		 END IF
		 RETURN
	      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) THEN
	   IF (ICOUNT.EQ.0) THEN
	      NBULL = F_NBULL
	      ICOUNT = 1
	      RETURN
	   ELSE IF (ICOUNT.EQ.-1) THEN
	      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_EXIT
		 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_EXIT
		 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 - 1
		    IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN
		    IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))
     &						CALL ERROR_AND_EXIT
		    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 DO
		 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_EXIT
		    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) 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_EXIT
		    IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
		 END IF
	      END IF
	      IF (BUFFER(:2).NE.'22') RETURN
	      IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3),
     &							ICOUNT,,%VAL(1))
	      IF (.NOT.IER) RETURN
	      START = ICOUNT
	      BULLETIN_NUM = START
	   END IF
	   NEWGROUP = .FALSE.
	   MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1)
	   IER = 0
	   CALL NEWS_HEADER(IER)
	   CALL CONVERT_FROM_GMT(MSG_BTIM)
	   IF (IER.GT.0) THEN
	      CALL ERROR_AND_EXIT
	   ELSE
	      CALL CONVERT_ENTRY_FROMBIN
	   END IF
	   BLOCK = START
	   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)

	IMPLICIT INTEGER (A-Z)

	INTEGER BTIM(2)

	CHARACTER*8 MSG_KEY,INPUT

	INPUT = MSG_KEY

	DO I=1,8
	   INPUT(9-I:9-I) = MSG_KEY(I:I)
	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,EB
	CHARACTER BUFFER*1280

	COMMON /NEWGROUP/ NEWGROUP

	IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN
	   IER = 1
	   RETURN
	END IF

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

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

	IER = 1

	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) RETURN
	BUFFER = BUFFER(INDEX(BUFFER,' ')+1:)
	IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))
	IF (.NOT.IER) RETURN
	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*28 TIME

	DIMENSION DIFF(2)

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

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

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

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

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

	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 IF

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

	IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN
	   CALL SYS_BINTIM('-',BTIM)
	   RETURN
	END IF

	IF (INDEX(TIME(:I-2),'.').GT.0) THEN
	   CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM)
	ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN
	   CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM)
	ELSE
	   CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM)
	END IF

	IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN
	   IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF)
	   IF (IER) THEN
	      IF (TIME(I:I).EQ.'-') THEN
		 IER = LIB$SUBX(BTIM,DIFF,BTIM)
	      ELSE
		 IER = LIB$ADDX(BTIM,DIFF,BTIM)
	      END IF
	   END IF
	END IF

	RETURN
	END



	SUBROUTINE NEWS_LIST

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLFILES.INC'

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

	COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1
	DATA LOCAL_UPDATE1/0/

	COMMON /NEWSLIST/ NEWSLIST

	CHARACTER TODAY*24

	DIMENSION EXPIRED(2)

	CALL LIB$DATE_TIME(TODAY)

	IF (.NOT.NEWS_LOGIN()) RETURN

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

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

	CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER))

	LOCAL_UPDATE = LOCAL_UPDATE1

	NEWSLIST = .TRUE.
	CALL OPEN_BULLNEWS_SHARED       ! Open folder file

	NEWS_FOLDER1_BBOARD = '::'

	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)
	   CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)
	   WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	END IF
	NEWS_FLAG_DEFAULT = NEWS_F1_FLAG
	NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE
	NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT
	IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001
	NEWS_F_COUNT = NEWS_F1_COUNT
	DAMAGED = .FALSE.
	DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.')
	   FLEN = INDEX(BUFFER(SB:),' ') - 1
	   IF (INDEX(BUFFER(SB:),' ').EQ.0) DAMAGED = .TRUE.
	   NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1)
	   IF (IER1.EQ.0) THEN
	      CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)
	   END IF
	   SP = FLEN+SB+1
	   EP = INDEX(BUFFER(SP:),' ')+SP-2
	   IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE.
	   IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1))
	   SP = EP + 2
	   EP = INDEX(BUFFER(SP:),' ')+SP-2
	   IF (INDEX(BUFFER(SP:),' ').EQ.0) DAMAGED = .TRUE.
	   IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1))
	   IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0
	   CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)
	   SP = EP + 1
	   IF (IER.EQ.0.AND.IER1.EQ.0)
     &	      NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10)  ! Old bug caused this.
	   IF (IER.NE.0.OR.IER1.NE.0) THEN
	      IF ((FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT.
     &	          LEN(NEWS_FOLDER1_DESCRIP)).AND.DAMAGED) THEN
	         IF (FLEN.GT.44) THEN
		    NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)//
     &					   BUFFER(SP:EB)
	         ELSE
		    NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)
	         END IF
		 CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE)
	      END IF
           ELSE
	      CALL UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP)
	   END IF
	   IF (DAMAGED) THEN
	      IER = NEWS_READ()
	      DAMAGED = .FALSE.
	   END IF
	END DO

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

	OPEN (UNIT=33,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
     &        'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY)
	
	DO WHILE (IER.EQ.0)
	   READ (33,'(A)',IOSTAT=IER) INPUT
	   IF (IER.EQ.0) THEN 
	      FLEN = INDEX(INPUT,':')-1
	      NEWS_FOLDER1 = INPUT(:FLEN)
	      IF (SET_ALT(INPUT(FLEN+2:))) THEN
	         CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER1)
		 IF (IER1.NE.0) THEN
		    FOLDER1_DESCRIP = NEWS_FOLDER1
	            IF (FLEN.GT.44) THEN
	   	       NEWS_FOLDER1_DESCRIP = INPUT(45:FLEN)
	            ELSE
	               NEWS_FOLDER1_DESCRIP = ' '
	   	    END IF
	         END IF
		 CALL NEWS_GROUP(IER)
		 IF (IER.EQ.0) THEN 
	            NEWS_F1_NBULL = F1_NBULL
	            NEWS_F1_START = F1_START
		    IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0
		    IF (IER1.NE.0) THEN
		       CALL ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE)
		    ELSE
	               CALL UPDATE_NEWS_ENTRY(.FALSE.,LOCAL_UPDATE,FLEN,0)
		    END IF
		 END IF
	      END IF
	   END IF
	   IF (IER.NE.0) CLOSE (UNIT=33)
	   IF (ALT_SET()) THEN
	      CALL UNSET_ALT
	      IF (.NOT.NEWS_LOGIN()) RETURN
	   END IF
	END DO

	IF (SPECIAL) THEN
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)
	   LAST = FOLDER1_NUMBER
	   DO WHILE (IER.EQ.0)
	      CALL READ_FOLDER_FILE_TEMP(IER)
	      DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops
		 DELETE (7)
		 CALL READ_FOLDER_FILE_TEMP(IER)
	      END DO
	      LAST = FOLDER1_NUMBER
	      IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN
		 NEWS_F1_NBULL = F1_NBULL
		 NEWS_F1_START = F1_START
		 NEWS_F1_COUNT = F1_COUNT
		 CALL NEWS_GROUP(IER)
		 IF (IER.EQ.1.AND.TEST_ALT(NEWS_FOLDER1//
     &		     NEWS_FOLDER1_DESCRIP)) THEN
		   IER = 0
		 ELSE 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) THEN
			  IF (NEWS_F1_FIRST.GT.F1_START.AND.
     &			      NEWS_F1_FIRST.GT.F1_NBULL) THEN
			     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))
			  END IF
		       END IF
		    ELSE IF (((F1_START.NE.NEWS_F1_START.OR.
     &			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.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN
		    DELETE (UNIT=7)
		    IER = 0
		 ELSE IF (IER.EQ.1) THEN
		    IF (NEWS_F1_NBULL.LT.NEWS_F1_START
     &			  .OR.NEWS_F1_START.EQ.0) THEN
		       CALL CLOSE_BULLNEWS
		       FOLDER_NUMBER = FOLDER1_NUMBER
		       CALL SELECT_FOLDER(.FALSE.,IER1)
		       IF (IER1) THEN
			  CALL OPEN_BULLDIR_SHARED
			  CALL READDIR(NEWS_F1_START,IER1)
			  CALL CLOSE_BULLDIR
			  IER1 = NEWS_F1_START+1.EQ.IER1
		       END IF
		       CALL OPEN_BULLNEWS_SHARED
		       CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER)
		       IF (.NOT.IER1) DELETE (UNIT=7)
		    END IF
		    IER = 0
		 END IF
	      END IF
	   END DO
	END IF

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

	CALL CLOSE_BULLNEWS
	NEWSLIST = .FALSE.

	IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT

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

	RETURN
	END



	SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLNEWS.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFILES.INC'

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

	COMMON /REF/ REFERENCES,LREF
	CHARACTER*256 REFERENCES

	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*256 MESSAGE_ID

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /NEWSGROUPS/ NEWSGROUPS
	CHARACTER*256 NEWSGROUPS

	COMMON /FOLLOWUP/ FOLLOWUP
	CHARACTER*128 FOLLOWUP

	COMMON /ZONE/ ZONE,LZONE
	CHARACTER ZONE*4

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

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

	COMMON /SENDER/ SENDER_LINE
	CHARACTER*256 SENDER_LINE

	COMMON /TEMP_INPUT/ GROUP_TEMP
	CHARACTER GROUP_TEMP*256

	COMMON /HEADER/ HEADER

        COMMON /MAIL_INFO/ USE_INFROM

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

	CHARACTER*(*) FILENAME,SUBJECT

	CHARACTER RESPONSE*4

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

	COMMON /POINT/ BULL_POINT

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING

	COMMON /NEWS2BULL/ NEWS2BULL

	DIMENSION NOW(2)

	IER = 1

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

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

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

	   REWIND (UNIT=3)
	END IF

	IER = SYS$GETTIM(NOW)
	CALL CONVERT_TO_GMT(NOW)
	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) THEN
	   IF (.NOT.NEWS_LOGIN()) GO TO 900
	   IF (.NOT.NEWS_WRITE('POST')) GO TO 900
	   IF (.NOT.NEWS_READ()) GO TO 900
	   IF (BUFFER(:3).NE.'340') THEN
	      WRITE (6,'('' ERROR: Posting not allowed.'')')
	      GO TO 900
	   END IF
	ELSE
	   I = INDEX(NEWS_MSGID,'.')
	   LENGTH = 0
	   OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))//
     &		NEWS_MSGID(:I-1)//
     &		NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER,
     &		STATUS='NEW',DISPOSE='DELETE',RECL=256)
	   IF (IER.NE.0) RETURN
	   LOCAL_POST = .TRUE.
	   CALL INIT_QUEUE(GROUP_LIST1,FOLDER)
	   GROUP_LIST = GROUP_LIST1
	END IF

	IF (LPATH.EQ.0) CALL GET_PATHNAME

	IF (FILENAME.EQ.'cancel') THEN 
	   IF (.NOT.NEWS_WRITE('Newsgroups: junk')) GO TO 900
	ELSE 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 (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN
	      IF (TRIM(FOLLOWUP).EQ.0) THEN
		 INPUT = 'Newsgroups: '//NEWSGROUPS
		 IF (INDEX(NEWSGROUPS,',').GT.0) THEN
		    WRITE (6,'('' Warning: Original message was cross'',
     &                       ''posted to the following news groups:'')')
		    DO I=1,TRIM(NEWSGROUPS),PAGE_WIDTH
                       WRITE (6,'(1X,A)') NEWSGROUPS(I:
     &			I-1+MIN(PAGE_WIDTH,TRIM(NEWSGROUPS(I:))))
		    END DO
		    CALL GET_INPUT_PROMPT(RESPONSE,RLEN,
     &			'Type Y if you want your reply crossposted also, '//
     &			'N for no: (default = Y) ')
		    IF (RESPONSE(:1).EQ.'n'.OR.RESPONSE(:1).EQ.'N') THEN
		       INPUT = 'Newsgroups: '//FOLDER_NAME
		    END IF
		 END IF
	      ELSE
		 INPUT = 'Newsgroups: '//FOLLOWUP
	      END IF
	   ELSE
	      INPUT = 'Newsgroups: '//FOLDER_NAME
	   END IF
	   IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND.
     &	       .NOT.NEWS_FEED()) THEN
	      NGROUPS = 0
	      IF (BTEST(FOLDER_FLAG,8)) THEN
		 CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER)
		 NGROUPS = NGROUPS + 1
	      END IF
	      IF (CLI$PRESENT('GROUPS')) THEN
		 CALL OPEN_BULLNEWS_SHARED
		 FLEN = 0
		 DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP))
		    IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP)
		    DO WHILE (TRIM(GROUP_TEMP).GT.0)
		       COMMA = INDEX(GROUP_TEMP,',')
		       IF (COMMA.GT.0) THEN
			  FOLDER1_NAME = GROUP_TEMP(1:COMMA-1)
			  GROUP_TEMP = GROUP_TEMP(COMMA+1:)
		       ELSE
			  FOLDER1_NAME = GROUP_TEMP
			  GROUP_TEMP = ' '
		       END IF
		       CALL LOWERCASE(FOLDER1_NAME)
		       FLEN = TRIM(FOLDER1_NAME)
		       CALL READ_FOLDER_FILE_KEYNAME_TEMP
     &			(FOLDER1_NAME(:FLEN),IER1)
		       IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9)
     &			   .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND.
     &			   INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND.
     &			   INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN
			  INPUT = INPUT(:TRIM(INPUT))//
     &				  ','//FOLDER1_NAME(:FLEN)
			  IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN
			     CALL WRITE_QUEUE(%VAL(GROUP_LIST),
     &				GROUP_LIST,FOLDER1)
			     NGROUPS = NGROUPS + 1
			  END IF
		       ELSE
			  WRITE (6,'(1X,A,'' is not a valid news group.'')')
     &				FOLDER1_NAME(:FLEN)
			  CALL GET_INPUT_PROMPT(RESPONSE,RLEN,
     &			   'Do you still want to specify it? (default = Y) ')
			  IF (RESPONSE(:1).NE.'n'.AND.
     &			      RESPONSE(:1).NE.'N') THEN
			     INPUT = INPUT(:TRIM(INPUT))//
     &				  ','//FOLDER1_NAME(:FLEN)
			  END IF
		       END IF
		    END DO
		 END DO
		 CALL CLOSE_BULLNEWS
	      END IF
	   END IF
	   IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900
	END IF
	ATSIGN = INDEX(PATHNAME,'@')
	PCSIGN = INDEX(PATHNAME,'%')
	CALL LOWERCASE(USERNAME)
	IF (FILENAME.EQ.'cancel'.AND.SUBJECT(:6).EQ.'CanceL') THEN
	   IF (.NOT.NEWS_WRITE('Path: cyberspam!usenet')) GO TO 900
	ELSE
	   IF (PCSIGN.GT.0) THEN
	      IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'
     &	        //PATHNAME(PCSIGN+1:ATSIGN-1)//'!'
     &	        //USERNAME(:TRIM(USERNAME)))) GO TO 900
	   ELSE
	      IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'
     &	        //USERNAME(:TRIM(USERNAME)))) GO TO 900
	   END IF
	END IF
	IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME)

	IF (FILENAME.NE.'cancel') THEN
	   FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)//
     &			UNAME(:TRIM(UNAME))
	   IF (USE_INFROM) THEN
	      IF (INDEX(INFROM,'::').GT.0) THEN
		 IF (INDEX(INFROM,' ').GT.0) 
     &		    INFROM = INFROM(:INDEX(INFROM,' ')-1)
		 INFROM = INFROM(INDEX(INFROM,'::')+2:TRIM(INFROM))//
     &		      	  PATHNAME(:LPATH)
	      ELSE IF (INDEX(INFROM,'@').EQ.0) THEN 
		 INFROM = INFROM(:TRIM(INFROM))//PATHNAME(:LPATH)
	      END IF
	      IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM))))
     &	         GO TO 900
	      IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE))))
     &	         GO TO 900
	   ELSE IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED').AND.
     &	            SYS_TRNLNM('MX_REPLY_TO',INFROM)) THEN
	      IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM))))
     &	         GO TO 900
	      IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE))))
     &	         GO TO 900
	   ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED').AND.
     &	            SYS_TRNLNM('PMDF_REPLY_TO',INFROM)) THEN
	      IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM))))
     &	         GO TO 900
	      IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE))))
     &	         GO TO 900
	   ELSE IF (SYS_TRNLNM('MULTINET_ROOT','DEFINED').AND.  
     &	            SYS_TRNLNM('MULTINET_SMTP_REPLY_TO',INFROM)) THEN
	      IF (.NOT.NEWS_WRITE('From: '//INFROM(:TRIM(INFROM))))
     &	         GO TO 900
	      IF (.NOT.NEWS_WRITE('Sender: '//FROM_LINE(:TRIM(FROM_LINE))))
     &	         GO TO 900
	   ELSE
	      IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE))))
     &	         GO TO 900
	   END IF
	   CALL STR$UPCASE(FROM_LINE,FROM_LINE)
	   FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME))
	   CALL STR$UPCASE(USERNAME,USERNAME)
	ELSE IF (REMOTE_SET.EQ.3) THEN
	   IF (SENDER_LINE.NE.' ') THEN 
	      IF (.NOT.NEWS_WRITE(SENDER_LINE(:TRIM(SENDER_LINE))))
     &	         GO TO 900
	   ELSE
	      IF (.NOT.NEWS_WRITE(FROM_LINE(:TRIM(FROM_LINE))))
     &	         GO TO 900
	   END IF
	ELSE
	   HEADER_SAVE = HEADER
	   HEADER = .TRUE.
	   CALL OPEN_BULLFIL_SHARED
	   ILEN = LINE_LENGTH + 1
	   DO WHILE (ILEN.GT.0)
	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
	      ILEN = TRIM(INPUT)
	      IF (INPUT(:5).EQ.'From:') THEN
		 GROUP_TEMP = INPUT
	      ELSE IF (INPUT(:7).EQ.'Sender:') THEN
		 GROUP_TEMP = 'From:'//INPUT(8:)
		 ILEN = 0
	      END IF
	   END DO
	   ILEN = TRIM(GROUP_TEMP)
	   IF (ILEN.NE.0) THEN
	      IF (.NOT.NEWS_WRITE(GROUP_TEMP(:ILEN))) RETURN
	   END IF
	   CALL CLOSE_BULLFIL
	   HEADER = HEADER_SAVE
	END IF

	IF (FILENAME.EQ.'cancel') THEN
	   IF (.NOT.NEWS_WRITE('Subject: cancel <'//
     &	    MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900
	ELSE IF (TRIM(SUBJECT).EQ.0) THEN
	   IF (.NOT.NEWS_WRITE('Subject: (none)'))
     &	      GO TO 900
	ELSE
	   IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT))))
     &	      GO TO 900
	END IF
	SUBJECT_LINE = SUBJECT

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

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

	IF (FILENAME.NE.'cancel') THEN
	   IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(:
     &	       TRIM(NEWS_MSGID))//PATHNAME(:LPATH)//'>')) GO TO 900
	ELSE
	   IF (.NOT.NEWS_WRITE('Message-ID: <cancel.'//
     &	       MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900
	END IF
	NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH)

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

	IF (FILENAME.NE.'cancel'.AND.LORGAN.GT.0) THEN
	   IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))
     &		GO TO 900
	ELSE IF (FILENAME.EQ.'cancel') THEN
	   IF (.NOT.NEWS_WRITE('Organization: cancel'))
     &		GO TO 900
	END IF

	IF (.NOT.USE_INFROM.OR.COMPARE_DATE(TODAY(:11),DATE).GT.13) THEN
	   DATE = TODAY(:11)
	   TIME = TODAY(13:20)//'.00'
	   TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(8:20)
	   IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)
	   IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//
     &		ZONE(:LZONE))) GO TO 900
	ELSE
	   CALL COPY2(NOW,MSG_BTIM)
	   CALL CONVERT_TO_GMT(NOW)
	   IER = SYS$ASCTIM(,TODAY,NOW,)
	   DATE = TODAY(:11)
	   TIME = TODAY(13:20)//'.00'
	   TODAY = DATE(:2)//' '//DATE(4:6)//' '//DATE(8:)
	   IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)
	   IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//
     &		TIME(:8)//' '//ZONE(:LZONE))) GO TO 900
	   IER = SYS$ASCTIM(,TODAY,MSG_BTIM,)
	   DATE = TODAY(:11)
	   TIME = TODAY(13:20)//'.00'
	END IF

	INPUT_HEADER = .FALSE.

	IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel')) THEN
	   EXPR = NEWS_FEED().OR.USE_INFROM
	   IF (.NOT.EXPR) EXPR = CLI$PRESENT('EXPIRATION')
	   IF (EXPR) THEN
	      CALL SYS_BINTIM(EXDATE//' '//EXTIME,NOW)
	      CALL CONVERT_TO_GMT(NOW)
	      IER = SYS$ASCTIM(,TODAY,NOW,)
	      EXDATE = TODAY(:11)
	      EXTIME = TODAY(13:20)
	      I = INDEX(EXDATE,'-')
	      IF (EXDATE(I+5:I+8).EQ.'2100') THEN ! Servers not Y21K compliant
		 READ (DATE(8:11),'(I4)') J
		 WRITE (EXDATE(I+5:I+8),'(I4)') J+10	! 10 years
	      END IF
	      IF (.NOT.NEWS_WRITE('Expires: '//EXDATE(FIRST_ALPHA(EXDATE):2)
     &		   //' '//EXDATE(I+1:I+3)//' '//EXDATE(I+5:TRIM(EXDATE))
     &		   //' '//EXTIME(:8)//' '//ZONE(:LZONE)))
     &		   GO TO 900
	   ELSE IF (REMOTE_SET.EQ.4) THEN
	      IF (FOLDER_BBEXPIRE.GT.0) THEN
		 CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
	      ELSE
		 CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT)
	      END IF
	      EXTIME = '00:00:00.00'
	   END IF
	   IF (.NOT.NEWS_FEED()) THEN
	      IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN
	         CALL LOWERCASE(GROUP_TEMP)
	         IF (.NOT.NEWS_WRITE('Followup-To: '
     &		     //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900
	      END IF
	   END IF
	END IF

	IF (CREATE) THEN
	   IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME))))
     &		 RETURN
	END IF

	IF (NEWS_FEED().OR.NEWS2BULL) THEN
	   IF (LPATH.EQ.0) CALL GET_PATHNAME
	   IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull')) GO TO 900
	END IF

	IF (FILENAME.EQ.'cancel') THEN
	   IF (.NOT.NEWS_WRITE('Control: cancel <'
     &		//MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN
	   IF (.NOT.NEWS_WRITE(' ')) RETURN
	   IF (.NOT.NEWS_WRITE('cancel <'
     &		//MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN
	   IF (SUBJECT(:6).EQ.'CanceL') THEN
	      IF (SUBJECT.EQ.'CanceL') THEN
	         WRITE (6,1055)
	         ILEN = LINE_LENGTH + 1		! Length of input line
	         DO WHILE (ILEN.GE.0)		! Input until no more input
	            CALL GET_LINE(INPUT,ILEN)	! Get input line
	            IF (ILEN.GT.LINE_LENGTH) THEN  ! Input line too long
		       WRITE(6,'('' ERROR: Input line length > '',I,
     &			      ''.  Reinput:'')') LINE_LENGTH
	            ELSE IF (ILEN.GE.0) THEN	! If good input line entered
	    	       IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) RETURN
	            END IF
	         END DO
	      ELSE
		 IF (.NOT.NEWS_WRITE(SUBJECT(7:TRIM(SUBJECT)-6))) RETURN
	      END IF
	   END IF
	   IF (.NOT.NEWS_WRITE('.')) RETURN
	   IF (REMOTE_SET.EQ.3) THEN
	      IF (.NOT.NEWS_READ()) RETURN
	      IF (BUFFER(:3).EQ.'240') IER = 0
	   ELSE
	      CLOSE (UNIT=8,STATUS='SAVE')
	      IER = 0
	   END IF
	   CALL STR$UPCASE(USERNAME,USERNAME)
	   LOCAL_POST = .FALSE.
	   RETURN
	END IF

	IF (.NOT.INPUT_HEADER) THEN
	   IF (.NOT.NEWS_WRITE(' ')) GO TO 900
	END IF

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

	IF (REMOTE_SET.EQ.3) THEN
	   IF (.NOT.NEWS_WRITE('.')) GO TO 900
	   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:MIN(79+SB,EB))
	      IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN
		 WRITE (6,'('' Use /INDENT to change indentation'',$)')
		 WRITE (6,'(''+ character. See Manager for permanent'',$)')
		 WRITE (6,'(''+ change.'')')
	      END IF
	   END IF
	ELSE
	   LENGTH = (LENGTH+127)/128
	   GROUP_LIST = GROUP_LIST1
	   FOLDER_NUMBER_SAVE = FOLDER_NUMBER
	   SAVE_BULL_POINT = BULL_POINT
	   OLD_NBULL = NBULL
	   DO I=NGROUPS,1,-1
	      CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1)
	      FOLDER_NUMBER = -1
	      OLD_NBULL = NBULL
	      CALL SELECT_FOLDER(.FALSE.,IER)
	      IF (IER) THEN
		 CALL ADD_LOCAL_NEWS(8)
		 CALL ADD_TAG(IER,2)
		 IF (NEWS_FIND_SUBSCRIBE().LT.FOLDER_MAX) THEN
		    CALL NEWS_GET_NEWEST_MESSAGE(IER1)
		    IF (IER1.EQ.0.OR.IER1.EQ.OLD_NBULL+1) THEN
		       CALL NEWS_UPDATE_NEWEST_MESSAGE(OLD_NBULL+1)
		    END IF
		 END IF
	      END IF
	   END DO
	   IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN
	      FOLDER_NUMBER = FOLDER_NUMBER_SAVE
	      CALL SELECT_FOLDER(.FALSE.,IER)
	   END IF
	   BULL_POINT = SAVE_BULL_POINT
	   IF (.NOT.NEWS_WRITE('.')) GO TO 900
	   CLOSE (UNIT=8,STATUS='SAVE')
	   IER = 0
	END IF

900	IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3)
	CALL STR$UPCASE(USERNAME,USERNAME)

	LOCAL_POST = .FALSE.

1055	FORMAT(' State reason for deleting message not owned by you:')

	RETURN
	END



	SUBROUTINE GET_PATHNAME

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME

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

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

	CALL LOWERCASE(PATHNAME)
	LPATH = TRIM(PATHNAME)

	RETURN
	END



	LOGICAL FUNCTION TEST_NEWS(NAME)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) NAME

	TEST_NEWS = .FALSE.
	MAYBE_NEWS = .FALSE.

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

	TEST_NEWS = MAYBE_NEWS

	RETURN
	END



	SUBROUTINE UPDATE_LOCAL_NEWS

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	EXTERNAL BULLETIN_SUBCOMMANDS

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

	CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM)

	LOCAL_UPDATE = LOCAL_UPDATE1

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

	CALL OPEN_BULLNEWS_SHARED

	DO WHILE (NUM.GT.0)
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER)
	   IF (IER.EQ.0) THEN
	      CALL CLOSE_BULLNEWS
	      CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
	      LAST = F1_NBULL
	      FIRST = F1_START
	      IF (IER.EQ.0) THEN
		 FOLDER_COM = FOLDER1_COM
		 REMOTE_SET = 3
		 CALL OPEN_BULLDIR_SHARED
		 INCMD = 'READ'	  ! REMOTE_GET_HEADER uses NEXT otherwise
		 I = F_LAST + 1
		 IER = I - 1
		 DO WHILE (I.NE.IER.AND.I.LE.LAST)
		    CALL READDIR(I,IER)
		    I = I + 1
		 END DO
		 CALL CLOSE_BULLDIR
		 CALL OTS$CVT_L_TI(I-1,NUMBER,,,)
		 INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM(
     &			FOLDER))//' '//NUMBER//'-LAST'
		 CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
		 CALL MOVE(.FALSE.)
		 CALL OPEN_BULLNEWS_SHARED
		 IF (REMOTE_SET.EQ.4) THEN
		    NEW_F_COUNT = F_COUNT
		    NEW_NEWS_F_END = NEWS_F_END
		    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 = FIRST
		    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 DO

	RETURN
	END




	SUBROUTINE NEWS2BULL(RECLAIM)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

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

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /BULLCP_NEWS/ BULLCP_NEWS
	DATA BULLCP_NEWS /.FALSE./

	EXTERNAL BULLETIN_SUBCOMMANDS

	CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12

	CHARACTER*8 NUMBER

	DIMENSION NOW(2)

	BULLCP_NEWS = .TRUE.

	IER = SYS$GETTIM(NOW)

	CALL ALLPRIV

	CALL DELETE_EXPIRED_NEWS(RECLAIM)

	IF (RECLAIM) CALL EXIT

	CALL SEND_POST
	IF (ALT_SET()) CALL UNSET_ALT

	CALL NEWS_LIST

	CALL UPDATE_LOCAL_NEWS

	CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM)

	FOLDER_Q = FOLDER_Q1

	CALL OPEN_BULLFOLDER_SHARED             ! Get folder file

	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
	      IF (NEWS_FEED()) THEN
		 NUM_FOLDERS = NUM_FOLDERS + 1
		 CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
	      END IF
	   END IF
	END DO

	CALL CLOSE_BULLFOLDER                   ! We don't need file anymore

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

	FOLDER_Q = FOLDER_Q1
	POINT_FOLDER = 0
	DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)
	   POINT_FOLDER = POINT_FOLDER + 1
	   CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
	   CALL SELECT_FOLDER(.FALSE.,IER)
	   FOLDER_SAVE = FOLDER
	   BBOARD_SAVE = FOLDER_BBOARD
	   FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:)
	   FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1)
	   IF (IER) THEN
	      SAVE_LAST = F_LAST
	      CALL OPEN_BULLNEWS_SHARED
	      FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP))
	      CALL READ_FOLDER_FILE_KEYNAME
     &		(FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER)
	      CALL CLOSE_BULLNEWS
	      FOLDER1_DESCRIP = FOLDER_DESCRIP
	      IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
	      IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM
	      IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN
		 SAVE_LAST = F_NBULL
		 CALL OPEN_BULLFOLDER
		 CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)
		 F_LAST = SAVE_LAST
		 FOLDER_BBOARD = 'NONEFEED'
		 CALL REWRITE_FOLDER_FILE(IER1)
		 CALL CLOSE_BULLFOLDER
	      ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND.
     &		  F_NBULL.GE.F_START) THEN
	         IF (FOLDER_BBOARD.EQ.'NONEFEED') THEN
		    CALL SETUSER('SYSTEM')
	         ELSE
		    CALL SETUSER(FOLDER_BBOARD)
	         END IF
		 REMOTE_SET = 3
		 IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1)
     &			SAVE_LAST = F_START-1
		 SAVE_LAST = MAX(F_START-1,SAVE_LAST)
		 CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,)
		 INCMD = 'COPY/LOCAL/ORIGINAL '//FOLDER_SAVE(:TRIM(
     &			FOLDER_SAVE))//' '//NUMBER//'-LAST'
		 SAVE_LAST = F_NBULL
		 CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
		 CALL MOVE(.FALSE.)
		 CALL OPEN_BULLFOLDER
		 CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)
		 IF (IER1.EQ.0) THEN
		    F_LAST = SAVE_LAST
		    CALL REWRITE_FOLDER_FILE(IER1)
		 END IF
		 CALL CLOSE_BULLFOLDER
	         CALL SETUSER(USERNAME)
	      END IF
	   END IF
	END DO

	CALL EXIT
	END



	SUBROUTINE DATE_TIME(TIME)

	IMPLICIT INTEGER (A-Z)

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

	CHARACTER*(*) TIME

	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')+
     &		 MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//
     &		 TIME(16:17)//TIME(19:20)

	RETURN
	END



	SUBROUTINE ALLPRIV

	IMPLICIT INTEGER (A-Z)

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

	PROCPRIV(1) = -1
	PROCPRIV(2) = -1
	NEEDPRIV(1) = -1
	NEEDPRIV(2) = -1

	RETURN
	END



	SUBROUTINE NEWS_NEW_FOLDER

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

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

	NEWS_FOLDER1 = FOLDER1
	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_COUNT
	CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)
	WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM

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

	RETURN
	END



	SUBROUTINE SUBSCRIBE

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

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

	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 + 1
	END DO

	IF (I.GT.FOLDER_MAX-1) THEN
	   WRITE (6,'('' ERROR: Cannot subscribe.  You have '',
     &		    '' reached the news folder limit of '',I,''.'')')
     &		    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,''.'')')
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))
	END IF

	CALL UPDATE_USERINFO

	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)
	      IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN
		 CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1))
	      END IF
	   END IF
	   IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN
	      LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER
	      IF (F_START.LE.F_NBULL) THEN
		 LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1))
		 LAST_NEWS_READ(2,J) = F_START - 1
	      ELSE
		 LAST_NEWS_READ2(2,J) = 0
		 LAST_NEWS_READ(2,J) = F_NBULL
	      END IF
	      CALL CLOSE_BULLNEWS
	      CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ)
	      CALL UPDATE_USERINFO_NEWS_ALWAYS
	      RETURN
	   END IF
	END DO

	END





	SUBROUTINE UNSUBSCRIBE

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED

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

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

	CALL OPEN_BULLINF_SHARED
	DO WHILE (REC_LOCK(IER))
	   READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC
	END DO
	IF (IER.NE.0) THEN
	   DO I=1,FOLDER_MAX
	      INF_REC(1,I) = 0
	      INF_REC(2,I) = 0
	   END DO
	END IF
	CALL CLOSE_BULLINF

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

	IF (I.LE.FOLDER_MAX-1) THEN
	   WRITE (6,'('' ERROR: Folder is permanent and cannot not be'',
     &		      '' unsubscribed.'')')
	   RETURN
	END IF

	WRITE (6,'('' You are now no longer subscribed to '',A,''.'')')
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))

	CALL UPDATE_USERINFO

	I = NEWS_FIND_SUBSCRIBE()

	DO J=I,FOLDER_MAX-2
	   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

	CALL FREE_TAGS(I)

	IF (NINCLUDE.GT.0) THEN
	   WRITE (6,'('' Note: Excludes and/or '',
     &		      ''threads exist for this group.'')')
	   WRITE (6,'('' Type EXCLUDE/DISABLE/ALL to remove them.'')')
	END IF

	CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ)

	CALL UPDATE_USERINFO_NEWS_ALWAYS

	RETURN
	END



	SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	I = NEWS_FIND_SUBSCRIBE()

	IER = LAST_NEWS_READ(2,I) + 1

	IF (IER.EQ.0) IER = 1           ! None read yet.

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

	RETURN
	END



	SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	I = NEWS_FIND_SUBSCRIBE1()

	IER = LAST_NEWS_READ(2,I) + 1

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

	RETURN
	END



	SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	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.NEWS_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.'E000'X)
	END IF

	RETURN
	END





	SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	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-1
	      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 + 1
	END IF

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

	RETURN
	END




	SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)
C
C  SUBROUTINE NEWS_NEW_NOTIFICATION
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	COMMON /READIT/ READIT

	COMMON /POINT/ BULL_POINT

	COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)

	MESSAGES = .FALSE.

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

	CALL NEWS_GET_SUBSCRIBE(0,MSGNUM)

	CALL OPEN_BULLNEWS_SHARED
	SUBNUM = 1

	FOLDER_DESCRIP = ' '
	REORDER = 0
	DO WHILE (SUBNUM.GT.0)
	   IER = 1
	   DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)
	      CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)
	      FOLDER1_DESCRIP = FOLDER_DESCRIP
	      IF (SUBNUM.NE.0) THEN
		 CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)
		 IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM
		 UNLOCK 7
		 IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1
		 IF (IER.EQ.0.AND.
     &			MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN
		    CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1)
		    CALL UPDATE_USERINFO
		    IF (F_START.EQ.0) IER = 1
		 ELSE IF (IER.NE.0) THEN
		    SUBNUM = -1
		 ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.
     &			  F_START.GT.F_NBULL) THEN
		    IER = 1
		 END IF
	      END IF
	      IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN
		 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)
		       IF (DIFF.GT.0) IER = 1
		    END IF
		 END IF
	      END IF
	   END DO
	   IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN
	      WRITE (6,'('' There are new messages in folder '',
     &		  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)
	      ELSE
		 CALL CLOSE_BULLNEWS
		 CALL SELECT_FOLDER(.FALSE.,IER1)
		 IF (IER1) THEN
		    CALL LOGIN_FOLDER
		    IF (BULL_POINT.NE.-1) THEN
		       NEWS_FOLDER_NUMBER = FOLDER_NUMBER
		       IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN
			  SAVE_BULL_POINT = BULL_POINT
			  REDO = .TRUE.
			  DO WHILE (REDO)
			     REDO = .FALSE.
			     CALL READNEW(REDO)
			     IF (REDO) CALL REDISPLAY_DIRECTORY
			     BULL_POINT = SAVE_BULL_POINT
			  END DO
		       END IF
		    END IF
		 END IF
		 CALL OPEN_BULLNEWS_SHARED
	      END IF
	   END IF
	END DO

	IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE

	CALL CLOSE_BULLNEWS

	RETURN
	END


	SUBROUTINE REORDER_SUBSCRIBE

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

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

	I = I - 1

	DO I1=1,I-1
	   DO J=1,I-I1
	      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)
	      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)
		    LAST_NEWS_READ(L,K) = TEMP
		 END DO
	      END IF
	   END DO
	END DO

	RETURN
	END




	LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN
	   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)

	RETURN
	END




	LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN
	   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)

	RETURN
	END




	LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

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

	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)

	RETURN
	END



	INTEGER FUNCTION NEWS_FIND_SUBSCRIBE()

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

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

	NEWS_FIND_SUBSCRIBE = I

	RETURN
	END



	INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1()

	IMPLICIT INTEGER (A-Z)

	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 + 1
	END DO

	NEWS_FIND_SUBSCRIBE1 = I

	RETURN
	END




	SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'

	I = NEWS_FIND_SUBSCRIBE()

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

	CALL OPEN_BULLINF_SHARED
	DO WHILE (REC_LOCK(IER))
	   READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC
	END DO
	IF (IER1.NE.0) THEN
	   DO I=1,FOLDER_MAX
	      INF_REC(1,I) = 0
	      INF_REC(2,I) = 0
	   END DO
	END IF
	CALL CLOSE_BULLINF

	IP = 1
	DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER
     &					.AND.IP.LE.FOLDER_MAX-1)
	   IP = IP + 1
	END DO

	IER = .TRUE.

	IF (IP.EQ.FOLDER_MAX) THEN
	   PERM = .FALSE.
	   IP = 1
	ELSE
	   PERM = .TRUE.
	END IF

	IF (NOTIFY.EQ.0) THEN
	   IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN
	      WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')')
	      RETURN
	   ELSE
	      LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13)
	   END IF
	ELSE IF (NOTIFY.EQ.1) THEN
	   LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13)
	   RETURN
	ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND.
     &	    (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN
	   IER = .FALSE.
	ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND.
     &	    (BTEST(INF_REC2(2,IP),14).AND.
     &	    .NOT.BTEST(INF_REC2(2,IP),15))) THEN
	   IER = .FALSE.
	ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND.
     &	    (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN
	   IER = .FALSE.
	END IF

	IF (IER) THEN
	   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)
	ELSE
	   WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')')
	   WRITE (6,'('' Flags will be set to those permanent settings.'')')

	   IF (BTEST(INF_REC2(2,IP),14)) THEN
	      LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14)
	   ELSE
	      LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14)
	   END IF

	   IF (BTEST(INF_REC2(2,IP),15)) THEN
	      LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15)
	   ELSE
	      LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15)
	   END IF
	END IF

	CALL UPDATE_USERINFO

	RETURN
	END



	SUBROUTINE ADD_LOCAL_NEWS(UNIT)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	COMMON /LAST_RECORD_WRITTEN/ OCOUNT

	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)
	IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN
	   CALL STORE_BULL(TRIM(SUBJECT_LINE)+6,
     &		'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK)
	END IF
	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 + 1
	SYSTEM = 0
	CALL ADD_ENTRY
	CALL CLOSE_BULLFIL
	CALL UPDATE_NEWS_FOLDER
	CALL CLOSE_BULLDIR

	RETURN
	END



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

	IMPLICIT INTEGER (A-Z)

	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,F_NEWEST_BTIM)
	   F_NBULL = NEW_NEWS_F_END
	   NEWS_F_END = NEW_NEWS_F_END
	   F_COUNT = NEW_F_COUNT
	END IF

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

	CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))
	IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0)
     &		NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY

	CALL REWRITE_FOLDER_FILE(IER)

	CALL CLOSE_BULLNEWS

	RETURN
	END



	SUBROUTINE SEND_POST

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLDIR.INC'

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

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /ALT_FOUND/ ALT_FOUND
	CHARACTER*128 ALT_FOUND

	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME

	COMMON /NEWSBULL/ NEWSBULL
	DATA NEWSBULL /.FALSE./

	CHARACTER FILE*132

	C = 0

	IF (.NOT.NEWS_LOGIN()) RETURN
	DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))
     &			//'*.POST*',FILE,C))
50	   IF (.NOT.NEWS_WRITE('POST')) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   IF (BUFFER(:3).NE.'340') RETURN

	   NEWSBULL = .FALSE.

	   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 (INPUT(:5).EQ.'From:') BULL_PARAMETER = INPUT(7:)
		 IF (INDEX(INPUT,'X-Newsreader: News2bull').EQ.1) THEN 
		    NEWSBULL = .TRUE.
	            IF (LPATH.EQ.0) CALL GET_PATHNAME
	            IF (.NOT.NEWS_WRITE('X-Newsreader: News2bull'
     &	       		//' '//PATHNAME(:TRIM(PATHNAME)))) GO TO 100
		 ELSE
		    IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100
		 END IF
	      END IF
	   END DO
	   IF (INPUT.NE.'.') THEN
	      IF (.NOT.NEWS_WRITE('.')) GO TO 100
	   END IF
	   IF (.NOT.NEWS_READ()) GO TO 100
	   IF (BUFFER(:3).EQ.'441'.AND..NOT.ALT_SET()) THEN
	      REWIND (UNIT=3)
	      IER = 0
	      DO WHILE (IER.EQ.0)
	         READ (3,'(Q,A)',IOSTAT=IER) I,INPUT
	         IF (IER.EQ.0.AND.INPUT(:12).EQ.'Newsgroups: ') THEN 
		    CLOSE (UNIT=3)
		    IF (TEST_ALT(INPUT(13:))) THEN
			IF (SET_ALT(ALT_FOUND)) GOTO 50
			GOTO 90
	            END IF
	            IER = 2
	         END IF
	      END DO
	      CLOSE (UNIT=3)
	   END IF
	   IF (BUFFER(:3).NE.'240') THEN
	      CLOSE (UNIT=3)
	      IF (NEWSBULL.AND.INDEX(FILE,'POST_ERROR').EQ.0) THEN 
		 CALL LIB$RENAME_FILE(FILE,'*.POST_ERROR',,,,,,,,,FILE)
	         CALL SENDMAIL(FILE,'SYSTEM'
     &			,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER)
		 NEWSBULL = .FALSE.
	      ELSE IF (.NOT.NEWSBULL) THEN 
	         CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER))
     &			,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER)
	         OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD')
		 CLOSE (UNIT=3,STATUS='DELETE')
	      END IF
	   ELSE
	      CLOSE (UNIT=3,STATUS='DELETE')
	   END IF
90	   IF (ALT_SET()) CALL UNSET_ALT
	END DO

100	CLOSE (UNIT=3)

	RETURN
	END



	SUBROUTINE GET_UNAME(UNAME)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($MAILDEF)'

	CHARACTER*(*) UNAME

	CALL DISABLE_PRIVS

	C = 0

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

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

100	CALL ENABLE_PRIVS

	IER = SYS_TRNLNM('BULL_PERSONAL_NAME',UNAME)
	
	IF (UNAME.EQ.'()') THEN
	   UNAME = ' '
	ELSE IF (TRIM(UNAME).GT.0) THEN
	   UNAME = ' ('//UNAME(:TRIM(UNAME))//')'
	END IF

	RETURN
	END



	SUBROUTINE RECOUNT
C
C  SUBROUTINE RECOUNT
C
C  FUNCTION:
C
C  Fixes the message count of stored news groups.  This may become wrong
C  if old copies of some of the database files are used with newer versions.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFILES.INC'

	COMMON /NEXT/ NEXT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /BULLFIL/ BULLFIL

	COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE
	CHARACTER*80 BULLNEWSDIR_FILE

	FOLDER_NUMBER = 1000

	FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]'

	CALL OPEN_BULLNEWS_SHARED

	DO WHILE (REC_LOCK(IER))
	   READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1)
	END DO

	IF (IER.NE.0) THEN
	   CALL CLOSE_BULLNEWS
	   RETURN
	END IF

	REMOTE_SET = 4

	DO WHILE (IER.EQ.0)

	   DO WHILE (REC_LOCK(IER))
	      READ (7,IOSTAT=IER) NEWS_FOLDER_COM
	   END DO

	   IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN
	      CALL NEWS_TO_FOLDER

	      CALL OPEN_BULLDIR_SHARED

	      NUM = F_START
	      F_COUNT = 0

	      IF (F_START.GT.0) THEN
		 CALL READDIR(NUM,IER)
		 NEXT = .TRUE.
		 F_START = NUM
		 DO WHILE (NUM+1.EQ.IER)
		    F_COUNT = F_COUNT + 1
		    NUM = NUM + 1
		    IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER)
		 END DO
		 NEXT = .FALSE.

		 F_NBULL = NUM - 1
	      END IF

	      CALL CLOSE_BULLDIR

	      CALL REWRITE_FOLDER_FILE(IER)
	   END IF
	END DO

	CALL DELLNM('BULL_NEWS_RECOUNT')

	CALL CLOSE_BULLNEWS

	RETURN
	END



	SUBROUTINE DELLNM(LOG)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($PSLDEF)'

	CHARACTER*(*) LOG

	CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER)

	RETURN
	END


	SUBROUTINE DELLNM_USER(LOG)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($PSLDEF)'

	CHARACTER*(*) LOG

	CALL SYS$DELLNM('LNM$PROCESS',LOG,PSL$C_USER)

	RETURN
	END


	SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND)

	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

	DIMENSION SINCE_BTIM(2)

	START = F_START
	END = F_NBULL

	FOUND = 0

	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
	   IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1))
     &							     RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   IF (BUFFER(:2).EQ.'22') THEN
	      IF (.NOT.NEWS_READ()) RETURN
	      DO WHILE (BUFFER(SB:EB).NE.'.')
		 IF (FOUND.EQ.0) THEN
		    L = INDEX(BUFFER(SB:EB),' ')
		    CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1))
		    CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM)
		    CALL CONVERT_FROM_GMT(MSG_BTIM)
		    IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0)
     &			     FOUND = IER
		 END IF
		 IF (.NOT.NEWS_READ()) RETURN
	      END DO
	      IF (FOUND.NE.0) THEN
		 IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN
		 IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
		 IF (.NOT.NEWS_READ()) RETURN
	      END IF
	   END IF
	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
	   I = START
	   DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0)
	      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
	      CALL CONVERT_FROM_GMT(MSG_BTIM)
	      IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM
	      I = I + 1
	      IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) 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
	   IF (FOUND.EQ.0) THEN
	      IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN
	      IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	   END IF
	END IF

	RETURN
	END



	LOGICAL FUNCTION TEST_ALT(FOLDER1)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFILES.INC'

	COMMON /ALT_FOUND/ ALT_FOUND
	CHARACTER*128 ALT_FOUND

        CHARACTER*(*) FOLDER1

	TEST_ALT = .FALSE.

	OPEN (UNIT=3,FILE=FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
     &	      'BULL_ALT_NEWS.LIS',IOSTAT=IER,STATUS='OLD',READONLY)
	
	IF (IER.NE.0) RETURN

	DO WHILE (IER.EQ.0)
	   READ (3,'(A)',IOSTAT=IER) ALT_FOUND
	   IF (STREQ(ALT_FOUND(:INDEX(ALT_FOUND,':')-1),
     &	      FOLDER1(:TRIM(FOLDER1)))) THEN
	      ALT_FOUND = ALT_FOUND(INDEX(ALT_FOUND,':')+1:)
	      CLOSE (UNIT=3)
	      TEST_ALT = .TRUE.
	      RETURN
	   END IF
	END DO

	CLOSE (UNIT=3)

	RETURN
	END



	LOGICAL FUNCTION SET_ALT(NEWALT)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) NEWALT

	COMMON /ALT/ ALT,SETALT
	CHARACTER*64 ALT
	LOGICAL SETALT
	DATA SETALT/.FALSE./

	SET_ALT = .FALSE.

	IF (SETALT) THEN
	   IF (NEWALT.EQ.ALT) THEN
	      SET_ALT = .TRUE.
	      RETURN
	   ELSE
	      CALL UNSET_ALT
	   END IF
	END IF

	CALL NEWS_LOGOUT

	CALL CRELNM('BULL_NEWS_SERVER',NEWALT(:TRIM(NEWALT)))

	IF (NEWS_LOGIN()) THEN
	   SET_ALT = .TRUE.
	   SETALT = .TRUE.
	   ALT = NEWALT
	ELSE
	   CALL DELLNM_USER('BULL_NEWS_SERVER')
	   SETALT = .FALSE.
	END IF

	RETURN
	END



        SUBROUTINE UNSET_ALT

        IMPLICIT INTEGER (A-Z)

        COMMON /ALT/ ALT,SETALT
        CHARACTER*64 ALT
	LOGICAL SETALT

	CALL DELLNM_USER('BULL_NEWS_SERVER')

	CALL NEWS_LOGOUT

	SETALT = .FALSE.

	RETURN
	END



	LOGICAL FUNCTION ALT_SET()

        COMMON /ALT/ ALT,SETALT
        CHARACTER*64 ALT
	LOGICAL SETALT

	ALT_SET = SETALT

	RETURN
	END



	SUBROUTINE ADD_NEW_NEWS_ENTRY(FLEN,LOCAL_UPDATE)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	DIMENSION EXPIRED(2)

	CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1)
	IER2 = 1
	I = FLEN
	NEWS_F1_COUNT = NEWS_F_COUNT
	DO WHILE (IER2.NE.0.AND.I.GT.1)
	   IF (NEWS_FOLDER(I:I).EQ.'.') THEN
	      NEWS_FOLDER = NEWS_FOLDER(:I)
	      DO WHILE (REC_LOCK(IER))
	         READ (7,KEY=NEWS_FOLDER,
     &	               KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM
	      END DO
	   END IF
	   IF (IER2.NE.0) I = I - 1
	END DO
	NEWS_F_COUNT = NEWS_F1_COUNT
	IER = 0
	DO WHILE (IER.EQ.0.AND.IER1.EQ.0)
	   DO WHILE (REC_LOCK(IER))
	      READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER)
	   END DO
	   IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1
	END DO
	NEWS_FOLDER1_NUMBER = NEWS_F_COUNT
	IF (IER2.EQ.0) THEN
	   NEWS_F1_FLAG = NEWS_F_FLAG
	   NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10)
	   IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN
	      NEWS_F1_EXPIRE = NEWS_F_EXPIRE
	      NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT
	   END IF
	ELSE
	   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)
	CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED)
	CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE)
	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 = 0
	   NEWS_F1_LAST = 0
	END IF

	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.
     &	     .NOT.BTEST(NEWS_F1_FLAG,9)) THEN
	       CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,
     &	     	%DESCR(NEWS_FOLDER1_NUMBER))
	   END IF
	END IF

	RETURN
	END




	SUBROUTINE UPDATE_NEWS_ENTRY(SPECIAL,LOCAL_UPDATE,FLEN,SP)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

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

	IF (BTEST(NEWS_F1_FLAG,8).AND.
     &			.NOT.BTEST(NEWS_F1_FLAG,9)) THEN
	   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) THEN
		 NEWS_F1_LAST = 0
		 NEWS_F1_START = F1_START
		 NEWS_F1_NBULL = F1_NBULL
		 REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	      END IF
	      IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN
		 CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,
     &					%DESCR(NEWS_FOLDER1_NUMBER))
	      END IF
	   END IF
	ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN
	   UPDATE = .FALSE.
	   IF (SP.GT.0) THEN 
	      IF (FLEN.GT.44) THEN
	         IF (NEWS_FOLDER1_DESCRIP.NE.
     &	             BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN
		    NEWS_FOLDER1_DESCRIP =
     &			BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)
		    UPDATE = .TRUE.
	         END IF
	      ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN
	         NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)
	         UPDATE = .TRUE.
	      END IF
	   ELSE
	      UPDATE = .TRUE.
	   END IF
	   IF (SPECIAL) THEN
	      IF (UPDATE) THEN
		 NEWS_F1_START = F1_START
		 NEWS_F1_NBULL = F1_NBULL
	      END IF
	   ELSE IF (.NOT.UPDATE) THEN
	      UPDATE = F1_START.LT.NEWS_F1_START.OR.
     &		       F1_NBULL.NE.NEWS_F1_NBULL
	   END IF
	   IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	END IF

	RETURN
	END
