From:	SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:52:51.90
To:	EVERHART
CC:	
Subj:	BULLETIN6.FOR

Date: Fri, 19 Aug 1994 17:25:51 -0400 (EDT)
From: BULLETIN@PFC.MIT.EDU
To:   EVERHART@arisia.gce.com
Message-Id: <940819172551.21438991@PFC.MIT.EDU>
Subject: BULLETIN6.FOR

C
C  BULLETIN6.FOR, Version 8/10/94
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
	SUBROUTINE CLOSE_FILE
C
C  SUBROUTINE CLOSE_FILE
C
C  FUNCTION: To close out the bulletin files and enable CTRL-C & -Y
C

        IMPLICIT INTEGER (A-Z)

	COMMON /BULLFIL/ BULLFIL
	DATA BULLFIL /0/

	DATA LUN /0/

	ENTRY CLOSE_BULLINF
	LUN = LUN + 1			! Unit = 9

	ENTRY CLOSE_SYSUAF
	LUN = LUN + 1			! Unit = 8

	ENTRY CLOSE_BULLNEWS
	ENTRY CLOSE_BULLFOLDER
	LUN = LUN + 3			! Unit = 7

	ENTRY CLOSE_BULLUSER
	LUN = LUN + 2			! Unit = 4

	ENTRY CLOSE_BULLDIR
	LUN = LUN + 1			! Unit = 2

	ENTRY CLOSE_BULLFIL
	LUN = LUN + 1			! Unit = 1

	CALL ENABLE_CTRL

	CLOSE (UNIT=LUN)

        IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL

	LUN = 0

	RETURN
	END


	SUBROUTINE CLOSE_FILE_DELETE

	IMPLICIT INTEGER (A-Z)

        COMMON /BULLFIL/ BULLFIL

	DATA LUN /0/

	ENTRY CLOSE_BULLDIR_DELETE
	LUN = LUN + 1			! Unit = 2

	ENTRY CLOSE_BULLFIL_DELETE
	LUN = LUN + 1			! Unit = 1

	CALL ENABLE_CTRL

	CLOSE (UNIT=LUN,STATUS='DELETE')

        IF (LUN.EQ.1.AND.BULLFIL.GT.0) BULLFIL = -BULLFIL

	LUN = 0

	RETURN
	END


	SUBROUTINE OPEN_FILE(UNIT)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE '($FORIOSDEF)'

	INCLUDE '($PRVDEF)'

	INCLUDE '($RMSDEF)'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /DIR_POSITION/ DIR_NUM

        COMMON /NEWS_OPEN/ NEWS_OPEN

        COMMON /BULLFIL/ BULLFIL

	COMMON /NEWSLIST/ NEWSLIST

	DATA LUN /0/

	LUN = UNIT - 14			! 14 gets added to LUN

	ENTRY OPEN_BULLNEWS
	LUN = LUN + 5			! Unit = 14

	ENTRY OPEN_BULLINF
	LUN = LUN + 1			! Unit = 9

	ENTRY OPEN_SYSUAF
	LUN = LUN + 1			! Unit = 8

	ENTRY OPEN_BULLFOLDER
	LUN = LUN + 3			! Unit = 7

	ENTRY OPEN_BULLUSER
	LUN = LUN + 2			! Unit = 4

	ENTRY OPEN_BULLDIR
	LUN = LUN + 1			! Unit = 2

	ENTRY OPEN_BULLFIL
	LUN = LUN + 1			! Unit = 1

	IER = 0

	NTRIES = 0

	CALL SET_PROTECTION

	CALL DISABLE_CTRL		! No breaks while file is open

	IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))

	    OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE,
     &	      STATUS='OLD',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,
     &	      KEY=(13:20:CHARACTER,
     &	      1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER,
     &	      85:96:CHARACTER),ACCESS='KEYED')

	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
	       OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE,
     &	        STATUS='NEW',FORM='UNFORMATTED',SHARED,
     &	        RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4,
     &	        ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP',
     &	        KEY=(13:20:CHARACTER,
     &	        1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER,
     &	        85:96:CHARACTER),ACCESS='KEYED')
	    END IF
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	   DIR_NUM = -1
	ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))

	    OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')

	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
	       OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	        //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
     &	        RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
     &	        ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP',
     &	        KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
	    ELSE IF (IER.EQ.0) THEN
	       INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)
	       IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN
	          CLOSE (UNIT=2)
	          IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	          CALL CONVERT_BULLFILES
		  NTRIES = 0
	       END IF
	    ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLDIRS
	       NTRIES = 0
	    END IF
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	   DIR_NUM = -1
	END IF

	IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    IF (REMOTE_SET.EQ.4) THEN
	      IF (BULLFIL.NE.1) CALL SET_BULLFIL
	      OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,SHARED,
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED')
	      IF (IER.EQ.0) THEN
	         DO WHILE (REC_LOCK(IER2))
                    READ (1'1,IOSTAT=IER2) NBLOCK
	         END DO
                 IF (IER2.NE.0) THEN
                    NBLOCK = 1
                    WRITE (1'1,IOSTAT=IER2) NBLOCK
		 END IF
                 BULLFIL = 1
              END IF
            ELSE
	      OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED')
            END IF
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILE
	       NTRIES = 0
            ELSE IF (IER.EQ.FOR$IOS_OPEFAI) THEN
	       CALL ERRSNS(IDUMMY,IER1)
               IF (IER1.EQ.RMS$_DNF) THEN
	          IER1 =  LIB$CREATE_DIR(
     &				FOLDER_FILE(:INDEX(FOLDER_FILE,']')))
	          IF (IER1) IDUMMY = FILE_LOCK(IER,IER1)
	       END IF
	    END IF
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	END IF

	IF (LUN.EQ.4) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4,
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:12:CHARACTER))
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
	     OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',
     &	      ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
     &	      FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	      KEY=(1:12:CHARACTER))
	     WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM,
     &	      BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR.
     &	      PRV$M_SETPRV,(0,I=1,FLONG*4-1)
	     CLOSE (UNIT=4)
	     IDUMMY = FILE_LOCK(IER,IER1)
	    ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	     IDUMMY = FILE_LOCK(IER,IER1)
	     CALL CONVERT_USERFILE
	     NTRIES = 0
	    END IF
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	END IF

	IF (LUN.EQ.7) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',
     &	     RECORDSIZE=FOLDER_RECORD/4,
     &	     ORGANIZATION='INDEXED',IOSTAT=IER)
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
	      FOLDER1 = 'GENERAL'
	      FOLDER1_OWNER = 'SYSTEM'
	      FOLDER1_DESCRIP = 'Default general bulletin folder.'
	      FOLDER1_BBOARD = 'NONE'
	      FOLDER1_BBEXPIRE = 14
	      NBULL = 0
	      OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',R
     &	        RECORDSIZE=FOLDER_RECORD,
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,o
     &	        KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER))
              CALL SYS_BINTIM('5-NOV-1982 00:00:00.00',R
     &				NEWS_F_NEWEST_BTIM) 
              CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER1_CREATED_DATE)
	      WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2)
     &		FOLDER1,0,FOLDER1_CREATED_DATE,FOLDER1_OWNER,FOLDER1_DESCRIP
     &		,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB
     &		,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM,0,0,0
						! 4 means system folders
	      CLOSE (UNIT=7)n
	      IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	    ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	      IDUMMY = FILE_LOCK(IER,IER1) 
	      CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE)L
	      NTRIES = 0 
	    END IF 
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	   IF (IER.EQ.0) NEWS_OPEN = .FALSE.E
	END IFE

	IF (LUN.EQ.14) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
            IF (NEWSLIST) THEN
	       OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',L
     &	        RECORDSIZE=NEWS_FOLDER_RECORD/4,R
     &	        BUFFERCOUNT=127, 
     &	        ORGANIZATION='INDEXED',IOSTAT=IER)
	    ELSE0
	       OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',I
     &	        RECORDSIZE=NEWS_FOLDER_RECORD/4,D
     &	        ORGANIZATION='INDEXED',IOSTAT=IER)C
            END IF
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THENN
	      OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',
     &	        RECORDSIZE=NEWS_FOLDER_RECORD, 
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,N
     &	        KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER,C
     &          57:64:CHARACTER:DESCENDING))
	      CLOSE (UNIT=7)'
	      IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop_
	    ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	      IDUMMY = FILE_LOCK(IER,IER1) 
	      CALL CONVERT_BULLNEWS(BULLNEWS_FILE)W
	      NTRIES = 0
	    END IF
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	   IF (IER.EQ.0) NEWS_OPEN = .TRUE.
	END IFN

	IF (LUN.EQ.9) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN',+
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3,
     &	     IOSTAT=IER,ORGANIZATION='INDEXED',
     &	     KEY=(1:12:CHARACTER))L
	     IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_INFFILE
	       NTRIES = 0
	     END IF
	     NTRIES = 0
	     IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)W
	   END DO
	END IF 

	IF (IER.NE.0) THENN
	   WRITE (6,'( 
     &	    '' Cannot open file in OPEN_FILE, unit = '',I)') LUN
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)R
	   IF (IER1.EQ.0) THENY
	      WRITE (6,'('' IOSTAT error = '',I)') IER2
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	   CALL ENABLE_CTRL_EXIT	! Enable CTRL-Y & -C & EXITN
	END IFE

	LUN = 0

	CALL RESET_PROTECTION

	RETURN
	END



	SUBROUTINE TIMER_ERR(UNIT)T

	IMPLICIT INTEGER (A-Z) 

	CHARACTER*14 NAMES(6)
	DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT',
     &			'BULLINF.DAT','BULLNEWS.DAT'/
	INTEGER NAME(14)R
	DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/:

	IF (TEST_BULLCP().NE.2) THEN	! If BULLCP process, don't log error
	   WRITE(6,'('' ERROR: Unable to open '',A,
     &	    	     '' file after 30 secs.'')')
     &			NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT))))
	   WRITE (6,'('' Please try again later.'')')
	END IF

	CALL ENABLE_CTRL_EXIT		! No breaks while file is open
	END



	SUBROUTINE OPEN_FILE_SHARED

	IMPLICIT INTEGER (A-Z) 

	INCLUDE '($FORIOSDEF)'D

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'D

	INCLUDE 'BULLUSER.INC' 

	INCLUDE 'BULLDIR.INC'

	COMMON /POINT/ BULL_POINT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /DIR_POSITION/ DIR_NUM

        COMMON /NEWS_OPEN/ NEWS_OPEN

        COMMON /BULLFIL/ BULLFIL

	EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT
CI
C  The following 2 files were used prior to V1.1.O
CI
	CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/Y
	CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/S

	COMMON /NEWSLIST/ NEWSLISTN
	DATA NEWSLIST/0/S

	CHARACTER*44 SAVE_FOLDERS
	DATA SAVE_BLOCK/-1/

	CHARACTER*14 NAMES(6)
	DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT',
     &			'BULLINF.DAT','BULLNEWS.DAT'/
	INTEGER NAME(14)
	DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/ 

	DATA LUN /0/S

	ENTRY OPEN_BULLNEWS_SHAREDY
	LUN = LUN + 5			! Unit = 14

	ENTRY OPEN_BULLINF_SHARED
	LUN = LUN + 1			! Unit = 9 

	ENTRY OPEN_SYSUAF_SHARED
	LUN = LUN + 1			! Unit = 8 

	ENTRY OPEN_BULLFOLDER_SHAREDR
	LUN = LUN + 3			! Unit = 7U

	ENTRY OPEN_BULLUSER_SHARED.
	LUN = LUN + 2			! Unit = 4

	ENTRY OPEN_BULLDIR_SHARED
	LUN = LUN + 1			! Unit = 24

	ENTRY OPEN_BULLFIL_SHARED
	LUN = LUN + 1			! Unit = 1O

	IER = 0

	NTRIES = 0E

	CALL DISABLE_CTRL

	IF (LUN.EQ.2.AND.REMOTE_SET.EQ.4) THENI
	   DO WHILE (FILE_LOCK(IER,IER1))

	    OPEN (UNIT=2,FILE=BULLNEWSDIR_FILE,
     &	      STATUS='OLD',FORM='UNFORMATTED', 
     &	      RECORDTYPE='FIXED',RECORDSIZE=NEWSDIR_RECORD_LENGTH/4, 
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,
     &	      KEY=(13:20:CHARACTER,
     &	      1:8:CHARACTER,9:20:CHARACTER,21:84:CHARACTER,
     &	      85:96:CHARACTER),ACCESS='KEYED') 
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	   DIR_NUM = -1
	ELSE IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))

	    OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,I
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')O
	    IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0 
     &		.OR.FOLDER.EQ.'GENERAL')) THEN
	       IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')L
	       IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR')
	       IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop
	    ELSE IF (IER.EQ.0) THEN
	       INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)
	       IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENI
	          CLOSE (UNIT=2)U
	          IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loopG
	          CALL CONVERT_BULLFILESE
		  NTRIES = 0
	       END IF
	    ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLDIRSD
	       NTRIES = 0
	    END IF8
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	   DIR_NUM = -1
	END IF)

	IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR.
     &		SAVE_FOLDER.NE.FOLDER)) THEN
	   CALL REMOTE_READ_MESSAGE(BULL_POINT,IER)
	   IF (IER.GT.0) THEN
	      CALL ERROR_AND_EXIT
	   ELSE
	      SAVE_BLOCK = BLOCKF
	      SAVE_FOLDER = FOLDERH
	      CALL GET_REMOTE_MESSAGE(IER))
	      IER = 0
	   END IF
	ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN
	   SAVE_BLOCK = -1I
	   IF (REMOTE_SET.EQ.4.AND.BULLFIL.NE.2) CALL SET_BULLFIL
	   DO WHILE (FILE_LOCK(IER,IER1))
	     OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))_
     &	      //'.BULLFIL',STATUS='OLD',E
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY)I
	    IF (REMOTE_SET.EQ.4) THEN
	      IF (IER.EQ.0) THEN
	         DO WHILE (REC_LOCK(IER2)) 
                    READ (1'1,IOSTAT=IER2) NBLOCKe
	         END DO
                 IF (IER2.NE.0) NBLOCK = 1
                 BULLFIL = 2
              END IF
            END IF
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN,
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILEI
	       NTRIES = 0
	    END IF 
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	END IFI

	IF (LUN.EQ.4) THEN0
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4,
     &	    IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
     &	    KEY=(1:12:CHARACTER))
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THENN
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_USERFILE	
	       NTRIES = 0
	    END IFC
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	END IFS

	IF (LUN.EQ.7) THENC
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     &	    RECORDSIZE=FOLDER_RECORD/4,
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',.
     &	    IOSTAT=IER,ORGANIZATION='INDEXED',SHARED)

	    IF (IER.EQ.FOR$IOS_INCRECLEN) THENL
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE)
	       NTRIES = 0
	    END IFL
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	   IF (IER.EQ.0) NEWS_OPEN = .FALSE. 
	END IF 

	IF (LUN.EQ.14) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
            IF (NEWSLIST) THEN
	       OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD', 
     &	       ACCESS='KEYED',RECORDTYPE='FIXED',
     &	       BUFFERCOUNT=127,
     &	       RECORDSIZE=NEWS_FOLDER_RECORD/4,
     &	       IOSTAT=IER,ORGANIZATION='INDEXED',SHARED)O
	    ELSE)
	       OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',U
     &	       ACCESS='KEYED',RECORDTYPE='FIXED',
     &	       RECORDSIZE=NEWS_FOLDER_RECORD/4,
     &	       IOSTAT=IER,ORGANIZATION='INDEXED',SHARED)'
            END IF

	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN8
	      IDUMMY = FILE_LOCK(IER,IER1) 
	      CALL CONVERT_BULLNEWS(BULLNEWS_FILE)O
	      NTRIES = 0 
	    END IFE
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	   IF (IER.EQ.0) NEWS_OPEN = .TRUE.
	END IF 

	IF (LUN.EQ.8) THENU
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT',
     &       ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,IOSTAT=IER,SHARED,C
     &	     USEROPEN=LNM_MODE_EXEC)B
	   END DO
	END IFN

	IF (LUN.EQ.9) THENC
	   DO WHILE (FILE_LOCK(IER,IER1))
	     OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD',
     &	      ACCESS='KEYED',RECORDTYPE='FIXED',E
     &	      RECORDSIZE=FOLDER_MAX*2+3, 
     &	      IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
     &	      KEY=(1:12:CHARACTER))
	     IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_INFFILE
	       NTRIES = 0
	     END IF
	     NTRIES = NTRIES + 1i
	     IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXITE
	   END DO
	END IFI

	IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN
	   CALL OPEN_FILE(LUN)'
	ELSE IF (IER.NE.0) THEN
	   WRITE(6,'('' ERROR: Cannot open '',A)')L
     &			NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN))))
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
		WRITE(6,'(1X,A)') FOLDER_FILE(:TRIM(FOLDER_FILE)) 
			WRITE(6,'(1X,A)')USERNAME
	   IF (IER1.EQ.0) THENT
	      WRITE (6,'('' IOSTAT error = '',I)') IERL
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	   CALL ENABLE_CTRL_EXIT 
	END IF0

	LUN = 0

	RETURN:
	END


	SUBROUTINE RESET_PROTECTION

	IMPLICIT INTEGER (A-Z)r

	DATA PROT_LEVEL /0/

	PROT_LEVEL = PROT_LEVEL - 1
	IF (PROT_LEVEL.GT.0) RETURN

	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection 

	RETURN'

	ENTRY SET_PROTECTIONr

	PROT_LEVEL = PROT_LEVEL + 1
	IF (PROT_LEVEL.GT.1) RETURN

	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)L
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)

	RETURNC
	END




	SUBROUTINE FOLDER_TO_NEWS

	IMPLICIT INTEGER (A-Z)S

	INCLUDE 'BULLFOLDER.INC'.

	NEWS_FOLDER = FOLDERU
	NEWS_FOLDER_NUMBER = FOLDER_NUMBERE
	NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP(
     &			       MIN(45,INDEX(FOLDER_DESCRIP,' ')):)N
	NEWS_F_NBULL = F_NBULLI
	NEWS_F_COUNT = F_COUNTN
	NEWS_F_START = F_STARTX
	NEWS_F_LAST = F_LASTg
	NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)A
	NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)A
	NEWS_F_FLAG = FOLDER_FLAG
	NEWS_F_EXPIRE = FOLDER_BBEXPIRE
 	NEWS_F_EXPIRE_LIMIT = F_EXPIRE_LIMIT

	RETURN

	ENTRY FOLDER1_TO_NEWS

	NEWS_FOLDER1 = FOLDER1
	NEWS_FOLDER1_NUMBER = FOLDER1_NUMBERr
	NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(
     &			       MIN(45,INDEX(FOLDER1_DESCRIP,' ')):)
	NEWS_F1_NBULL = F1_NBULL1
	NEWS_F1_COUNT = F1_COUNT 
	NEWS_F1_START = F1_STARTY
	NEWS_F1_LAST = F1_LASTL
	NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)L
	NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)E
	NEWS_F1_FLAG = FOLDER1_FLAG
	NEWS_F1_EXPIRE = FOLDER1_BBEXPIRE
	NEWS_F1_EXPIRE_LIMIT = F1_EXPIRE_LIMIT!

	RETURN

	ENTRY NEWS_TO_FOLDERA

	FOLDER = NEWS_FOLDERU
	FOLDER_NUMBER = NEWS_FOLDER_NUMBERD
	FOLDER_DESCRIP = NEWS_FOLDER(:MAX(1,TRIM(NEWS_FOLDER)))
     &			 //NEWS_FOLDER_DESCRIP
	FOLDER_BBOARD = '::' 
	F_NBULL = NEWS_F_NBULL
	F_COUNT = NEWS_F_COUNTE
	F_START = NEWS_F_STARTW
	F_LAST = NEWS_F_LAST1
	F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1)L
	F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2)T
	FOLDER_FLAG = NEWS_F_FLAG
	IF (BTEST(FOLDER_FLAG,8)) FOLDER_BBOARD = 'NONE' 
	FOLDER_BBEXPIRE = NEWS_F_EXPIRE
	F_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT3

	RETURNE

	ENTRY NEWS_TO_FOLDER1

	FOLDER1 = NEWS_FOLDER1H
	FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER,
	FOLDER1_DESCRIP = NEWS_FOLDER1(:MAX(1,TRIM(NEWS_FOLDER1)))T
     &			 //NEWS_FOLDER1_DESCRIP
	FOLDER1_BBOARD = '::'
	F1_COUNT = NEWS_F1_COUNTE
	F1_NBULL = NEWS_F1_NBULLE
	F1_START = NEWS_F1_START 
	F1_LAST = NEWS_F1_LASTE
	F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1)B
	F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2) 
	FOLDER1_FLAG = NEWS_F1_FLAG
	IF (BTEST(FOLDER1_FLAG,8)) FOLDER1_BBOARD = 'NONE'T
	FOLDER1_BBEXPIRE = NEWS_F1_EXPIRE
	F1_EXPIRE_LIMIT = NEWS_F1_EXPIRE_LIMITR

	RETURNE

	END




	SUBROUTINE CONVERT_BULLDIRS

	IMPLICIT INTEGER (A-Z)&

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'N

	INCLUDE 'BULLFILES.INC'

	CHARACTER BUFFER*116E

	WRITE (6,'('' Converting data files to new format. Please wait.'')')D

	CALL SET_PROTECTION

	OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',ACCESS='DIRECT',
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',
     &	      IOSTAT=IER)

	IF (IER.NE.0) GO TO 900	! No BULLDIR file found.	

	READ (2'1,IOSTAT=IER1) BUFFER(:115)

	CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL)

	OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, 
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',A
     &	      INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 )

	IF (IER.NE.0) THEN0
	   OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))V
     &	      //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,U
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')(
	END IF(

	IF (IER1.NE.0) GO TO 8001

	CALL SYS_BINTIM(BUFFER(:11)//' '//BUFFER(12:19),NEWEST_EXBTIM)T
	CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM)
	BULLDIR_HEADER(29:40) = BUFFER(39:)
	CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM) 
	BULLDIR_HEADER(49:52) = BUFFER(70:)
	IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER

	ICOUNT = 2)
	DO WHILE (IER.EQ.0)
	   READ (2'ICOUNT,IOSTAT=IER) BUFFER(:115)=
	   IF (IER.EQ.0) THEN
	      MSG_NUM = ICOUNT - 1F
	      DESCRIP = BUFFER(:)
	      FROM = BUFFER(54:))
	      BULLDIR_ENTRY(81:84) = BUFFER(85:))
	      BULLDIR_ENTRY(93:100) = BUFFER(108:)L
	      CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM)T
	      CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM)
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      WRITE (9,IOSTAT=IER) BULLDIR_ENTRY=
	      ICOUNT = ICOUNT + 1
	   END IF
	END DOC

800	CLOSE (UNIT=9,DISPOSE='KEEP')S
	CLOSE (UNIT=2) 

900	CALL RESET_PROTECTIONI

	RETURN'

	END



	SUBROUTINE CONVERT_BULLFILES 
CI
C  SUBROUTINE CONVERT_BULLFILESN
C 
C  FUNCTION: Converts bulletin files to new format file.
C	Add expiration time to directory file, add extra byte to bulletin
C	file to show where each bulletin starts (for redunancy sake in
C	case crash occurs).C
C 

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'D

	INCLUDE 'BULLFILES.INC'

	CHARACTER*81 BUFFER

	WRITE (6,'('' Converting data files to new format. Please wait.'')')N

	OPEN (UNIT=9,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='OLD',I
     &	      RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',T
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',)
     &	      SHARED,READONLY,IOSTAT=IER)

	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?

	OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) 
     &	      //'.BULLFIL',STATUS='OLD',N
     &	      RECORDTYPE='FIXED',RECORDSIZE=80,
     &	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)F

	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?

	CALL SET_PROTECTION

	OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='NEW',IOSTAT=IER,
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81,
     &	      FORM='FORMATTED')

	OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,O
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP',
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')C

	NEWEST_EXTIME = '00:00:00.00'
	READ (9'1,1000,IOSTAT=IER) 
     &		NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8),
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)S
	NEMPTY = 0D
	IF (IER.EQ.0) CALL WRITEDIR(0,IER1)

	EXTIME = '00:00:00.00'=
	ICOUNT = 2 
	DO WHILE (IER.EQ.0)
	   READ(9'ICOUNT,1010,IOSTAT=IER)
     &		DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCKL
	   IF (IER.EQ.0) THEN
	      READ(10,'(A)') BUFFER
	      WRITE(1,'(A)') BUFFER(:80)//CHAR(1)
	      DO I=2,LENGTH
	         READ(10,'(A)') BUFFER
	         WRITE(1,'(A)') BUFFERX
	      END DO 
	      CALL WRITEDIR(ICOUNT-1,IER1)'
	      ICOUNT = ICOUNT + 1
	   END IF
	END DO 

	CLOSE (UNIT=9)S
	CLOSE (UNIT=2)
	CLOSE (UNIT=10)
	CLOSE (UNIT=1))

	CALL RESET_PROTECTION
	RETURN 

1000	FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)=
1010	FORMAT(A53,A12,A11,A8,A4,A11,A4,A4)

	END

	SUBROUTINE CONVERT_BULLFILE
CL
C  SUBROUTINE CONVERT_BULLFILE
C 
C  FUNCTION: Converts bulletin data file to new format file.
CL
C  NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length.
C	 This converts from 81 byte length to 128 compressed format.
C 

	IMPLICIT INTEGER (A-Z)S

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'O

	INCLUDE 'BULLFILES.INC'

	CHARACTER*80 BUFFER,NEW_FILE)

	WRITE (6,'('' Converting data files to new format. Please wait.'')') 

	CALL CLOSE_BULLDIR

	CALL SET_PROTECTION

	CALL OPEN_BULLFOLDER

100	READ (7,FMT=FOLDER_FMT,ERR=200)O
     &		FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB

	FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER(:TRIM(FOLDER))'
	NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD'
	OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'E
     &	      ,STATUS='OLD',t
     &	      RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT',
     &	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)

	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?

	OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &	   //'.BULLFIL',STATUS='NEW',IOSTAT=IER,D
     &	   ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,_
     &	   FORM='UNFORMATTED') 
	IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))
     &		//'.BULLFIL;-1',NEW_FILE)E

	CALL OPEN_BULLDIR

	CALL READDIR(0,IER)

	IF (IER.EQ.1) THENX
	 NBLOCK = 0
	 DO I=1,NBULL
	   CALL READDIR(I,IER)E
	   NBLOCK = NBLOCK + 1T
	   SBLOCK = NBLOCK
	   DO J=BLOCK,LENGTH+BLOCK-1_
	      READ(10'J,'(A)') BUFFER
	      ILEN = TRIM(BUFFER)
	      IF (ILEN.EQ.0) ILEN = 1
	      CALL STORE_BULL(ILEN,BUFFER,NBLOCK)
	   END DO
	   CALL FLUSH_BULL(NBLOCK)_
	   LENGTH = NBLOCK - SBLOCK + 1
	   BLOCK = SBLOCK
	   CALL WRITEDIR(I,IER)
	 END DO

	 NEMPTY = 0
	 CALL WRITEDIR(0,IER)
	END IFW

	CLOSE (UNIT=10)
	CLOSE (UNIT=1)_

	CALL CLOSE_BULLDIR 
	GOTO 100X

200	CALL OPEN_BULLDIR_SHARED

	CALL RESET_PROTECTION

	RETURNN

	END



	SUBROUTINE CONVERT_BULLFOLDER(FILENAME)
CN
C  SUBROUTINE CONVERT_BULLFOLDER
C 
C  FUNCTION: Converts bulletin folder file to new format.L
C_
	IMPLICIT INTEGER (A-Z)=

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'N

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($SSDEF)'1

	INCLUDE '($FORIOSDEF)'F

	CHARACTER*(*) FILENAME_

	CHARACTER NEW_FILE*80,OLD_FOLDER*25

	WRITE (6,'('' Converting '',A,'' to new format. Please wait.'')')
     &			FILENAME(:TRIM(FILENAME))

	CALL SET_PROTECTION

	EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))
	SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1L
	NEW_FILE = FILENAME(:SUFFIX)//'OLD'

	DO WHILE (FILE_LOCK(IER,IER1))T
	   OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED', 
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	END DOB

	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?

	INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)

	OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',I
     &	        RECORDSIZE=FOLDER_RECORD,
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER),
     &		DISPOSE='DELETE')I

	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?

	IF (ASK_SIZE.EQ.184.OR.ASK_SIZE.EQ.173) THENI
	 F_NUMBER = 0
	 DO WHILE (IER.EQ.0))
	   IF (ASK_SIZE.EQ.184) THENT
	      READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)',F
     &			KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)T
     &		OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
     &	        ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET
	      CALL COPY2(F_NEWEST_NOSYS_BTIM,F_NEWEST_BTIM)
	   ELSE IF (ASK_SIZE.EQ.173) THEN
	      READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,7A4)',C
     &			KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)4
     &		OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPE
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
     &	        ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET
     &	        ,F_NEWEST_NOSYS_BTIME
	   END IF
	   IF (IER.EQ.0) THEN
	      FOLDER = OLD_FOLDER
	      CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM) 
              CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE) 
	      IF (NEWS_FEED()) THEN T
		 CALL LIB$MOVC3(4,%REF(FOLDER_BBOARD(7:)),F_LAST)G
	      ELSET
	         F_LAST = 0
	      END IF 
	      WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)F
     &	        FOLDER,F_NUMBER,FOLDER_CREATED_DATE
     &		,FOLDER_OWNER,FOLDER_DESCRIP
     &	        ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBY
     &	        ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET
     &		,F_NEWEST_NOSYS_BTIM,0,0,F_LASTI
	      F_NUMBER = F_NUMBER + 1
	   END IF
	 END DO
	ELSE
	 F_NUMBER = 0
	 DO WHILE (IER.EQ.0)T
	   READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)',
     &			KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)R
     &		OLD_FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPR
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
	   IF (IER.EQ.0) THEN
	      FOLDER_FLAG = 0
	      IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
	      FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//OLD_FOLDER(:TRIM(OLD_FOLDER))T
	      CALL CHKACL
     &		(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)L
	      IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN
		 FOLDER_FLAG = IBSET(FOLDER_FLAG,0)
	      END IFO
	      DO WHILE (FILE_LOCK(IER,IER1))V
	       OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE)) 
     &	         //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',e
     &	         RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
     &	         ORGANIZATION='INDEXED',IOSTAT=IER,
     &	         KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
	        IF (IER.EQ.FOR$IOS_INCFILORG) THEN
	          IDUMMY = FILE_LOCK(IER,IER1)n
	          CALL CONVERT_BULLDIRS
		END IF
	      END DOE
	      IF (IER.EQ.FOR$IOS_FILNOTFOU) THENE
		 F_NEWEST_BTIM(1) = 0D
		 F_NEWEST_BTIM(2) = 0&
	      ELSET
	         CALL READDIR(0,IER)S
	         IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN
		    IF (NBULL.GT.0) THEN
		       CALL READDIR(NBULL,IER)
		       NEWEST_DATE = DATE.
		       NEWEST_TIME = TIMEo
		       CALL WRITEDIR(0,IER)=
		    END IF
	         END IF
	         CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)
	         CLOSE (UNIT=2)
	      END IFR
	      FOLDER = OLD_FOLDER
              CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM)
              CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,FOLDER_CREATED_DATE)I
              WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)
     &          FOLDER,F_NUMBER,FOLDER_CREATED_DATE,
     &	       ,FOLDER_OWNER,FOLDER_DESCRIP
     &	        ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB 
     &	        ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM,0,0,0=
	      F_NUMBER = F_NUMBER + 1
	   END IF
	 END DO
	END IFT

	CLOSE (UNIT=7)T
	CLOSE (UNIT=19,STATUS='SAVE')

	IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)E
	IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE),

	CALL RESET_PROTECTION

	IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY))
     &		//'BOARD.COM;*')	! BULLETIN$ is referenced in old file

	RETURND
	END



	SUBROUTINE CONVERT_BULLNEWS(FILENAME)
CD
C  SUBROUTINE CONVERT_BULLNEWS
CN
C  FUNCTION: Converts bulletin NEWS file to new format.N
C,
	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($SSDEF)',

	INCLUDE '($FORIOSDEF)'(

	CHARACTER*(*) FILENAMET

	CHARACTER NEW_FILE*80,OLD_FOLDER*25,OLD_DESCRIP*55R

	WRITE (6,'('' Converting '',A,'' to new format. ''F
     &		,''This will take a while.'')') FILENAME(:TRIM(FILENAME))

	CALL SET_PROTECTION

	EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']')),
	SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 14
	NEW_FILE = FILENAME(:SUFFIX)//'OLD'

	DO WHILE (FILE_LOCK(IER,IER1))U
	   OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD',
     &	        RECORDTYPE='FIXED',ACCESS='KEYED',L
     &	        ORGANIZATION='INDEXED',IOSTAT=IER, 
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	END DO

	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?

	OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',E
     &	        RECORDSIZE=NEWS_FOLDER_RECORD/4,INITIALSIZE=600,
     &	        ORGANIZATION='INDEXED',IOSTAT=IER,C
     &	        KEY=(1:44:CHARACTER,45:48:INTEGER,49:56:CHARACTER,&
     &		57:64:CHARACTER:DESCENDING),DISPOSE='DELETE') 

	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?

	NEWS_FOLDER_NUMBER = 0_
        CALL SYS_BINTIM('5-NOV-1982',NEWS_F_NEWEST_BTIM)
        CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_CREATED_DATE)L
        CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEWS_F_NEWEST_BTIM)
        CALL GET_MSGKEY(NEWS_F_NEWEST_BTIM,NEWS_F_EXPIRED_DATE)E
	NEWS_F_LAST = 0
	NEWS_F_FLAG = 0
	NEWS_F_EXPIRE = 7
	NEWS_F_FIRST = 0E
	NEWS_F_END = 0I
	NEWS_F_EXPIRE_LIMIT = 0
	READ (7,KEY=1000,KEYID=1,IOSTAT=IER) INPUT(:108)_
	DO WHILE (IER.EQ.0)
	      OLD_FOLDER = INPUT(:25)
	      CALL LIB$MOVC3(4,%REF(INPUT(26:)),NEWS_FOLDER_NUMBER)
	      OLD_DESCRIP = INPUT(30:)O
	      CALL LIB$MOVC3(4,%REF(INPUT(87:)),NEWS_F_START)
              CALL LIB$MOVC3(4,%REF(INPUT(91:)),NEWS_F_COUNT) 
              CALL LIB$MOVC3(4,%REF(INPUT(97:)),NEWS_F_NBULL) 
              CALL LIB$MOVC3(8,%REF(INPUT(101:)),NEWS_F_NEWEST_BTIM)
	      LMOVE = INDEX(OLD_DESCRIP,' ')-1B
	      IF (LMOVE.LE.0) THENR
	         NEWS_FOLDER = OLD_FOLDER
	         NEWS_FOLDER_DESCRIP = OLD_DESCRIP1
	      ELSE 
	         NEWS_FOLDER = OLD_FOLDER//OLD_DESCRIP(:MIN(19,LMOVE))B
	         NEWS_FOLDER_DESCRIP = OLD_DESCRIP(MIN(20,LMOVE+1):) 
	      END IF(
  	      WRITE (19,IOSTAT=IER) NEWS_FOLDER_COM  
	      READ (7,IOSTAT=IER) INPUT(:108)
	 END DO

	CLOSE (UNIT=7)_
	CLOSE (UNIT=19,STATUS='SAVE')

	IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)N
	IER = LIB$RENAME_FILE(BULLNEWS_FILE//';-1',NEW_FILE)D

	CALL RESET_PROTECTION

	RETURNR
	END



	SUBROUTINE CONVERT_USERFILE
Ct
C  SUBROUTINE CONVERT_USERFILE
C
C  FUNCTION: Converts user file to new format which has 8 bytes added.
CI

	IMPLICIT INTEGER (A-Z).

	INCLUDE '($PRVDEF)'

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLUSER.INC'N

	CHARACTER BUFFER*74,NEW_FILE*80

	CHARACTER*12 LOGIN_DATE,READ_DATE
	CHARACTER*8 LOGIN_TIME,READ_TIME'

	WRITE (6,'('' Converting data files to new format. Please wait.'')')R

	EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))I
	SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1
	NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'I
	IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE)

	OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',E
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',
     &	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,R
     &	     KEY=(1:12:CHARACTER))I
	INQUIRE (UNIT=9,RECORDSIZE=RECL)o

	IF ((RECL-28)/16.GT.FLONG) THEN
	   WRITE (6,'('' ERROR: Old data files have more folders'',
     &		      '' than was specified with BULLUSER.INC.'')') 
	   WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')D
	   IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) 
	   IF (USERNAME.EQ.'DECNET') THEN
	      CALL SYS$DELPRC(,)I
	   ELSE
	      CALL ENABLE_CTRLC
	      CALL SYS$CANEXH()
	      CALL EXIT
	   END IF
	END IF_

	IF (IER.EQ.0) THEN_
	   CALL SET_PROTECTIONE
	   OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',A
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
     &	    FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	    KEY=(1:12:CHARACTER))
	END IFE

	IF (IER.NE.0) THEN,
	   WRITE (6,'('' Cannot convert user file.'')')
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)E
	   CALL SYS_GETMSG(IER1))
	   CALL RESET_PROTECTION1
	   CALL ENABLE_CTRL_EXITT
	END IF,

	DO I=1,FLONG8
	   NEW_FLAG(I) = 'FFFFFFFF'XE
	   NOTIFY_FLAG(I) = 0
	   BRIEF_FLAG(I) = 0M
	   SET_FLAG(I) = 0E
	END DOE

	IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR. 
     &		RECL.EQ.74) THEN		! Old format
	   IF (RECL.LE.58) RECL = 50 
	   IER = 0N
	   DO WHILE (IER.EQ.0) 
	      READ (9,'(A<RECL>)',IOSTAT=IER) BUFFERR
	      IF (IER.EQ.0) THEN-
		TEMP_USER = BUFFER(:12)M
	        LOGIN_DATE = BUFFER(13:23)S
	        LOGIN_TIME = BUFFER(24:31)
	        READ_DATE = BUFFER(32:42)
	        READ_TIME = BUFFER(43:50)
	        IF (RECL.EQ.58)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))T
	        IF (RECL.EQ.66)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))	
	        IF (RECL.EQ.74)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1))
	        CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM)
	        CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)E
	        WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,B
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	    END IFA
	   END DO
	   IF (RECL.LT.66) THEN
	     READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER,
     &		LOGIN_BTIM,F
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	     NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV
	     WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	   END IF
	ELSE					! Folder maxmimum increase
	   OFLONG = (RECL - 28) / 16		! Old  #longwords/flagI
	   DO WHILE (IER.EQ.0)S
	    READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) 
     &	     TEMP_USER,LOGIN_BTIM,READ_BTIM, 
     &	     (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG),
     &	     (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG)
	    IF (IER.EQ.0) THEN'
	     WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	    END IF 
	   END DO
	END IF1

	IER = 0

	CLOSE (UNIT=9)=
	CLOSE (UNIT=4) 

	CALL RESET_PROTECTION

	RETURN
	END


	SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT)
CL
C  SUBROUTINE READDIRN
CF
C  FUNCTION: Finds the entry for the specified bulletin in the
C	directory file and returns the information for that entry.
C 
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1.-
C			 If 0, gives header info, i.e number of bulls,
C			 number of blocks in bulletin file, etc.
C  OUTPUTS: 
C	ICOUNT  -  The last record read by this routine.
C

	IMPLICIT INTEGER (A - Z)F

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'M

	COMMON /PROMPT/ COMMAND_PROMPTU
	CHARACTER*40 COMMAND_PROMPT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /DIR_POSITION/ DIR_NUM

	COMMON /NEXT/ NEXTT

	COMMON /KEEPLOCK/ KEEPLOCKE
	DATA KEEPLOCK/.FALSE./ 

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*256 INCMD

	COMMON /BULLFIL/ BULLFILC

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMR

	CHARACTER*4 CFOLDER_NUMBERR

	CHARACTER*8 NEWS_KEYS

	ICOUNT = BULLETIN_NUM

	IF (ICOUNT.EQ.0) THEN
	   IF (.NOT.REMOTE_SET) THENI
	      DO WHILE (REC_LOCK(IER))B
		IF (REMOTE_SET.EQ.4) THEN
		   IER = 0
		ELSE
	           READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER
		END IF
	      END DOI
	      IF (IER.EQ.0) THENL
		 CALL CONVERT_HEADER_FROMBIN
		 IF (REMOTE_SET.EQ.4) THEN
		    DIR_NUM = -1
		 ELSET
	            DIR_NUM = 0
		 END IF	
	      END IF)
	   ELSE
	      CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)
	      RETURNR
	   END IF
	   IF (IER.EQ.0.AND..NOT.REMOTE_SET.EQ.4) THEN
	      IF (NBULL.LT.0) THEN	! This indicates bulletin deletion
					! was incomplete.
		 CALL CLOSE_BULLDIR'
		 CALL OPEN_BULLDIR
		 CALL CLEANUP_DIRFILE(1)
		 CALL UPDATE_FOLDER$
	      END IFC
	      IF (NEMPTY.EQ.'    '.AND.
     &		  FOLDER_BBOARD(:2).NE.'::') NEMPTY = 0E
C5
C  Check to see if cleanup of empty file space is necessary, which isF
C  defined here as being 50 blocks (200 128byte records).  Also check
C  to see if cleanup was in progress but didn't properly finish.
CM
	      IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN 
		 WRITE (CFOLDER_NUMBER,'(I4)') FOLDER_NUMBER
	         IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(:INDEX(
     &		  COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER,
     &		  'NL:','NL:',1,'BULL_CLEANUP')D
	      ELSE IF (NEMPTY.EQ.-1) THEN
		 CALL CLEANUP_BULLFILE
	      END IFD
	   END IF
	ELSE)
	   IF (.NOT.REMOTE_SET) THEN 
	      DO WHILE (REC_LOCK(IER))I
		 IF (REMOTE_SET.EQ.4) THEN
		    IF (NEXT) THEN
		       IF (DIR_NUM.EQ.ICOUNT-1) THEN
	                  READ(2,IOSTAT=IER) NEWSDIR_ENTRY 
	               ELSE
	                  READ(2,KEYGE=NEWS_KEY(ICOUNT,FOLDER_NUMBER)
     &			    ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYE
	               END IF
		    ELSE
		       IF (ICOUNT.LT.F_START) ICOUNT = F_START
		       IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL
	               IF (DIR_NUM.EQ.ICOUNT-1) THENG
			  READ(2,IOSTAT=IER) NEWSDIR_ENTRYA
                       ELSEB
	                  READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER)
     &			    ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRYA
		       END IFT
		       IF (INCMD(:4).EQ.'BACK') THEN
		          DO WHILE (IER.NE.0.AND.ICOUNT.GT.F_START)E
	                     ICOUNT = ICOUNT - 1T
			     READ(2,KEY=NEWS_KEY(ICOUNT,FOLDER_NUMBER)D
     &		                     ,KEYID=1,IOSTAT=IER) NEWSDIR_ENTRY 
                          END DO
		       END IF
		    END IF
		    IF (IER.EQ.0) THEN
		       NUM = GET_INTEGER(%REF(NEWS_MSG_KEY))
		       IF (NUM.NE.FOLDER_NUMBER) THEN 
			  IER = 36V
			  UNLOCK 2(
		       ELSEU
			  MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:)))
			  IF (MSG_NUM.GT.F_NBULL) THEN 
			     IER = 36 P
			     UNLOCK 2
                          ELSE IF (ICOUNT.LE.F_START.AND. 
     &				 MSG_NUM.GT.F_START) THENC
			     INQUIRE (UNIT=7,OPENED=IER1)
			     IF (.NOT.IER1) CALL OPEN_BULLNEWS_SHARED
			     IDUMMY = REC_LOCK(IER)
			     CALL READ_FOLDER_FILE_KEYNAMED
     &							(FOLDER,IER2)
			     F_START = MSG_NUM
		             CALL REWRITE_FOLDER_FILE(IER2)O
			     IF (.NOT.IER1) CALL CLOSE_BULLNEWS
			     IDUMMY = REC_LOCK(IER)
	                  END IFR
		       END IFE
		       IF (IER.EQ.0.AND.MSG_NUM.NE.BULLETIN_NUM) THENN
			  ICOUNT = MSG_NUM
			  BULLETIN_NUM = ICOUNT
		       END IFT
		    END IF
		 ELSE
                    IF (DIR_NUM.EQ.ICOUNT-1) THENc
	               READ(2,IOSTAT=IER) BULLDIR_ENTRY
		       IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN
			  REWRITE (2) BULLDIR_ENTRY(:65)//'   '//
     &					BULLDIR_ENTRY(66:97)C
	                  READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) E
     &					BULLDIR_ENTRY
		       END IFf
		       IF (MSG_NUM.NE.ICOUNT) THEN
		          IER = 36
		          UNLOCK 2 E
		       END IF]
		    ELSE
	               READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) 
     &					BULLDIR_ENTRY
		       IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN
			  REWRITE (2) BULLDIR_ENTRY(:65)//'   '//
     &					BULLDIR_ENTRY(66:97)S
	                  READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) O
     &					BULLDIR_ENTRY
		       END IF 
		    END IF
		 END IFI
	      END DOT
	      IF (IER.EQ.0) THEN 
	      	 CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
		 CALL CONVERT_ENTRY_FROMBINm
		 DIR_NUM = MSG_NUM
	         IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFIL
	      ELSEp
		 DIR_NUM = -1F
	      END IFD
	   ELSE
	      CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)
	   END IF
	END IFN

	IF (IER.EQ.0) THENC
	   IF (.NOT.REMOTE_SET) THENB
	      ICOUNT = ICOUNT + 1
	      IF (.NOT.KEEPLOCK) UNLOCK 2
	   END IF
	   IF (ICOUNT.GT.1.AND.BTEST(BULL_USER_CUSTOM,1)) THENN
	      IF (BTEST(BULL_USER_CUSTOM,3)) THEN
	         IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) ICOUNT = ICOUNT - 1,
	      END IFR
       	   END IFI
	END IFN

	RETURNA

	END



	CHARACTER*8 FUNCTION NEWS_KEY(ICOUNT,FOLDER_NUMBER)

	IMPLICIT INTEGER (A-Z)a

	CHARACTER*4 INTEGER_KEY

	NEWS_KEY = INTEGER_KEY(FOLDER_NUMBER)//INTEGER_KEY(ICOUNT)T

	RETURN
	END



	INTEGER FUNCTION GET_INTEGER(NUM)

        IMPLICIT INTEGER (A-Z)

	CHARACTER*4 CTEMP,INTEGER_KEY

	CTEMP = INTEGER_KEY(NUM)R

	CALL LIB$MOVC3(4,%REF(CTEMP),GET_INTEGER)

	RETURNR
	END



	CHARACTER*4 FUNCTION INTEGER_KEY(NUM)

	IMPLICIT INTEGER (A-Z)H

	INTEGER TEMP
	CHARACTER*4 CTEMP
	EQUIVALENCE (CTEMP,TEMP) 

	TEMP = NUM.

	DO I=4,1,-1
	   INTEGER_KEY(I:I) = CTEMP(5-I:5-I)
	END DO 

	RETURNT
	END


	SUBROUTINE READDIR_KEYGE(IER)
CG
C  SUBROUTINE READDIR_KEYGE 
C 
C  FUNCTION: Finds the entry for the specified bulletin in the
C	directory file corresponding to or later than the date specified.&
C 
C  INPUTS:
C	MSG_KEY	- Message key (passed via BULLDIR.INC common block).
C  OUTPUTS:L
C	IER  -  If 0, no entry found.  Else contains message number.
C7

	IMPLICIT INTEGER (A - Z)8

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'I

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /DIR_POSITION/ DIR_NUM

	COMMON /KEYID/ NEWS_KEYID
	DATA NEWS_KEYID/2/R

	COMMON /KEEPLOCK/ KEEPLOCK 

	COMMON /BULLFIL/ BULLFILF

	COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOMN

	CHARACTER*4 INTEGER_KEY

10	IF (.NOT.REMOTE_SET) THEN
	   DO WHILE (REC_LOCK(IER))
	      IF (REMOTE_SET.EQ.4) THEN
	         IF (NEWS_KEYID.NE.4.OR.MSG_NUM.EQ.0) THEN 
		    READ(2,KEYGT=INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY
     &		      ,KEYID=NEWS_KEYID,IOSTAT=IER) NEWSDIR_ENTRY 
                 ELSES
		    READ(2,IOSTAT=IER) NEWSDIR_ENTRY
	         END IF
 	         IF (IER.EQ.0) THENO
		    NUM = GET_INTEGER(%REF(NEWS_MSG_KEY))I
	            IF (NUM.NE.FOLDER_NUMBER) THEN 
		       IER = 36)
		       UNLOCK 2 
		    ELSE
		       MSG_NUM = GET_INTEGER(%REF(NEWS_MSG_KEY(5:)))
		       IF (MSG_NUM.GT.F_NBULL) THEN 
			   IF (NEWS_KEYID.EQ.4.AND.MSG_NUM.NE.0) THEN )
			     IF (MSG_NUM.GT.NEWS_F_END) THEN 
				IDUMMY = REC_LOCK(IER)
			     END IF
	                   ELSE
		             IER = 36G
			     UNLOCK 2
			   END IF
	               END IF
		    END IF
	         END IF
	      ELSE
	         READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER)
     &					BULLDIR_ENTRY
		 IF (IER.EQ.0.AND.BLOCK.EQ.0) THEN
		    REWRITE (2) BULLDIR_ENTRY(:65)//'   '//i
     &					BULLDIR_ENTRY(66:97)i
	            READ(2,KEYID=0,KEY=MSG_NUM,IOSTAT=IER) 
     &					BULLDIR_ENTRY
		 END IF 
	      END IF 
	   END DO
	   IF (IER.EQ.0) THEN
	      IER = MSG_NUM
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      CALL CONVERT_ENTRY_FROMBINT
	      DIR_NUM = MSG_NUM
	      IF (.NOT.KEEPLOCK) UNLOCK 2
	      IF (REMOTE_SET.EQ.4.AND.BULLFIL.GT.0) CALL SET_BULLFILM
	   ELSE
	      IER = 0
	      DIR_NUM = -1R
	   END IF
	ELSE
	   CALL REMOTE_GET_HEADER(DUMMY,-1,IER)
 	END IF

	IF (IER.GT.0.AND.BTEST(BULL_USER_CUSTOM,1)) THENT
	   IF (BTEST(BULL_USER_CUSTOM,3)) THENE
	      IF (.NOT.INCLUDE_MSG(FROM,DESCRIP)) GO TO 10A
	   END IF
       	END IF

	RETURNU

	END



	SUBROUTINE CONVERT_HEADER_FROMBIN

	IMPLICIT INTEGER (A-Z)R

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'N

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*24 DATETIME

	IF (REMOTE_SET.EQ.4) THEN
 	   CALL COPY2(NEWEST_MSGBTIM,NEWS_F_NEWEST_BTIM)
	   CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))
           NBULL = F_NBULL
	   NEMPTY = 0
	END IF_

	CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,)

	NEWEST_EXDATE = DATETIME(:11)
	NEWEST_EXTIME = DATETIME(13:23)

	CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)T

	NEWEST_DATE = DATETIME(:11)
	NEWEST_TIME = DATETIME(13:23)

	CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,)

	SHUTDOWN_DATE = DATETIME(:11)
	SHUTDOWN_TIME = DATETIME(13:23)

	RETURNc
	END



	SUBROUTINE CONVERT_ENTRY_FROMBINB

	IMPLICIT INTEGER (A-Z)F

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /POST/ POSTTIMER

	CHARACTER*24 DATETIME

	IF (REMOTE_SET.EQ.4) THEN
 	   CALL GET_MSGKEY(%REF(NEWS_MSG_BTIM_KEY(5:)),%DESCR(MSG_BTIM))
 	   CALL GET_MSGKEY(%REF(NEWS_EX_BTIM_KEY(5:)),%DESCR(EX_BTIM))
	   IF (POSTTIME) CALL COPY2(MSG_BTIM,NEWS_POST_BTIM)
           DESCRIP = NEWS_DESCRIPU
           FROM = NEWS_FROM  F
           BLOCK = NEWS_BLOCKB
	   LENGTH = NEWS_LENGTH
	   SYSTEM = 0
	END IF:

	ENTRY CONVERT_ENTRY_FROMBIN_FOLDER 

	CALL SYS$ASCTIM(,DATETIME,EX_BTIM,)

	EXDATE = DATETIME(:11)U
	EXTIME = DATETIME(13:23)Y

	CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,) 

	DATE = DATETIME(:11)
	TIME = DATETIME(13:23)T

	RETURN 
	END





	SUBROUTINE WRITEDIR(BULLETIN_NUM,IER)
C 
C  SUBROUTINE WRITEDIR
C
C  FUNCTION: Writes the entry for the specified bulletin in the,
C	directory file._
CR
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1.Y
C			 If 0, write the header of the directory file.
C  OUTPUTS:_
C	IER - Error status from WRITE.
C 

	IMPLICIT INTEGER (A - Z)F

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'L

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /DIR_POSITION/ DIR_NUM

	CHARACTER*8 NEWS_KEY 

	CONV = .TRUE.

	GO TO 10 

	ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER)

	CONV = .FALSE.&
	 
10	IF (BULLETIN_NUM.EQ.0) THEN
	   IF (CONV) CALL CONVERT_HEADER_TOBINC
	   IF (REMOTE_SET) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER 
	   ELSE
	      IER = -1 
	      IF (DIR_NUM.EQ.0) THENE
		 IF (REMOTE_SET.EQ.4) THEN
                    IER = 0I
		 ELSET
	            REWRITE (2,IOSTAT=IER) BULLDIR_HEADER
		 END IF 
	      END IF 
	      IF (IER.NE.0) THEN 
		 IF (REMOTE_SET.EQ.4) THEN
		    IER = 0G
		 ELSE	
		    READ (2,KEYID=0,KEY=0,IOSTAT=IER)	
		    IF (IER.EQ.0) THEN (
	               REWRITE (2,IOSTAT=IER) BULLDIR_HEADERM
		    END IF
		 END IFG
	      END IF)
	      IF (IER.NE.0) THEN
		 IF (REMOTE_SET.NE.4) THEN
	            WRITE (2,IOSTAT=IER) BULLDIR_HEADER
		 END IFG
	      END IF)
	   END IF
	ELSEU
	   MSG_NUM = BULLETIN_NUM
	   IF (CONV) CALL CONVERT_ENTRY_TOBIN
	   IF (REMOTE_SET) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,
     &							BULLDIR_ENTRY
	   ELSE
	      IER = -1 
	      IF (DIR_NUM.EQ.MSG_NUM) THEN2
		 IF (REMOTE_SET.EQ.4) THEN
	            REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY 
		 ELSE 
	            REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYE
		 END IF_
	      END IF_
	      IF (IER.NE.0) THENS
		 IF (REMOTE_SET.EQ.4) THEN
		    DO WHILE (REC_LOCK(IER).AND.
     &			BULLETIN_NUM.NE.NEWS_F_END+1)
	               READ (2,KEYID=1,KEY=NEWS_KEY(I
     &			     BULLETIN_NUM,FOLDER_NUMBER),IOSTAT=IER)C
		    END DO		
		 ELSEE
	            READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER)6
		 END IF 
		 IF (REMOTE_SET.EQ.4.AND.,
     &			BULLETIN_NUM.EQ.NEWS_F_END+1) THENE
                    CALL SPECIAL_NEWSDIR_ENTRY(IER)T
	         ELSE IF (IER.EQ.0) THEN 
		    IF (REMOTE_SET.EQ.4) THEN]
	               REWRITE (2,IOSTAT=IER) NEWSDIR_ENTRY
		    ELSE
	               REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY
		    END IF
	         ELSE
		    IF (REMOTE_SET.EQ.4) THEN/
	               WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY
		    ELSE
	               WRITE (2,IOSTAT=IER) BULLDIR_ENTRY
		    END IF
		 END IF	
	      END IFE
	   END IF
	END IFT

	IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITY

	DIR_NUM = -1)

	RETURNO

	END



        SUBROUTINE SPECIAL_NEWSDIR_ENTRY(IER)O

        IMPLICIT INTEGER (A-Z)

        INCLUDE 'BULLDIR.INC'R

        INCLUDE 'BULLFOLDER.INC'

	INCLUDE '($RMSDEF)'

	DIMENSION BTIM(2)

	CHARACTER*8 NEWS_KEYE

        READ (2,KEYID=3,KEY=NEWS_MSGID,IOSTAT=IER) INPUT(:84) 
	DO WHILE (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).NE.FOLDER_NUMBER)
           READ (2,IOSTAT=IER) INPUT(:84) 
	   IF (NEWS_MSGID.NE.INPUT(21:84)) IER = 2R
 	END DO

	IF (IER.EQ.0.AND.GET_INTEGER(%REF(INPUT)).EQ.FOLDER_NUMBER) THEN   
	   IER = 2D
	   RETURN
	END IFI

10	IER1 = 0
	DO WHILE (REC_LOCK(IER1))
	   READ (2,KEYID=1,KEYGT=NEWS_KEY(NEWS_F_END,FOLDER_NUMBER),N
     &			IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH) 
	END DO		E
	DO WHILE (IER1.EQ.0)E
	   FNUM = GET_INTEGER(%REF(INPUT))
	   IF (FNUM.NE.FOLDER_NUMBER) THEN
	      IER1 = 2T
	   ELSE
	      CALL GET_MSGKEY(%REF(INPUT(85:)),%DESCR(BTIM))G
	      IF (COMPARE_BTIM(BTIM,NEWEST_EXBTIM).LT.0.AND.E
     &		  .NOT.BTEST(FOLDER_FLAG,13)) THEN
	         CALL COPY2(NEWEST_EXBTIM,BTIM)
	      END IFT
	      F_COUNT = F_COUNT + 1
	      NEWS_F_END = GET_INTEGER(%REF(INPUT(5:)))
	      DO WHILE (REC_LOCK(IER1))
	         READ (2,IOSTAT=IER1) INPUT(:NEWSDIR_RECORD_LENGTH)
	      END DO		)
	   END IF
	END DOE

	IF (MSG_NUM.NE.NEWS_F_END+1) THEN
	   MSG_NUM = NEWS_F_END + 1
	   CALL CONVERT_ENTRY_TOBIN
	END IFn
	WRITE (2,IOSTAT=IER) NEWSDIR_ENTRY  d

	IF (IER.NE.0) THENS
	   CALL ERRSNS(IDUMMY,IER1)
           IF (IER1.EQ.RMS$_DUP) GO TO 10
	ELSE-
	   F_COUNT = F_COUNT + 1s
	END IF	

	RETURNm
	END



	SUBROUTINE CONVERT_HEADER_TOBIN

	IMPLICIT INTEGER (A-Z)U

        INCLUDE 'BULLFOLDER.INC' T

	INCLUDE 'BULLDIR.INC'

        COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNITD

	CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)

	CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM)

	CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)

	IF (REMOTE_SET.EQ.4) THEN
 	   CALL COPY2(NEWS_F_NEWEST_BTIM,NEWEST_MSGBTIM)
           CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE)K
	END IF_

	RETURNG
	END



	SUBROUTINE CONVERT_ENTRY_TOBINI

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

        COMMON /LOCALPOST/ LOCAL_POST)

	CHARACTER*4 INTEGER_KEY

	CHARACTER*8 NEWS_KEY	

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

        IF (REMOTE_SET.EQ.4) THENS
	   CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)_
        END IF
  
	CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM)

	IF (LOCAL_POST) THENN
	   CALL COPY2(NEWS_POST_BTIM,MSG_BTIM)E
	END IF 

	IF (REMOTE_SET.EQ.4) THEN
           NEWS_DESCRIP = DESCRIP 
           NEWS_FROM = FROM 
           NEWS_BLOCK = BLOCK 
           NEWS_LENGTH = LENGTH
	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)Y
	   NEWS_MSG_KEY = NEWS_KEY(MSG_NUM,FOLDER_NUMBER)
	   NEWS_MSG_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY)
	   CALL GET_MSGKEY(EX_BTIM,MSG_KEY)
	   NEWS_EX_BTIM_KEY = INTEGER_KEY(FOLDER_NUMBER)//MSG_KEY
	ELSE&
	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)E
	END IF 

	RETURN 
	END



	SUBROUTINE READ_FIRST_EXPIRED(NDEL)

	IMPLICIT INTEGER (A-Z)S

        INCLUDE 'BULLDIR.INC'_

        INCLUDE 'BULLFOLDER.INC'
  
        COMMON /KEYID/ NEWS_KEYID 

	COMMON /KEEPLOCK/ KEEPLOCKF
 G
	EX_BTIM(1) = 0L
	EX_BTIM(2) = 0	
	MSG_NUM = 0

	ENTRY READ_NEXT_EXPIRED(NDEL) 	

	NEWS_KEYID = 4T
	KEEPLOCK = .TRUE.
      	CALL GET_MSGKEY(EX_BTIM,MSG_KEY)S
	CALL READDIR_KEYGE(NDEL)T
	KEEPLOCK = .FALSE.U
	NEWS_KEYID = 2E

	RETURNI
	END



	SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH)
C 
C  SUBROUTINE READACL
CD
C  FUNCTION: Reads the ACL of a file.B
C
C  PARAMETERS:
C	FILENAME - Name of file to check.
C	ACLENT - String which will be large enough to hold ACL information.T
CN
	IMPLICIT INTEGER (A-Z)I

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($ACLDEF)'

	CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*256,FILENAME*(*)N

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT))
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist

	IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)S

	BIG = .NOT.IERS
	IF (BIG) THEN
	   IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,)
	   ACLLENGTH = ACL$S_ADDACLENTE
	   CTXT = 0
	END IFU

	DO ACC_TYPE=1,2
	 POINT = 1D
	 OUTLEN = 0
	 DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)O
	   IF (.NOT.BIG) THEN
	      IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+I
     &		ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,)
	   ELSE
	      CALL INIT_ITMLST	! Initialize item list
	      CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT))
	      CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
	      IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST)B
     &				,,,CTXT,,)
	      IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(:1))),S
     &				ACLLEN,ACLSTR,,,,)
	      CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS)
	      IF (ACCESS.EQ.0) IER = .FALSE.O
	   END IF
	   AC = INDEX(ACLSTR,',ACCESS')
	   IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR.
     &	       (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND.
     &	        INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THENO
	      START_ID = INDEX(ACLSTR,'=') + 1S
	      END_ID = INDEX(ACLSTR,',ACCESS') - 1h
	      IF (ACLSTR(END_ID:END_ID).EQ.']') THENi
		 START_ID = END_ID - 1
		 ASCII = .FALSE.
		 DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND.
     &			   ACLSTR(START_ID:START_ID).NE.'='.AND._
     &			   (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))-
		    IF (ACLSTR(START_ID:START_ID).NE.','.AND.O
     &			(ACLSTR(START_ID:START_ID).LT.'0'.OR.
     &			 ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.8
		    IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN
		       START_ID = START_ID - 1
	 	    END IF0
		 END DOI
		 IF (ASCII) THEN
		    START_ID = START_ID + 1_
		    END_ID = END_ID - 1 
		    IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN
		       START_ID = INDEX(ACLSTR,'=') + 1-
	               END_ID = INDEX(ACLSTR,'ACCESS') - 2.
		    END IF
		 END IF 
	      END IF
	      IF (OUTLEN.EQ.0) THEN
		IF (FILENAME.NE.BULLUSER_FILE) THENI
	         IF (ACC_TYPE.EQ.1) THENN
		    WRITE (6,'(R
     &		    '' These users can read and write to this folder:'')')
	         ELSE
		    WRITE (6,'(.
     &		    '' These users can only read this folder:'')')
	         END IF
		ELSE
		 WRITE (6,'('' The following are rights identifiers'',
     &			'' which will give privileges.'')')
		END IF
		OUTLEN = 1
	      END IFG
	      IDLEN = END_ID - START_ID + 1
	      IF (OUTLEN+IDLEN-1.GT.80) THENV
		 WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)E
		 OUTPUT = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = IDLEN + 2_
	      ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN
		 WRITE (6,'(1X,A)') 
     &			OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)4
	         OUTLEN = 1
	      ELSET
	         OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = OUTLEN + IDLEN + 1
	      END IFE
	   END IF
	   POINT = POINT + ICHAR(ACLENT(POINT:POINT))
	 END DO
	 IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)N
	END DO+

	RETURN 
	END




	SUBROUTINE CONVERT_INFFILE 

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLUSER.INC' 

	INCLUDE 'BULLFILES.INC'

	OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD',
     &	   ACCESS='KEYED',RECORDTYPE='FIXED',
     &	   IOSTAT=IER,ORGANIZATION='INDEXED',
     &	   KEY=(1:12:CHARACTER))N

	INQUIRE (UNIT=10,RECORDSIZE=RECL)

	IF ((RECL-3)/2.GT.FOLDER_MAX) THENE
	   WRITE (6,'('' ERROR: Old data files have more folders'',
     &		      '' than was specified with BULLUSER.INC.'')')R
	   WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')E
	   IF (USERNAME.EQ.'DECNET') THEN
	      CALL SYS$DELPRC(,)
	   ELSE
	      CALL ENABLE_CTRL2
	      CALL SYS$CANEXH()
	      CALL EXIT
	   END IF
	END IFI

	RECL = (RECL-3)/2

	OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',D
     &	   ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3,
     &	   IOSTAT=IER,ORGANIZATION='INDEXED',
     &	   KEY=(1:12:CHARACTER)) 

	DO WHILE (IER.EQ.0)
	 READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)
	 IF (IER.EQ.0) WRITE (9) TEMP_USER,
     &			((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)D
	END DOI

	CLOSE (UNIT=10,STATUS='DELETE')

	CLOSE (UNIT=9)

	RETURNR
	END


	SUBROUTINE ERROR_AND_EXIT

	IMPLICIT INTEGER (A-Z))
	E
	CALL ERRSNS(IDUMMY,IER)
	CALL SYS_GETMSG(IER)(
	CALL ENABLE_CTRL_EXIT

	RETURN 
	END




	SUBROUTINE COPY_ACL(INFILE,OUTFILE)
C
C  SUBROUTINE COPY_ACL
C
C  FUNCTION:
C	Copy ACLs from one file to another fileE
CN
	IMPLICIT INTEGER (A-Z)N

	INCLUDE '($ACLDEF)'

	CHARACTER*(*) INFILE,OUTFILE.

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))T
				! Get length needed to store acl output(
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist

	IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,) 

	CALL LIB$GET_VM(ACLLENGTH+12,ACLSTR)	! Create character string to
	CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)	! store acl)

	CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH)
						! Pass location of stringN
	CALL LIB$FREE_VM(ACLLENGTH+12,ACLSTR)

	RETURN 
	END


	SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH)
CL
C  SUBROUTINE COPY_ACL1D
Cn
C  FUNCTION: Called by COPY_ACL to actually do the copy.  Need 2 routinesE
C	since must convert location of string into a character string.
C-
	IMPLICIT INTEGER (A-Z) 

	INCLUDE '($ACLDEF)'

	CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*)

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT))
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
	IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)C
				! Read input file acl/

	IF (.NOT.IER) THEN_
	   IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,)
	   IF (.NOT.IER) RETURN
	   ACLLENGTH = ACL$S_ADDACLENTC
	   CTXT = 0
	   DO WHILE (IER)
	      CALL INIT_ITMLST	! Initialize item list
	      CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,
     &				%LOC(ACLENT))_
	      CALL END_ITMLST(ACL1_ITMLST)	! Get address of itemlist
	      IER = SYS$CHANGE_ACL
     &			(,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) 

	      CALL INIT_ITMLST	! Initialize item list
	      CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT))
	      CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
	      IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST)L
     &				,,,CTXT,,)
	      CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS)
	      IF (ACCESS.EQ.0) RETURN		! ID=*, ACCESS=NONE, which has
						! (and must) be applied first 
	   END DO
	   RETURN
	END IFF

	CALL INIT_ITMLST	! Initialize item list

	POINT = 1
	DO WHILE (POINT.LT.ACLLENGTH)	! Transfer all acls to output fileK
	   CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,E
     &		%LOC(ACLENT(POINT:)))
	   POINT = POINT + ICHAR(ACLENT(POINT:POINT))
	END DOY

	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
	IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,)

	RETURN 
	END




	SUBROUTINE CHECK_DIR_ACCESS()

	IMPLICIT INTEGER (A-Z)B

        INCLUDE 'BULLFILES.INC'L

	CHARACTER*80 TEST,TEST1

	DATA CHECKED /.FALSE./

  	IF (CHECKED) RETURN

	CHECKED = .TRUE. 

	IF (SYS_TRNLNM_SYSTEM(FOLDER_DIRECTORY,TEST)) THEN 
	   IER = SYS_TRNLNM(FOLDER_DIRECTORY,TEST1)
	   IF (IER) IER = TEST.NE.TEST1
	   IF (IER) THEN 
	      TEST1 = BULLNEWS_FILE
	      CALL ADD_DIRECTORY(BULLNEWS_FILE)
	      C = 0
	      IER = LIB$FIND_FILE(BULLNEWS_FILE,BULLNEWS_FILE,C)S
	      BULLNEWS_FILE = TEST1
	   END IF
	   IF (.NOT.IER) THEN  
	      TEST1 = FOLDER_DIRECTORY 
	      FOLDER_DIRECTORY = TEST
	   END IF
	   CALL ADD_DIRECTORY(BULLNEWS_FILE)a
	   CALL ADD_DIRECTORY(BULLNEWSDIR_FILE)
	   IF (.NOT.IER) FOLDER_DIRECTORY = TEST1
	ELSEC
	   CALL ADD_DIRECTORY(BULLNEWS_FILE)6
	   CALL ADD_DIRECTORY(BULLNEWSDIR_FILE)
	END IFe

	CALL CHECK_DIR(FOLDER_DIRECTORY)A
	CALL CHECK_DIR(NEWS_DIRECTORY) 

	CALL ADD_DIRECTORIESG

        RETURN
        END=
 S


	SUBROUTINE ADD_DIRECTORIES%

        INCLUDE 'BULLFILES.INC'.

	CALL ADD_DIRECTORY(BULLUSER_FILE)
	CALL ADD_DIRECTORY(BULLFOLDER_FILE)
	CALL ADD_DIRECTORY(BULLINF_FILE)

	RETURN0
	END



	SUBROUTINE CHECK_DIR(DIRECTORY)

	IMPLICIT INTEGER (A-Z)P

	CHARACTER*(*) DIRECTORY

	CHARACTER*80 TEST,TEST1

	IF (.NOT.SYS_TRNLNM_SYSTEM(DIRECTORY,TEST)) RETURN&

	CALL SYS_TRNLNM(DIRECTORY,TEST1)A
	IER = 1
	DO WHILE (TEST.NE.TEST1.AND.IER)	
	   IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST)H
	END DOD

	IF (TEST.NE.TEST1) THEN
           IF (INDEX(TEST1,':').EQ.0) TEST1 = TEST1(:TRIM(TEST1))//':'
	   CALL DISABLE_PRIVS
	   OPEN(UNIT=3,FILE=TEST1(:TRIM(TEST1))//
     &		'BULL.SCR',STATUS='NEW',IOSTAT=IER)A
	   CLOSE(UNIT=3,STATUS='DELETE')A
	   CALL ENABLE_PRIVS 
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR: No access to directory: '',A)') 
     &		TEST1(:TRIM(TEST1))C
	      CALL EXIT
	   END IF
	   DIRECTORY = TEST1'
	ELSE.
           IF (INDEX(TEST,':').EQ.0) TEST = TEST(:TRIM(TEST))//':'
	   DIRECTORY = TEST
    	   DO WHILE (IER)
	      IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',TEST)
	   END DO
	END IF 

	RETURNR
	END




	SUBROUTINE ADD_DIRECTORY(DIRECTORY)

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLFILES.INC'

	CHARACTER*(*) DIRECTORY

	DIRECTORY = DIRECTORY(INDEX(DIRECTORY,':')+1:)T
	DIRECTORY = DIRECTORY(INDEX(DIRECTORY,']')+1:)T
        IF (INDEX(FOLDER_DIRECTORY,':').EQ.0) FOLDER_DIRECTORY I
     &			= FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//':'D
	DIRECTORY = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &			//DIRECTORY

	RETURNS
        ENDT
