C
C  BULLETIN10.FOR, Version 1/8/92
C  Purpose: Bulletin board utility program.
C  Environment: VAX/VMS
C  Usage: Invoked by the BULLETIN command.
C  Programmer: Mark R. London
C
C  Copyright (c) 1990
C  Property of Massachusetts Institute of Technology, Cambridge MA 02139.
C  This program cannot be copied or distributed in any form for non-MIT
C  use without specific written approval of MIT Plasma Fusion Center
C  Management.
C
	INTEGER FUNCTION NEWS_READ()
 
	IMPLICIT INTEGER (A-Z)
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
	PARAMETER CR = CHAR(13), LF = CHAR(10)
 
	COMMON /NEWS_INIT/ END_READ
 
	NEWS_READ = 1
 
	IF (END_READ.EQ.0) THEN
	   IER = NEWS_READ_PACKET(BUFFER(:1024))
	   IF (IER.LE.0) THEN
	      CALL NEWS_LOGOUT
	      NEWS_READ = 0
	      RETURN
	   END IF
	   START_READ = 1
	   END_READ = IER
	END IF
 
	IF (END_READ.EQ.0) THEN
	   NEWS_READ = 0
	   RETURN
	END IF
 
	DO WHILE (1)
	   END_LINE = INDEX(BUFFER(START_READ:END_READ),LF)
	   IF (END_LINE.GT.257.OR.
     &	       (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN
	      END_LINE = 255
	   END IF
	   IF (END_LINE.GT.0) THEN
	      SB = START_READ
	      END_LINE = END_LINE + SB - 1
	      EB = END_LINE - 2
	      IF (BUFFER(EB+2:EB+2).NE.LF) EB = EB + 2
	      IF (END_LINE.LT.END_READ) THEN
	         START_READ = END_LINE + 1
	      ELSE
	         END_READ = 0
	      END IF
	      RETURN
	   ELSE
	      BUFFER = BUFFER(START_READ:END_READ)
	      END_READ = END_READ - START_READ + 1
	      IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024))
	      IF (IER.LE.0) THEN
	         NEWS_READ = 0
	         RETURN
	      ELSE
	         START_READ = 1
		 END_READ = END_READ + IER
	      END IF
	   END IF
	END DO
 
	RETURN
	END
 
 
 
 
	INTEGER FUNCTION NEWS_WRITE(WRITE)
 
	IMPLICIT INTEGER (A-Z)
 
	PARAMETER CR = CHAR(13), LF = CHAR(10)
 
	COMMON /NEWS_INIT/ END_READ
 
	CHARACTER*(*) WRITE
 
	LOGICAL TRY_RECONNECT/.FALSE./
 
	END_READ = 0
 
	IF (WRITE.EQ.' ') THEN
	   NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF)
	ELSE
	   NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF)
	END IF
 
	IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN
	   TRY_RECONNECT = .TRUE.
	   CALL NEWS_RECONNECT(WRITE)
	   TRY_RECONNECT = .FALSE.
	END IF
 
	RETURN
	END
 
 
 
 
	SUBROUTINE NEWS_RECONNECT(WRITE)
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLFOLDER.INC'
 
	COMMON /POINT/ BULL_POINT
 
	CHARACTER*(*) WRITE
 
	CHARACTER*6 NUMBER
 
	CHARACTER*(FOLDER_RECORD) FOLDER2_COM
 
	CALL NEWS_LOGOUT
 
        IF (.NOT.NEWS_LOGIN()) RETURN
	
	IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN
	   FOLDER2_COM = FOLDER1_COM
	   FOLDER1 = FOLDER
	   FOLDER1_DESCRIP = FOLDER_DESCRIP
	   CALL NEWS_GROUP(IER)
	   IF (IER.NE.0) RETURN
	   FOLDER1_COM = FOLDER2_COM
 
	   IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN
	   IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
           IF (.NOT.NEWS_READ()) RETURN
	END IF
	
	IF (.NOT.NEWS_WRITE(WRITE)) RETURN
 
	RETURN
	END
 
 
 
	SUBROUTINE NEWS_LOGOUT
 
        IMPLICIT INTEGER (A-Z)
 
	COMMON /NEWS_CONNECTED/ NEWS_CONNECTED
 
	CALL NEWS_DISCONNECT
	NEWS_CONNECTED = .FALSE.
	
	RETURN
	END
 
 
 
	SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER)
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE 'BULLUSER.INC'
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME
 
	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*255 MESSAGE_ID
 
	CHARACTER*12 HIGHFROM
 
	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.EQ.3) THEN
	   CALL STR$UPCASE(HIGHFROM,FROM)
	   IF (LPATH.EQ.0) CALL GET_PATHNAME
	   IF (HIGHFROM.EQ.USERNAME.AND.
     &		MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'):
     &		TRIM(MESSAGE_ID)-1).EQ.
     &		PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) THEN
	      CALL NEWS_POST('cancel',0,IER,'Delete news item.')
	   ELSE
	      WRITE (6,'('' ERROR: Not owner of message.'')')
	   END IF
	   IER = 0
	END IF
 
	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*6 NUMBER,NUMBER1
 
	CHARACTER*1024 TEMP
 
	DATA QXHDR1 /0/
 
	IF (XHDR) THEN
	   IF (QXHDR1.NE.0) THEN		! Is queue empty?
	      QXHDR = QXHDR1		! No, set queue pointer to head
	   ELSE				! Else if queue is empty
	      CALL INIT_QUEUE(QXHDR,TEMP)
	      QXHDR1 = QXHDR		! Init header pointer
	   END IF
	END IF
 
	SYSTEM = 0
 
	IF (REMOTE_SET.EQ.1) THEN
	   IF (REVERSE) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START
	   ELSE
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END
	   END IF
	ELSE
	   IER = 2
	   NUMDIR = END - START + 1
	   IF (START.LT.F_START) THEN
	      START = F_START
	      END = START + NUMDIR - 1 
	   END IF
	END IF
 
	IF (REMOTE_SET.EQ.3.AND.XHDR) THEN
	   IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
	   IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN
	   DO WHILE (NUMBER1(1:1).EQ.' ')
	      NUMBER1 = NUMBER1(2:)
	   END DO
	   NUMDIR1 = 0
	   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.'.'.AND..NOT.
     &		    OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')+SB-2)
     &		    ,START,,%VAL(1))) RETURN
	         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) RETURN
		    START = MAX(F_START,START-NUMDIR)
		    END = START + NUMDIR - 1
		    IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
		    IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN
		    DO WHILE (NUMBER1(1:1).EQ.' ')
		       NUMBER1 = NUMBER1(2:)
	 	    END DO
	         ELSE IF (NUMDIR1.LT.NUMDIR) THEN
		    IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1)))
     &								 RETURN
		    IF (.NOT.NEWS_READ()) RETURN
		    IF (.NOT.NEWS_WRITE('NEXT')) RETURN
		    IF (.NOT.NEWS_READ()) RETURN
	            IF (BUFFER(:2).NE.'22') THEN
	               NUMDIR = NUMDIR1
		    ELSE
		       NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2)
                       IF (.NOT.OTS$CVT_TI_L(NUMBER,
     &						MSG_NUM,,%VAL(1))) RETURN
		       DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ')
		          NUMBER = ' '//NUMBER(1:)
		       END DO
		       MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1
		       IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN
		       DO WHILE (NUMBER1(1:1).EQ.' ')
		          NUMBER1 = NUMBER1(2:)
		       END DO
	            END IF
	         END IF
	      END IF
	   END DO
	   CALL OTS$CVT_L_TI(START,NUMBER,,,)
	   NUMBER1 = TEMP(:INDEX(TEMP,' ')-1)
	   END = START + NUMDIR - 1
	   DO I=1,2
	      IF (I.EQ.1.AND..NOT.NEWS_WRITE
     &		('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN
	      IF (I.EQ.2.AND..NOT.NEWS_WRITE
     &		('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	      IF (BUFFER(:2).EQ.'22') THEN
	         QXHDR = QXHDR1
		 IF (.NOT.NEWS_READ()) RETURN
		 NUMDIR1 = 0
	         DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR)
		    NUMDIR1 = NUMDIR1 + 1
	            CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP)
		    SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1
		    SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1
		    TEMP(I*256+1:) = BUFFER(SB1:EB)
	            CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
		    IF (.NOT.NEWS_READ()) RETURN
		 END DO
	      END IF
	   END DO
	   QXHDR = QXHDR1
	   IER = 0
	ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN
	   IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
	   IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
	   IF (.NOT.NEWS_READ()) RETURN
	   IF (BUFFER(:2).NE.'22') THEN
	      IF (.NOT.NEWS_WRITE('NEXT')) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
              IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4:
     &		  INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN
	      IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN
		 BUFFER(:3) = '500'
		 DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22')
		    START = START + 1
		    IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
		    IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
		    IF (.NOT.NEWS_READ()) RETURN
		 END DO
	         IF (BUFFER(:2).NE.'22') THEN
		    IER = 0
		    END = START - 1
		    RETURN
	         END IF
	      END IF
	      IF (.NOT.NEWS_WRITE('HEAD')) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
              IER = OTS$CVT_TI_L(BUFFER(SB+4:
     &			INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
	      END = START + NUMDIR - 1
	   END IF
	   IER = 0
	END IF
 
	IF (IER.EQ.0) THEN
	   I = START
	   DO WHILE (IER.EQ.0.AND.I.LE.END)
	      IF (REMOTE_SET.EQ.1) THEN
	         READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY
	      ELSE IF (XHDR) THEN
		 CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
		 LTEMP = INDEX(TEMP,' ')
	         CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1))
		 CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM)
		 DESCRIP = TEMP(257:512)
		 CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768)))
	      ELSE
	         IER = OTS$CVT_TI_L(BUFFER(SB+4:
     &			INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1))
		 CALL NEWS_HEADER(IER)
		 IF (IER.NE.0) RETURN
	      END IF
	      CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)
	      I = I + 1
	      IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN
		 IER = 2
	         IF (.NOT.NEWS_WRITE('NEXT')) RETURN
		 IF (.NOT.NEWS_READ()) RETURN
	         IF (BUFFER(:3).NE.'223') THEN
		    END = I - 1
		    IER = 0
		    RETURN
		 END IF
	         IF (.NOT.NEWS_WRITE('HEAD')) RETURN
		 IF (.NOT.NEWS_READ()) RETURN
		 IER = 0
	      END IF
	   END DO
	END IF
 
	IF (REMOTE_SET.EQ.3) THEN
	   IER = 1
	   IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN
	   IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
           IF (.NOT.NEWS_READ()) RETURN
	   IER = 0
	END IF
 
	RETURN
	END
 
 
 
	INTEGER FUNCTION NEWS_LOGIN
 
	IMPLICIT INTEGER (A-Z)
 
	COMMON /NEWS_CONNECTED/ NEWS_CONNECTED
	LOGICAL NEWS_CONNECTED /.FALSE./
 
        COMMON /XHDR/ XHDR
        LOGICAL XHDR /.FALSE./
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
        IF (.NOT.NEWS_CONNECTED) THEN
	   NEWS_LOGIN = .FALSE.
	   CALL START_NEWS_TIMER()
           NEWS_CONNECTED = NEWS_CONNECT()
	   CALL CANCEL_NEWS_TIMER()
           IF (.NOT.NEWS_CONNECTED) RETURN
           IF (.NOT.NEWS_READ()) RETURN
           IF (.NOT.NEWS_WRITE('XHDR')) RETURN
           IF (.NOT.NEWS_READ()) RETURN
	   XHDR = BUFFER(:3).NE.'500'
	   CALL GET_GMT_DIFF()
	END IF
 
	NEWS_LOGIN = .TRUE.
 
	RETURN
	END
 
 
	SUBROUTINE GET_GMT_DIFF()
 
	IMPLICIT INTEGER (A-Z)
 
	COMMON /GMT/ GMT_DIFF,PAST
	DIMENSION GMT_DIFF(2)
 
	CHARACTER ZONE*3
 
	IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',ZONE)) THEN
	   IER = OTS$CVT_TI_L(ZONE(:TRIM(ZONE)),DIFF,,%VAL(1))
	   IF (DIFF.LT.0) THEN
	      PAST = .TRUE.
	      ZONE = ZONE(2:)
	   ELSE IF (DIFF.GT.12) THEN
	      PAST = .TRUE.
	      DIFF = 24 - DIFF
	      IER = OTS$CVT_L_TI(DIFF,ZONE(:2),,,)
	      IF (ZONE(:1).EQ.' ') ZONE = ZONE(2:)
	   ELSE
	      PAST = .FALSE.
	   END IF
	ELSE
	   ZONE = '00'
	END IF
 
	IER = SYS_BINTIM('0 '//ZONE(:TRIM(ZONE))//':00',GMT_DIFF)
 
	RETURN
	END
 
 
 
 
	SUBROUTINE START_NEWS_TIMER()
 
	IMPLICIT INTEGER (A-Z)
 
	INTEGER TIMADR(2)			! Buffer containing time
						! in desired system format.
	CHARACTER TIMBUF*13,SEC*2
	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,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
 
	EX_BTIM(1) = 0
	EX_BTIM(2) = 0
 
	DESCRIP = ' '
	FROM = ' '
 
	DO WHILE (BUFFER(SB:EB).NE.'.')
	   IER = NEWS_READ()
	   IF (.NOT.IER) RETURN
	   IF (BUFFER(SB:EB).NE.'.') THEN
	      IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN
		 SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8
		 DESCRIP = BUFFER(SB1:EB)
	      ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN
		 CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM)
	      ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN
		 CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM)
	      ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN
		 SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5
		 CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1)
	      END IF
	   END IF
	END DO
 
	IER = 0
 
	RETURN
	END
 
 
 
	INTEGER FUNCTION FIRST_ALPHA(INPUT)
 
	CHARACTER*(*) INPUT
 
	DO I=1,LEN(INPUT)
	   IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' '
	END DO
 
	DO FIRST_ALPHA=1,LEN(INPUT)
	   IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN
	END DO
 
	RETURN
	END
 
 
 
 
	SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER)
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLFOLDER.INC'
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
	CHARACTER*6 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('HEAD '//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*6 NUMBER
 
	IF (REMOTE_SET.EQ.1) THEN
	   WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2)
	   IF (IER.EQ.0) THEN
	      READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START
	   END IF
	ELSE IF (READIT.EQ.1) THEN
	   I = NEWS_FIND_SUBSCRIBE()
	   START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) + 
     &			LAST_NEWS_READ(2,I) + 1
	   IF (START.GT.F_NBULL) THEN
	      START = -1
	   ELSE
	      LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I))
     &			.OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)
	   END IF
	ELSE
	   START = -1
	   IER = SYS$ASCTIM(,TIME,IN_BTIM,)
	   CALL DATE_TIME(TIME)
	   SKIP = 0
	   DO WHILE (1)
	      IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM(
     &		  FOLDER_NAME))//' '//TIME)) RETURN
	      IF (.NOT.NEWS_READ()) RETURN
	      IF (BUFFER(:2).EQ.'23') THEN
 	         IF (.NOT.NEWS_READ()) CALL EXIT
		 DO I=1,SKIP
		    IF (.NOT.NEWS_READ()) CALL EXIT
		 END DO
		 FIRST = BUFFER(SB:EB)
		 IF (FIRST.EQ.'.') RETURN
		 DO WHILE (BUFFER(SB:EB).NE.'.')
		    IF (.NOT.NEWS_READ()) CALL EXIT
		 END DO
	         IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST))))
     &					  CALL EXIT
                 IF (.NOT.NEWS_READ()) CALL EXIT
	         IF (BUFFER(:2).EQ.'22') THEN
		    IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN
		       I = F_NBULL + 1
		       DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE.
     &			   BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))
     &			   .OR.I.GT.F_NBULL))
		          I = I - 1
			  IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN
			  IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
			  IF (.NOT.NEWS_READ()) RETURN
		       END DO
		       IF (I.GE.F_START) START = I
		    ELSE
		       IER = OTS$CVT_TI_L(BUFFER(SB+4:
     &		          INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
		    END IF
		    RETURN
		 END IF
	      END IF
	      SKIP = SKIP + 1
	   END DO
	END IF
 
	RETURN
	END
 
 
 
	SUBROUTINE REMOTE_COPY_BULL(IER)
 
	IMPLICIT INTEGER (A-Z)
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	IF (REMOTE_SET.EQ.1) THEN
	   WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2
	ELSE
	END IF
 
	RETURN
	END
 
 
 
	SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT)
 
	IMPLICIT INTEGER (A-Z)
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	CHARACTER*(*) OUTPUT
 
	IF (REMOTE_SET.EQ.1) THEN
	   WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT
	ELSE
	END IF
 
	RETURN
	END
 
 
 
 	SUBROUTINE GET_REMOTE_MESSAGE(IER)
C
C  SUBROUTINE GET_REMOTE_MESSAGE
C
C  FUNCTION:
C	Gets remote message.
C
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE '($RMSDEF)'
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1
	DATA SCRATCH_R1 /0/
 
	COMMON /REF/ REFERENCES,LREF
	CHARACTER*255 REFERENCES
 
	COMMON /NEWSGROUPS/ NEWSGROUPS
	CHARACTER*255 NEWSGROUPS
 
	CHARACTER*255 TEMP,FROM_LINE,SUBJECT_LINE
 
	CHARACTER*10 MSGNUM
 
	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
 
	IF (REMOTE_SET.EQ.3) THEN
	   MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4)
 
	   SUBJECT_LINE = ' '
	   FROM_LINE = ' '
	   NEWSGROUPS = ' '
	   LREF = 0
	   DO WHILE (BUFFER(SB:EB).NE.'.')
	      IER = NEWS_READ()
	      IF (.NOT.IER) RETURN
	      IF (BUFFER(SB:EB).NE.'.') THEN
	         IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GT.SB+5) THEN
		    SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5
		    FROM_LINE = 'From: '//BUFFER(SB1:EB)
	         ELSE IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.
     &						    EB.GT.SB+8) THEN
		    SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8
		    SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB)
	         ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND.
     &						    EB.GT.SB+11) THEN
		    SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11
		    NEWSGROUPS = BUFFER(SB1:EB)
	         ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND.
     &						    EB.GT.SB+11) THEN
		    IF (LREF.EQ.0) THEN
		       REFERENCES = BUFFER(SB+12:EB)
		    ELSE
		       REFERENCES = BUFFER(SB+12:EB)//' '//
     &				REFERENCES(:LREF)
	            END IF
		    LREF = TRIM(REFERENCES)
	         ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND.
     &						    EB.GT.SB+11) THEN
		    IF (LREF.EQ.0) THEN
		       REFERENCES = BUFFER(SB+12:EB)
		    ELSE
		       REFERENCES = REFERENCES(:LREF)//' '//
     &				BUFFER(SB+12:EB)
	            END IF
		    LREF = TRIM(REFERENCES)
	         END IF
	      END IF
	   END DO
 
	   LSUB = TRIM(SUBJECT_LINE)
	   LFRO = TRIM(FROM_LINE)
	END IF
 
	ILEN = 128
	IER = 0
	LENGTH = 0
	LTEMP = 0
 
	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
		    BUFFER = FROM_LINE
		    SB = 1
		    EB = LFRO
		    LFRO = 0
		    IER = 1
		 ELSE IF (LSUB.GT.0) THEN
		    BUFFER = SUBJECT_LINE
		    SB = 1
		    EB = LSUB
		    LSUB = 0
		    IER = 1
		 ELSE
		    IF (LSUB.EQ.0) THEN
		       IF (.NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN
		       IF (.NOT.NEWS_READ()) RETURN
		       IF (BUFFER(:2).NE.'22') THEN
			  IER = 0
			  RETURN
		       END IF
		       LSUB = -1
		    END IF
		    IER = NEWS_READ()
		 END IF
		 IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN
		    IER = 0
		    LTEMP = EB-SB+1
		    IF (LTEMP.GT.0) THEN
		       TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1)
		    ELSE
		       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
	      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
 
	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*1 SEPARATE
 
	COMMON /READIT/ READIT
 
	COMMON /NEWS_INIT/ END_READ
 
	INCLUDE 'BULLUSER.INC'
 
	INCLUDE 'BULLFOLDER.INC'
 
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE 'BULLFILES.INC'
 
	CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE
	CHARACTER*25 FOLDER_SAVE
 
	DIMENSION DUMMY(4)
 
	IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN
	   END_READ = 0
	   IF (.NOT.NEWS_LOGIN()) THEN
	      IER = 2
	      RETURN
	   END IF
	   CALL NEWS_GROUP(IER)
	   IF (IER.NE.0) RETURN
	   IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT)
	   RETURN
	END IF
 
	REMOTE_UNIT = 31 - REMOTE_UNIT
 
	SAME = .TRUE.
	LEN_BBOARD = TRIM(FOLDER1_BBOARD)
	IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN  ! Remote folder name 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:)
	   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*132 INCMD
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*255 MESSAGE_ID
 
	COMMON /NEXT/ NEXT
	LOGICAL NEXT /.FALSE./
 
	COMMON /NEWGROUP/ NEWGROUP
 
	CHARACTER*6 NUMBER
 
	CHARACTER 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') NEXT = .FALSE.
	         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,'<'):INDEX(BUFFER,'>'))
	   IER = 0
	   CALL NEWS_HEADER(IER)
	   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
 
	IER = NEWS_WRITE('GROUP '//
     &	                 FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1))
	IF (.NOT.IER) RETURN
 
	IER = NEWS_READ()
	IF (.NOT.IER) RETURN
 
	IF (BUFFER(:3).EQ.'411') RETURN
 
	NEWGROUP = .TRUE.
 
	BUFFER = BUFFER(5:)
 
	IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_END,,%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*20 TIME
 
	COMMON /GMT/ GMT_DIFF,PAST
	DIMENSION GMT_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) RETURN
 
	CALL SYS_BINTIM(TIME(:I-2),BTIM)
 
	IF (INDEX(INTIME,'GMT').GT.0) THEN
	   IF (PAST) THEN
	      IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM)
	   ELSE
	      IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM)
	   END IF
	END IF
 
	RETURN
        END
 
 
 
	SUBROUTINE NEWS_LIST
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLFOLDER.INC'
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
	CHARACTER*23 TODAY
 
	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 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_END = 1001
	   WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	END IF
	IF (NEWS_F1_END.LT.1001) NEWS_F1_END = 1001
	NEWS_F_END = NEWS_F1_END
	DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.')
	   FLEN = INDEX(BUFFER(SB:),' ') - 1
	   NEWS_FOLDER1 = BUFFER(SB:MIN(25,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
	   IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1))
	   SP = EP + 2
	   EP = INDEX(BUFFER(SP:),' ')+SP-2
	   IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1))
	   IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0
	   CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)
	   SP = EP + 1
	   IF (IER.NE.0.OR.IER1.NE.0) THEN
	      IF (FLEN.GT.25) THEN
	         NEWS_FOLDER1_DESCRIP = BUFFER(SB+25:FLEN+SB-1)//
     &					BUFFER(SP:EB)
	      ELSE
	         NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB)
	      END IF
	      IER = 0
	      DO WHILE (IER.EQ.0.AND.IER1.EQ.0)
		 DO WHILE (REC_LOCK(IER))
	            READ (7,KEY=NEWS_F_END,KEYID=1,IOSTAT=IER)
	         END DO
		 IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1
	      END DO
	      NEWS_FOLDER1_NUMBER = NEWS_F_END
	      CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)
	      WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	      IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1
	   ELSE
	      UPDATE = .FALSE.
	      IF (FLEN.GT.25) THEN
		 IF (NEWS_FOLDER1_DESCRIP.NE.
     &		     BUFFER(SB+25:FLEN+SB-1)//BUFFER(SP:EB)) THEN
	            NEWS_FOLDER1_DESCRIP =
     &			BUFFER(SB+25: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
	      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.NE.NEWS_F1_START.OR.
     &		          F1_NBULL.NE.NEWS_F1_NBULL
	      END IF
	      IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
	   END IF
	END DO
 
	CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)
	NEWS_F1_END = NEWS_F_END
	REWRITE (7) NEWS_FOLDER1_COM
 
	IF (SPECIAL) THEN
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)
	   DO WHILE (IER.EQ.0)
	      CALL READ_FOLDER_FILE_TEMP(IER)
	      IF (IER.EQ.0) THEN
		 NEWS_F1_NBULL = F1_NBULL
		 NEWS_F1_START = F1_START
	         CALL NEWS_GROUP(IER)
		 IF (IER.EQ.0) THEN
		    IF ((F1_START.NE.NEWS_F1_START.OR.
     &		        F1_NBULL.NE.NEWS_F1_NBULL)
     &			.AND.F1_START.GT.0) THEN
		       CALL SYS_BINTIM('-',F1_NEWEST_BTIM)
	               CALL REWRITE_FOLDER_FILE_TEMP
		    END IF
		 ELSE
		    DELETE (UNIT=7)
		    IER = 0
	         END IF
	      END IF
	   END DO
	END IF
 
	CALL CLOSE_BULLNEWS
 
	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 'BULLUSER.INC'
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
	COMMON /REF/ REFERENCES,LREF
	CHARACTER*255 REFERENCES
 
	COMMON /PATH/ PATHNAME,LPATH
	CHARACTER*132 PATHNAME
 
	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD
 
	COMMON /MSGID/ MESSAGE_ID
	CHARACTER*255 MESSAGE_ID
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	COMMON /NEWSGROUPS/ NEWSGROUPS
	CHARACTER*255 NEWSGROUPS
 
	COMMON /GMT/ GMT_DIFF,PAST
	DIMENSION GMT_DIFF(2)
 
	CHARACTER*(*) FILENAME,SUBJECT
 
	CHARACTER TODAY*23,MSGID*23,ZONE*5,GROUPS*255
 
	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
	   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
 
	IF (.NOT.NEWS_LOGIN()) GO TO 900
 
	IF (LPATH.EQ.0) CALL GET_PATHNAME
 
	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
 
	IF (REMOTE_SET.GE.3.OR.CREATE) THEN
	   IF (CREATE) THEN
	      GROUPS = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME))
	   ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN
	      GROUPS = 'Newsgroups: '//NEWSGROUPS
	   ELSE IF (REMOTE_SET.EQ.4) THEN
	      GROUPS = 'Newsgroups: '//FOLDER1_DESCRIP
	   ELSE
	      GROUPS = 'Newsgroups: '//FOLDER_NAME
	   END IF
	   IF (FILENAME.NE.'cancel'.AND..NOT.CREATE) THEN
	      IF (CLI$PRESENT('GROUPS')) THEN
		 CALL OPEN_BULLNEWS_SHARED
		 FLEN = 0
		 DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN)
     &			.AND.TRIM(GROUPS)+FLEN+1.LE.LEN(GROUPS))
		    CALL LOWERCASE(FOLDER1_NAME)
		    CALL READ_FOLDER_FILE_KEYNAME_TEMP
     &			(FOLDER1_NAME(:FLEN),IER1)
		    IF (IER1.EQ.0) GROUPS = GROUPS(:TRIM(GROUPS))//
     &			','//FOLDER1_NAME(:TRIM(FOLDER1_NAME))
		 END DO
		 CALL CLOSE_BULLNEWS
	      END IF
	   END IF
	   IF (.NOT.NEWS_WRITE(GROUPS(:TRIM(GROUPS)))) GO TO 900
	END IF
	ATSIGN = INDEX(PATHNAME,'@')
	PCSIGN = INDEX(PATHNAME,'%')
	CALL LOWERCASE(USERNAME)
	IF (PCSIGN.GT.0) THEN
	   IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'
     &	       //PATHNAME(PCSIGN+1:ATSIGN-1)//'!'
     &	       //USERNAME(:TRIM(USERNAME)))) GO TO 900
	ELSE
	   IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'
     &	       //USERNAME(:TRIM(USERNAME)))) GO TO 900
	END IF
	IF (.NOT.NEWS_WRITE('From: '//USERNAME(:TRIM(USERNAME))//
     &	   PATHNAME(:LPATH))) GO TO 900
	CALL STR$UPCASE(USERNAME,USERNAME)
	IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT))))
     &	   GO TO 900
 
	IF (INCMD(:2).EQ.'RE') THEN
	   IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF)))
     &	      GO TO 900
	END IF
 
	IF (LZONE.EQ.0) THEN
	   IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',ZONE)) THEN
	      ZONE = 'GMT'
	   ELSE IF (.NOT.SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE)
     &         .AND..NOT.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN
	      ZONE = 'GMT'
	   END IF
	   LZONE = TRIM(ZONE)
	END IF
 
	IER = SYS$GETTIM(NOW)
	IF (PAST) THEN
	   IER = LIB$ADDX(NOW,GMT_DIFF,NOW)
	ELSE
	   IER = LIB$SUBX(NOW,GMT_DIFF,NOW)
	END IF
	IER = SYS$ASCTIM(,TODAY,NOW,)
 
	MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'//
     &		TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23)
	IF (MSGID(1:1).EQ.' ') MSGID = MSGID(2:)
	IF (.NOT.NEWS_WRITE('Message-ID: <'//MSGID(:TRIM(MSGID))//
     &	    PATHNAME(:LPATH)//'>')) GO TO 900
 
	TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20)
	IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)
 
	IF (LORGAN.EQ.0) THEN
	   IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN
	      IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)
	   END IF
	   LORGAN = TRIM(ORGANIZATION)
	END IF
 
	IF (LORGAN.GT.0) THEN
	   IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))
     &		GO TO 900
	END IF
 
	IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//
     &		ZONE(:LZONE))) GO TO 900
 
	IF (CREATE) THEN
	   IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME))))
     &		 RETURN
	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_READ()) RETURN
	   IF (BUFFER(:3).EQ.'240') IER = 0
	   RETURN
	END IF
 
	IF (.NOT.NEWS_WRITE(' ')) GO TO 900
 
	IER1 = 0
	DO WHILE (IER1.EQ.0)
	   READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER
	   IF (BUFFER(:ILEN).EQ.'.') THEN
	      BUFFER = '..'
	      ILEN = 2
	   END IF
	   IF (IER1.EQ.0.AND..NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900
	END DO
 
	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:EB)
	END IF
 
900	IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3)
 
	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
	   IF (.NOT.SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME).AND.
     &	    .NOT.SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME).AND.
     &	    .NOT.SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME)) 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.
 
	DO I=1,LEN(NAME)
	   IF (NAME(I:I).NE.'.'.AND.
     &	       (NAME(I:I).LT.'a'.OR.NAME(I:I).GT.'z')) RETURN
	END DO
 
	TEST_NEWS = .TRUE.
 
	RETURN
	END
 
 
 
 
	SUBROUTINE NEWS2BULL
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLFOLDER.INC'
 
	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD
 
	COMMON /BUFFER/ BUFFER,SB,EB
	CHARACTER BUFFER*1280
 
	EXTERNAL BULLETIN_SUBCOMMANDS
 
	CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*25,BBOARD_SAVE*12
 
	CHARACTER*6 NUMBER
 
	DIMENSION NOW(2)
 
	IER = SYS$GETTIM(NOW)
 
	CALL ALLPRIV
 
	CALL NEWS_LIST
 
	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
	      SLIST = INDEX(FOLDER_DESCRIP,'<')
	      ELIST = INDEX(FOLDER_DESCRIP,'>')
	      IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN
		 IF (TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))) THEN
		    NUM_FOLDERS = NUM_FOLDERS + 1
	   	    CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
	         END IF
	      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_END = F_END
	      CALL OPEN_BULLNEWS_SHARED
	      FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP))
	      CALL READ_FOLDER_FILE_KEYNAME
     &		(FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER)
	      CALL CLOSE_BULLNEWS
	      IF (BBOARD_SAVE.EQ.'NONE') THEN
	         SAVE_END = F_NBULL
		 CALL OPEN_BULLFOLDER
	         CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1)
		 F_END = SAVE_END
	         CALL REWRITE_FOLDER_FILE
	         CALL CLOSE_BULLFOLDER
	      ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_END.AND.
     &		F_NBULL.GE.F_START) THEN
	         FOLDER_NUMBER = -1
	         CALL SELECT_FOLDER(.FALSE.,IER)
	         IF (IER) THEN
		    IF (SAVE_END.GT.F_NBULL) SAVE_END = F_START-1
		    SAVE_END = MAX(F_START-1,SAVE_END)
	            CALL OTS$CVT_L_TI(SAVE_END+1,NUMBER,,,)
	            INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM(
     &			FOLDER_SAVE))//' '//NUMBER//'-LAST'
		    SAVE_END = 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_END = SAVE_END
		       CALL COPY2(F_NEWEST_BTIM,NOW)
	               CALL REWRITE_FOLDER_FILE
		    END IF
		    CALL CLOSE_BULLFOLDER
	         END IF
	      END IF
	   END IF
	END DO
 
	CALL EXIT
	END
 
 
 
	SUBROUTINE DATE_TIME(TIME)
 
	IMPLICIT INTEGER (A-Z)
 
	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_END,KEYID=1)
	   IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1
        END DO
 
        NEWS_FOLDER1_NUMBER = NEWS_F_END
	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_END = NEWS_F_END
	REWRITE (7) NEWS_FOLDER1_COM
 
	RETURN
	END
 
 
 
	SUBROUTINE SUBSCRIBE
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLUSER.INC'
 
	INCLUDE 'BULLFOLDER.INC'
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	IF (REMOTE_SET.NE.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
 
	LAST_NEWS_READ2(1,I) = NEWS_FOLDER_NUMBER
	IF (F_START.LE.F_NBULL) THEN
	   LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-(F_START-1))
	   LAST_NEWS_READ(2,I) = F_START - 1
	ELSE
	   LAST_NEWS_READ2(2,I) = 0
	   LAST_NEWS_READ(2,I) = F_NBULL
	END IF
 
	RETURN
	END
 
 
 
 
 
	SUBROUTINE UNSUBSCRIBE
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLUSER.INC'
 
	INCLUDE 'BULLFOLDER.INC'
 
	I = NEWS_FIND_SUBSCRIBE()
 
	IF (I.GT.FOLDER_MAX-1) THEN
	   WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')')
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))
	   RETURN
	ELSE
	   WRITE (6,'('' You are now no longer subscribed to '',A,''.'')')
     &			FOLDER_NAME(:TRIM(FOLDER_NAME))
	END IF
 
	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)
 
	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 (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) 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.F_NBULL.AND.F_START.LE.F_NBULL)) THEN
	   LAST_NEWS_READ(2,I) = NUMBER
	   LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)
     &			.OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)
	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 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)
	IF (MSGNUM.EQ.0) RETURN
 
	CALL OPEN_BULLNEWS_SHARED
	SUBNUM = 1
 
	DO WHILE (SUBNUM.GT.0)
	   IER = 1
	   DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)
	      CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)
	      IF (SUBNUM.NE.0) THEN
	         CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)
		 IF (IER.EQ.0.AND.
     &			MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN
		    CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-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
		     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
 
	CALL CLOSE_BULLNEWS
 
	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 = 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 = BTEST(LAST_NEWS_READ2(2,I),15)
 
	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
 
 
 
 
	SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF)
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLUSER.INC'
 
	I = NEWS_FIND_SUBSCRIBE()
 
	IF (I.GT.FOLDER_MAX-1) THEN
	   WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')')
	   RETURN
	END IF
 
	IF (NOTIFY.EQ.1) THEN
	   WRITE (6,'('' ERROR: NOTIFY cannot be set for news folder.'')')
	   RETURN
	END IF
 
	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)
	
	RETURN
	END
