C
C  BULLETIN6.FOR, Version 2/22/91
C  Purpose: Contains subroutines for the bulletin board utility program.
C  Environment: VAX/VMS
C  Usage: Invoked by the BULLETIN command.
C  Programmer: Mark R. London
C
C  Copyright (c) 1990
C  Property of Massachusetts Institute of Technology, Cambridge MA 02139.
C  This program cannot be copied or distributed in any form for non-MIT
C  use without specific written approval of MIT Plasma Fusion Center
C  Management.
C
	SUBROUTINE CLOSE_FILE
C
C  SUBROUTINE CLOSE_FILE
C
C  FUNCTION: To close out the bulletin files and enable CTRL-C & -Y
C
	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)
 
	LUN = 0
 
	RETURN
	END
 
 
	SUBROUTINE CLOSE_FILE_DELETE
 
	IMPLICIT INTEGER (A-Z)
 
	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')
 
	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)'
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	COMMON /DIR_POSITION/ DIR_NUM
 
        COMMON /NEWS_OPEN/ NEWS_OPEN
 
	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 DISABLE_CTRL		! No breaks while file is open
 
	IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
 
	    OPEN (UNIT=2,FILE=FOLDER_FILE(1: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(1: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))
	    OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED')
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILE
	       NTRIES = 0
	    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',
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:25:CHARACTER,26:29:INTEGER))
	    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',
     &	        RECORDSIZE=FOLDER_RECORD,
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	      WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2)
     &		FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP
     &		,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB
     &		,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM
						! 4 means system folder
	      CLOSE (UNIT=7)
	      IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	    END IF
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	   IF (IER.EQ.0) NEWS_OPEN = .FALSE.
	END IF
 
	IF (LUN.EQ.14) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:25:CHARACTER,26:29:INTEGER))
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
	      OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',
     &	        RECORDSIZE=NEWS_FOLDER_RECORD,
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	      CLOSE (UNIT=7)
	      IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	    END IF
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
	   END DO
	   IF (IER.EQ.0) NEWS_OPEN = .TRUE.
	END IF
 
	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))
	     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)
	   END DO
	END IF
 
	IF (IER.NE.0) THEN
	   WRITE (6,'(
     &	    '' Cannot open file in OPEN_FILE, unit = '',I)') LUN
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THEN
	      WRITE (6,'('' IOSTAT error = '',I)') IER
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	   CALL ENABLE_CTRL_EXIT	! Enable CTRL-Y & -C & EXIT
	END IFB
 E
	LUN = 0
 s
	RETURN9
	END
 r
 e
 o
	SUBROUTINE TIMER_ERR(UNIT)l
 i
	IMPLICIT INTEGER (A-Z)
 E
	CHARACTER*14 NAMES(6)
	DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT',
     &			'BULLINF.DAT','BULLNEWS.DAT'/
	INTEGER NAME(14)t
	DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/0
 9
	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 IFa
 e
	CALL ENABLE_CTRL_EXIT		! No breaks while file is open
	END
 
 N
 L
	SUBROUTINE OPEN_FILE_SHARED
 C
	IMPLICIT INTEGER (A-Z)+
 	
	INCLUDE '($FORIOSDEF)'C
 E
	INCLUDE 'BULLFILES.INC'
 F
	INCLUDE 'BULLFOLDER.INC'U
  
	INCLUDE 'BULLUSER.INC'L
 E
	INCLUDE 'BULLDIR.INC'
  
	COMMON /POINT/ BULL_POINT
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 F
	COMMON /DIR_POSITION/ DIR_NUM
 
        COMMON /NEWS_OPEN/ NEWS_OPEN
 N
	EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT
C
C  The following 2 files were used prior to V1.1.E
CA
	CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/L
	CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/L
 L
	CHARACTER*25 SAVE_FOLDER!
	DATA SAVE_BLOCK/-1/
 B
	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/E
 U
	DATA LUN /0/
 
	ENTRY OPEN_BULLNEWS_SHARED
	LUN = LUN + 5			! Unit = 14
 U
	ENTRY OPEN_BULLINF_SHARED
	LUN = LUN + 1			! Unit = 9 
 M
	ENTRY OPEN_SYSUAF_SHAREDT
	LUN = LUN + 1			! Unit = 8T
 /
	ENTRY OPEN_BULLFOLDER_SHAREDE
	LUN = LUN + 3			! Unit = 7 
  
	ENTRY OPEN_BULLUSER_SHARED!
	LUN = LUN + 2			! Unit = 4E
 Y
	ENTRY OPEN_BULLDIR_SHARED
	LUN = LUN + 1			! Unit = 2O
 _
	ENTRY OPEN_BULLFIL_SHARED
	LUN = LUN + 1			! Unit = 1Y
 F
	IER = 0
 +
	NTRIES = 0 
 
	CALL DISABLE_CTRL
 D
	IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THENT
	   DO WHILE (FILE_LOCK(IER,IER1))
 i
	    OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)) 
     &	      //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,e
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,READONLY,E
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')I
	    IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0D
     &		.OR.FOLDER.EQ.'GENERAL')) THEN
	       IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL') 
	       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)E
	       IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENU
	          CLOSE (UNIT=2) 
	          IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loopN
	          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_BULLDIRS_
	       NTRIES = 0
	    END IF 
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	   DIR_NUM = -1
	END IFV
 _
	IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR.E
     &		SAVE_FOLDER.NE.FOLDER)) THEN
	   CALL REMOTE_READ_MESSAGE(BULL_POINT,IER)
	   IF (IER.GT.0) THEN
	      CALL ERROR_AND_EXIT
	   ELSE
	      SAVE_BLOCK = BLOCKR
	      SAVE_FOLDER = FOLDERR
	      CALL GET_REMOTE_MESSAGE(IER)N
	      IER = 0
	   END IF
	ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))L
     &	      //'.BULLFIL',STATUS='OLD',N
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY) 
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN 
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILE 
	       NTRIES = 0
	    END IFR
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	END IFL
 E
	IF (LUN.EQ.4) THENI
	   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) THEN(
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_USERFILEY
	       NTRIES = 0
	    END IF=
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	END IFK
 (
	IF (LUN.EQ.7) THEN 
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',R
     &	    IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
     &	    KEY=(1:25:CHARACTER,26:29:INTEGER))
 I
	    IF (IER.EQ.0) THEN 
	       INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)E
	       IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN 
	          CLOSE (UNIT=7) 
	          IDUMMY = FILE_LOCK(IER,IER1) 
	          CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE,ASK_SIZE)
		  NTRIES = 0
	       END IF
	    END IFL
	    NTRIES = NTRIES + 1
	    IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
	   END DO
	   IF (IER.EQ.0) NEWS_OPEN = .FALSE.
	END IF 
 E
	IF (LUN.EQ.14) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',S
     &	    IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
     &	    KEY=(1:25:CHARACTER,26:29:INTEGER))
 
	    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) THENO
	   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, 
     &	     USEROPEN=LNM_MODE_EXEC)E
	   END DO
	END IFB
  
	IF (LUN.EQ.9) THEN_
	   DO WHILE (FILE_LOCK(IER,IER1))
	     OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD',
     &	      ACCESS='KEYED',RECORDTYPE='FIXED',g
     &	      RECORDSIZE=FOLDER_MAX*2+3,E
     &	      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 + 1 
	     IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT 
	   END DO
	END IF6
 :
	IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN
	   CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
	   CALL OPEN_FILE(LUN)C
	   CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	ELSE IF (IER.NE.0) THEN
	   WRITE(6,'('' ERROR: Cannot open '',A)'):
     &			NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN))))
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1) 
	   IF (IER1.EQ.0) THEN 
	      WRITE (6,'('' IOSTAT error = '',I)') IERL
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	   CALL ENABLE_CTRL_EXIT
	END IFN
 .
	LUN = 0
  
	RETURN(
	END
 (
 ,
 1
 
	SUBROUTINE FOLDER_TO_NEWS
 F
	IMPLICIT INTEGER (A-Z) 
 &
	INCLUDE 'BULLFOLDER.INC'T
 =
	NEWS_FOLDER = FOLDERE
	NEWS_FOLDER_NUMBER = FOLDER_NUMBERG
	NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP(26:)
	NEWS_FOLDER_BBOARD = FOLDER_BBOARDS
	NEWS_F_NBULL = F_NBULL 
	NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)n
	NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)I
 
	RETURNT
 S
	ENTRY FOLDER1_TO_NEWS
 T
	NEWS_FOLDER1 = FOLDER1S
	NEWS_FOLDER1_NUMBER = FOLDER1_NUMBERO
	NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:)
	NEWS_FOLDER1_BBOARD = FOLDER1_BBOARDe
	NEWS_F1_NBULL = F1_NBULL'
	NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1),
	NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)E
 ,
	RETURNA
 r
	ENTRY NEWS_TO_FOLDER 
 E
	FOLDER = NEWS_FOLDERG
	FOLDER_NUMBER = NEWS_FOLDER_NUMBERT
	FOLDER_DESCRIP = NEWS_FOLDER//NEWS_FOLDER_DESCRIP
	FOLDER_BBOARD = NEWS_FOLDER_BBOARD
	F_NBULL = NEWS_F_NBULL(
	F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1)C
	F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2)y
	FOLDER_FLAG = 0
 .
	RETURNL
 D
	ENTRY NEWS_TO_FOLDER1
 .
	FOLDER1 = NEWS_FOLDER1T
	FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER4
	FOLDER1_DESCRIP = NEWS_FOLDER1//NEWS_FOLDER1_DESCRIPf
	FOLDER1_BBOARD = NEWS_FOLDER1_BBOARDR
	F1_NBULL = NEWS_F1_NBULL 
	F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1) 
	F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2)N
	FOLDER1_FLAG = 0
  
	RETURN'
  
	END
 y
 a
 l
 r
	SUBROUTINE CONVERT_BULLDIRS
 E
	IMPLICIT INTEGER (A-Z)h
  
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE 'BULLFOLDER.INC'H
 D
	INCLUDE 'BULLFILES.INC'
 +
	CHARACTER BUFFER*115S
 )
	WRITE (6,'('' Converting data files to new format. Please wait.'')')I
 U
	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)N
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
  
	OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))R
     &	      //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',ACCESS='DIRECT',
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',
     &	      IOSTAT=IER)
 U
	IF (IER.NE.0) GO TO 900	! No BULLDIR file found.R
 L
	READ (2'1,IOSTAT=IER1) BUFFER
 E
	CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL)
 1
	OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))E
     &	      //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
     &	      RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,E
     &	      ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
     &	      KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',+
     &	      INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 )
 U
	IF (IER.NE.0) THENO
	   OPEN (UNIT=9,FILE=FOLDER_FILE(1: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')E
	END IFN
 R
	IF (IER1.NE.0) GO TO 800I
 (
	CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM)
	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)D
	BULLDIR_HEADER(49:52) = BUFFER(70:)
	IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER
 E
	ICOUNT = 2 
	DO WHILE (IER.EQ.0)
	   READ (2'ICOUNT,IOSTAT=IER) BUFFERO
	   IF (IER.EQ.0) THEN
	      MSG_NUM = ICOUNT - 1M
	      DESCRIP = BUFFER(1:).
	      FROM = BUFFER(54:)L
	      BULLDIR_ENTRY(78:81) = BUFFER(85:)R
	      BULLDIR_ENTRY(90:97) = BUFFER(108:)
	      CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM) 
	      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 DO 
 L
800	CLOSE (UNIT=9,DISPOSE='KEEP')0
	CLOSE (UNIT=2)
  
900	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
 I
	RETURN!
 o
	END
 n
 u
 f
	SUBROUTINE CONVERT_BULLFILESB
CD
C  SUBROUTINE CONVERT_BULLFILESD
C 
C  FUNCTION: Converts bulletin files to new format file.
C	Add expiration time to directory file, add extra byte to bulletinE
C	file to show where each bulletin starts (for redunancy sake in
C	case crash occurs). 
CA
 R
	IMPLICIT INTEGER (A-Z)O
 ,
	INCLUDE 'BULLDIR.INC'
 N
	INCLUDE 'BULLFOLDER.INC'T
  
	INCLUDE 'BULLFILES.INC'
 L
	CHARACTER*81 BUFFER
 =
	WRITE (6,'('' Converting data files to new format. Please wait.'')') 
 
	OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))W
     &	      //'.BULLDIR',STATUS='OLD',I
     &	      RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',F
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',O
     &	      SHARED,READONLY,IOSTAT=IER)
 O
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 R
	OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='OLD',L
     &	      RECORDTYPE='FIXED',RECORDSIZE=80,
     &	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) 
 B
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 T
	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) 
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
 C
	OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='NEW',IOSTAT=IER,
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81,
     &	      FORM='FORMATTED')
 _
	OPEN (UNIT=2,FILE=FOLDER_FILE(1: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')S
 K
	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)N
	NEMPTY = 0Z
	IF (IER.EQ.0) CALL WRITEDIR(0,IER1)
 D
	EXTIME = '00:00:00.00' 
	ICOUNT = 2N
	DO WHILE (IER.EQ.0)
	   READ(9'ICOUNT,1010,IOSTAT=IER)
     &		DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCKS
	   IF (IER.EQ.0) THEN
	      READ(10,'(A)') BUFFER
	      WRITE(1,'(A)') BUFFER(1:80)//CHAR(1)R
	      DO I=2,LENGTH
	         READ(10,'(A)') BUFFERE
	         WRITE(1,'(A)') BUFFER 
	      END DOI
	      CALL WRITEDIR(ICOUNT-1,IER1)U
	      ICOUNT = ICOUNT + 1
	   END IF
	END DO 
 C
	CLOSE (UNIT=9)D
	CLOSE (UNIT=2) 
	CLOSE (UNIT=10)
	CLOSE (UNIT=1)N
 E
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	RETURNE
  
1000	FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)N
1010	FORMAT(A53,A12,A11,A8,A4,A11,A4,A4)
  
	END
  
	SUBROUTINE CONVERT_BULLFILE
CE
C  SUBROUTINE CONVERT_BULLFILE
C(
C  FUNCTION: Converts bulletin data file to new format file.
CE
C  NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length.
C	 This converts from 81 byte length to 128 compressed format.
CE
 H
	IMPLICIT INTEGER (A-Z)P
 L
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE 'BULLFOLDER.INC')
 E
	INCLUDE 'BULLFILES.INC'
 E
	CHARACTER*80 BUFFER,NEW_FILEL
 U
	WRITE (6,'('' Converting data files to new format. Please wait.'')')'
 
	CALL CLOSE_BULLDIRZ
 O
	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)A
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
 
	CALL OPEN_BULLFOLDERS
 C
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'D
     &	      ,STATUS='OLD', 
     &	      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(1:TRIM(FOLDER_FILE))R
     &	   //'.BULLFIL',STATUS='NEW',IOSTAT=IER, 
     &	   ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, 
     &	   FORM='UNFORMATTED') 
	IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))
     &		//'.BULLFIL;-1',NEW_FILE)
 B
	CALL OPEN_BULLDIR
 
	CALL READDIR(0,IER)
 Z
	IF (IER.EQ.1) THENL
	 NBLOCK = 0
	 DO I=1,NBULL
	   CALL READDIR(I,IER)N
	   NBLOCK = NBLOCK + 1N
	   SBLOCK = NBLOCKF
	   DO J=BLOCK,LENGTH+BLOCK-1R
	      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)E
	   LENGTH = NBLOCK - SBLOCK + 1
	   BLOCK = SBLOCK
	   CALL WRITEDIR(I,IER)
	 END DO
 I
	 NEMPTY = 0
	 CALL WRITEDIR(0,IER)
	END IF=
 L
	CLOSE (UNIT=10)
	CLOSE (UNIT=1)B
 '
	CALL CLOSE_BULLDIRM
	GOTO 100W
 _
200	CALL OPEN_BULLDIR_SHARED
  
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
 
	RETURN 
 S
	END
 
 L
 _
	SUBROUTINE CONVERT_BULLFOLDER(FILENAME,ASK_SIZE)S
CL
C  SUBROUTINE CONVERT_BULLFOLDER
CA
C  FUNCTION: Converts bulletin folder file to new format.S
CT
	IMPLICIT INTEGER (A-Z)M
 C
	INCLUDE 'BULLDIR.INC'
 F
	INCLUDE 'BULLFOLDER.INC'L
 =
	INCLUDE 'BULLFILES.INC'
 N
	INCLUDE '($SSDEF)'F
 E
	INCLUDE '($FORIOSDEF)'E
 N
	CHARACTER*(*) FILENAMEE
 
	CHARACTER*80 NEW_FILE
 D
	WRITE (6,'('' Converting data files to new format. Please wait.'')')_
 L
	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)W
 1
	EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))T
	SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1
	NEW_FILE = FILENAME(:SUFFIX)//'OLD'
 I
	DO WHILE (FILE_LOCK(IER,IER1))
	   OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',A
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	END DOU
 E
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 ,
	OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',R
     &	        RECORDSIZE=FOLDER_RECORD,
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')N
 )
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 S
	IF (ASK_SIZE.EQ.173/4) THEN
	 F_NUMBER = 0
	 DO WHILE (IER.EQ.0)
	   READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)',
     &			KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)=
     &		FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPD
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
     &	        ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET
	   IF (IER.EQ.0) THEN
	      WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER))
     &	        FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &	        ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBB
     &	        ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET
     &		,F_NEWEST_BTIM
	      F_NUMBER = F_NUMBER + 1
	   END IF
	 END DO
	ELSET
	 F_NUMBER = 0
	 DO WHILE (IER.EQ.0)K
	   READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)',
     &			KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)(
     &		FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPE
     &		,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))
     &		//FOLDER(:TRIM(FOLDER))_
	      CALL CHKACL
     &		(FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER)
	      IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN
		 FOLDER_FLAG = IBSET(FOLDER_FLAG,0)O
	      END IFL
	      DO WHILE (FILE_LOCK(IER,IER1))8
	       OPEN (UNIT=2,FILE=FOLDER_FILE(1: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_INCFILORG) THENK
	          IDUMMY = FILE_LOCK(IER,IER1)S
	          CALL CONVERT_BULLDIRS
		END IF
	      END DOR
	      IF (IER.EQ.FOR$IOS_FILNOTFOU) THENO
		 F_NEWEST_BTIM(1) = 0S
		 F_NEWEST_BTIM(2) = 0E
	      ELSEN
	         CALL READDIR(0,IER)t
	         IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN
		    IF (NBULL.GT.0) THEN
		       CALL READDIR(NBULL,IER)
		       NEWEST_DATE = DATEn
		       NEWEST_TIME = TIMEc
		       CALL WRITEDIR(0,IER)E
		    END IF
	         END IF
	         CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)
	         CLOSE (UNIT=2)
	      END IFC
	      WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)i
     &	        FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &	        ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBT
     &	        ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIMZ
	      F_NUMBER = F_NUMBER + 1
	   END IF
	 END DO
	END IF 
 A
	CLOSE (UNIT=7)A
	CLOSE (UNIT=19,STATUS='SAVE')
 O
	IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)=
	IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE)'
 L
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionE
 ,
	IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY))
     &		//'BOARD.COM;*')	! BULLETIN$ is referenced in old file
 E
	RETURNF
	END
 _
	SUBROUTINE CONVERT_USERFILE
C 
C  SUBROUTINE CONVERT_USERFILE
C)
C  FUNCTION: Converts user file to new format which has 8 bytes added.
C'
 L
	IMPLICIT INTEGER (A-Z)=
 ,
	INCLUDE 'BULLFILES.INC'
 '
	INCLUDE 'BULLUSER.INC'D
 E
	CHARACTER BUFFER*74,NEW_FILE*80
 
	CHARACTER*11 LOGIN_DATE,READ_DATE
	CHARACTER*8 LOGIN_TIME,READ_TIME/
 B
	WRITE (6,'('' Converting data files to new format. Please wait.'')')D
 E
	EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))D
	SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1
	NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'N
	IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE)
 T
	OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',E
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',
     &	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, 
     &	     KEY=(1:12:CHARACTER)):
	INQUIRE (UNIT=9,RECORDSIZE=RECL) 
 R
	IF ((RECL-28)/16.GT.FLONG) THEN
	   WRITE (6,'('' ERROR: Old data files have more folders'',
     &		      '' than was specified with BULLUSER.INC.'')')F
	   WRITE (6,'('' Recompile with correct FOLDER_MAX.'')') 
	   IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE) 
	   IF (USERNAME.EQ.'DECNET') THEN
	      CALL SYS$DELPRC(,)R
	   ELSE
	      CALL SYS$CANEXH()
	      CALL EXIT
	   END IF
	END IFO
 (
	IF (IER.EQ.0) THENT
	   CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
	   OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',1
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
     &	    FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	    KEY=(1:12:CHARACTER))
	END IF 
  
	IF (IER.NE.0) THENN
	   WRITE (6,'('' Cannot convert user file.'')')
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)h
	   CALL SYS_GETMSG(IER1)
	   CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	   CALL ENABLE_CTRL_EXIT
	END IFU
 '
	DO I=1,FLONG
	   NEW_FLAG(I) = 'FFFFFFFF'XL
	   NOTIFY_FLAG(I) = 0
	   BRIEF_FLAG(I) = 0 
	   SET_FLAG(I) = 0i
	END DO
 
	IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.R
     &		RECL.EQ.74) THEN		! Old format
	   IF (RECL.LE.58) RECL = 50C
	   IER = 0F
	   DO WHILE (IER.EQ.0)M
	      READ (9,'(A<RECL>)',IOSTAT=IER) BUFFERU
	      IF (IER.EQ.0) THENS
		TEMP_USER = BUFFER(1:12)
	        LOGIN_DATE = BUFFER(13:23)B
	        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))(
	        IF (RECL.EQ.66)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))X
	        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) 
	        WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,E
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	    END IFE
	   END DO
	   IF (RECL.LT.66) THEN
	     READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER,
     &		LOGIN_BTIM,R
     &		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/flag 
	   DO WHILE (IER.EQ.0)
	    READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) 
     &	     TEMP_USER,LOGIN_BTIM,READ_BTIM,P
     &	     (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 IFO
	   END DO
	END IFE
 
	IER = 0
 T
	CLOSE (UNIT=9)O
	CLOSE (UNIT=4)T
 :
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionN
 E
	RETURN
	END
 U
 '
	SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT)
C
C  SUBROUTINE READDIR.
C'
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 
 E
	IMPLICIT INTEGER (A - Z)D
 H
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE 'BULLFOLDER.INC'A
 S
	COMMON /PROMPT/ COMMAND_PROMPTS
	CHARACTER*39 COMMAND_PROMPT
  
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 '
	COMMON /DIR_POSITION/ DIR_NUM
 :
	CHARACTER*3 CFOLDER_NUMBER
 D
	ICOUNT = BULLETIN_NUM
 L
	IF (ICOUNT.EQ.0) THEN
	   IF (.NOT.REMOTE_SET) THENL
	      DO WHILE (REC_LOCK(IER)) 
	        READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADERR
	      END DOR
	      IF (IER.EQ.0) THENR
		 CALL CONVERT_HEADER_FROMBIN
		 DIR_NUM = 0
	      END IF 
	   ELSE
	      CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)
	      RETURNR
	   END IF
	   IF (IER.EQ.0) THEN
	      IF (NBULL.LT.0) THEN	! This indicates bulletin deletion
					! was incomplete.
		 CALL CLOSE_BULLDIR,
		 CALL OPEN_BULLDIR
		 CALL CLEANUP_DIRFILE(1)
		 CALL UPDATE_FOLDERM
	      END IFR
	      IF (NEMPTY.EQ.'    ') NEMPTY = 0F
CE
C  Check to see if cleanup of empty file space is necessary, which is,
C  defined here as being 50 blocks (200 128byte records).  Also checkL
C  to see if cleanup was in progress but didn't properly finish.
CD
	      IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THENR
		 WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER
	         IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(_
     &		  COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER,
     &		  'NL:','NL:',1,'BULL_CLEANUP')K
	      ELSE IF (NEMPTY.EQ.-1) THEN
		 CALL CLEANUP_BULLFILE
	      END IFI
	   END IF
	ELSE 
	   IF (.NOT.REMOTE_SET) THENN
	      DO WHILE (REC_LOCK(IER))E
		 IF (DIR_NUM.EQ.ICOUNT-1) THEN
	            READ(2,IOSTAT=IER) BULLDIR_ENTRYL
		    IF (MSG_NUM.NE.ICOUNT) IER = 36 
		 ELSEA
	            READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY
		 END IFD
	      END DO 
	      IF (IER.EQ.0) THEN_
	      	 CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
		 CALL CONVERT_ENTRY_FROMBIN,
		 DIR_NUM = MSG_NUM
	      ELSET
		 DIR_NUM = -1A
	      END IF	
	   ELSE
	      CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)
	      RETURNI
	   END IF
	END IFP
 (
	IF (IER.EQ.0) ICOUNT = ICOUNT + 1
 I
	UNLOCK 2&
  
	RETURN.
 L
	END
 U
 O
 ,
 M
 N
	SUBROUTINE READDIR_KEYGE(IER)
CD
C  SUBROUTINE READDIR_KEYGEE
CD
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: 
C	IER  -  If not 0, no entry found.  Else contains message number.
C$
 _
	IMPLICIT INTEGER (A - Z)S
 T
	INCLUDE 'BULLDIR.INC'
 M
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 R
	COMMON /DIR_POSITION/ DIR_NUM
 -
	IF (.NOT.REMOTE_SET) THEN
	   DO WHILE (REC_LOCK(IER))
	      READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRYW
	   END DO
	   IF (IER.EQ.0) THEN
	      IER = MSG_NUM
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      CALL CONVERT_ENTRY_FROMBINM
	      DIR_NUM = MSG_NUM
	   ELSE
	      IER = 0
	      DIR_NUM = -1(
	   END IF
	   UNLOCK 2
	ELSE 
	   CALL REMOTE_GET_HEADER(DUMMY,-1,IER)
 	END IF
 P
	RETURN 
  
	END
 R
 O
 ,
	SUBROUTINE CONVERT_HEADER_FROMBIN
 
	IMPLICIT INTEGER (A-Z)E
 T
	INCLUDE 'BULLDIR.INC'
 T
	CHARACTER*23 DATETIME
 _
	CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,)
 
	NEWEST_EXDATE = DATETIMEN
	NEWEST_EXTIME = DATETIME(13:)
 B
	CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)R
 M
	NEWEST_DATE = DATETIME;
	NEWEST_TIME = DATETIME(13:)
 D
	CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,)
 E
	SHUTDOWN_DATE = DATETIMEE
	SHUTDOWN_TIME = DATETIME(13:)
 C
	RETURN 
	END
 B
 D
 M
	SUBROUTINE CONVERT_ENTRY_FROMBINl
 i
	IMPLICIT INTEGER (A-Z)_
 S
	INCLUDE 'BULLDIR.INC'
 
	CHARACTER*23 DATETIME
 S
	CALL SYS$ASCTIM(,DATETIME,EX_BTIM,)
 l
	EXDATE = DATETIME
	EXTIME = DATETIME(13:)
 
	CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)'
 L
	DATE = DATETIME
	TIME = DATETIME(13:)
 
	RETURNR
	END
 4
 W
 L
 0
 
	SUBROUTINE WRITEDIR(BULLETIN_NUM,IER)
CA
C  SUBROUTINE WRITEDIR
C/
C  FUNCTION: Writes the entry for the specified bulletin in thew
C	directory file.D
C=
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1. 
C			 If 0, write the header of the directory file.
C  OUTPUTS:S
C	IER - Error status from WRITE.
CR
 M
	IMPLICIT INTEGER (A - Z)L
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
  
	COMMON /DIR_POSITION/ DIR_NUM
 F
	INCLUDE 'BULLDIR.INC'
 O
	CONV = .TRUE.
 O
	GO TO 10,
 T
	ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER)
 
	CONV = .FALSE.R
	R
10	IF (BULLETIN_NUM.EQ.0) THEN
	   IF (CONV) CALL CONVERT_HEADER_TOBINO
	   IF (REMOTE_SET) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER.
	   ELSE
	      IER = -1'
	      IF (DIR_NUM.EQ.0) THEN_
	         REWRITE (2,IOSTAT=IER) BULLDIR_HEADERL
	      END IF 
	      IF (IER.NE.0) THEN 
		 READ (2,KEYID=0,KEY=0,IOSTAT=IER)
		 IF (IER.EQ.0) THENA
	            REWRITE (2,IOSTAT=IER) BULLDIR_HEADER
		 END IF.
	      END IFA
	      IF (IER.NE.0) THENR
	         WRITE (2,IOSTAT=IER) BULLDIR_HEADERO
	      END IF,
	   END IF
	ELSEN
	   IF (CONV) CALL CONVERT_ENTRY_TOBIN
	   MSG_NUM = BULLETIN_NUM
	   IF (REMOTE_SET) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY=
	   ELSE
	      IER = -1C
	      IF (DIR_NUM.EQ.MSG_NUM) THEN.
	         REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY
	      END IF 
	      IF (IER.NE.0) THENI
	         READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER)
	         IF (IER.EQ.0) THEN
	            REWRITE (2,IOSTAT=IER) BULLDIR_ENTRYE
	         ELSE
		    WRITE (2,IOSTAT=IER) BULLDIR_ENTRY
		 END IFY
	      END IF 
	   END IF
	END IF
  
	IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITR
 .
	DIR_NUM = -1Q
 .
	RETURNQ
 .
	END
  
 	
 L
	SUBROUTINE CONVERT_HEADER_TOBIN
 E
	IMPLICIT INTEGER (A-Z) 
  
	INCLUDE 'BULLDIR.INC'
 0
	CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)E
 )
	CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM)
 :
	CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)F
 (
	RETURN 
	END
 A
 I
 =
	SUBROUTINE CONVERT_ENTRY_TOBIN.
 5
	IMPLICIT INTEGER (A-Z)V
 8
	INCLUDE 'BULLDIR.INC'
 (
	CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)L
 M
	CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM)
  
	CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
 V
	RETURN(
	END
 :
 N
 F
 L
	SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH)
CO
C  SUBROUTINE READACL 
C 
C  FUNCTION: Reads the ACL of a file._
CE
C  PARAMETERS:
C	FILENAME - Name of file to check.E
C	ACLENT - String which will be large enough to hold ACL information.L
C
	IMPLICIT INTEGER (A-Z)
  
	INCLUDE 'BULLFILES.INC'
 E
	INCLUDE '($ACLDEF)'
 ,
	CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)E
 B
	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),,,) 
  
	BIG = .NOT.IERo
	IF (BIG) THEN
	   IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,)
	   ACLLENGTH = ACL$S_ADDACLENT
	   CTXT = 0
	END IF<
 F
	DO ACC_TYPE=1,2
	 POINT = 1&
	 OUTLEN = 0
	 DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)F
	   IF (.NOT.BIG) THEN
	      IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+1
     &		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)s
     &				,,,CTXT,,)
	      IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(1:1))),
     &				ACLLEN,ACLSTR,,,,)
	      CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS)
	      IF (ACCESS.EQ.0) IER = .FALSE.r
	   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)) THENC
	      START_ID = INDEX(ACLSTR,'=') + 1t
	      END_ID = INDEX(ACLSTR,',ACCESS') - 1
	      IF (ACLSTR(END_ID:END_ID).EQ.']') THENR
		 START_ID = END_ID - 1
		 ASCII = .FALSE.
		 DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND.
     &			   ACLSTR(START_ID:START_ID).NE.'='.AND.T
     &			   (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))U
		    IF (ACLSTR(START_ID:START_ID).NE.','.AND.N
     &			(ACLSTR(START_ID:START_ID).LT.'0'.OR.
     &			 ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.A
		    IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN
		       START_ID = START_ID - 1
	 	    END IF
		 END DO 
		 IF (ASCII) THEN
		    START_ID = START_ID + 1)
		    END_ID = END_ID - 1F
		    IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN
		       START_ID = INDEX(ACLSTR,'=') + 1	
	               END_ID = INDEX(ACLSTR,'ACCESS') - 2P
		    END IF
		 END IFU
	      END IF	
	      IF (OUTLEN.EQ.0) THEN
		IF (FILENAME.NE.BULLUSER_FILE) THENM
	         IF (ACC_TYPE.EQ.1) THENe
		    WRITE (6,'(s
     &		    '' 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 IF
	      IDLEN = END_ID - START_ID + 1
	      IF (OUTLEN+IDLEN-1.GT.80) THEN:
		 WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)F
		 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) 
	         OUTLEN = 1
	      ELSE_
	         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)O
	END DOR
 R
	RETURN	
	END
 =
 G
 M
  
	SUBROUTINE CONVERT_INFFILE
  
	IMPLICIT INTEGER (A-Z) 
 C
	INCLUDE 'BULLUSER.INC'L
 N
	INCLUDE 'BULLFILES.INC'
 R
	OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD',
     &	   ACCESS='KEYED',RECORDTYPE='FIXED',
     &	   IOSTAT=IER,ORGANIZATION='INDEXED',
     &	   KEY=(1:12:CHARACTER))N
 E
	INQUIRE (UNIT=10,RECORDSIZE=RECL)
 e
	IF ((RECL-28)/16.GT.FLONG) THEN
	   WRITE (6,'('' ERROR: Old data files have more folders'',
     &		      '' than was specified with BULLUSER.INC.'')')e
	   WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')f
	   IF (USERNAME.EQ.'DECNET') THEN
	      CALL SYS$DELPRC(,)
	   ELSE
	      CALL SYS$CANEXH()
	      CALL EXIT
	   END IF
	END IF_
 D
	RECL = RECL/8
 T
	OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',
     &	   ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3,
     &	   IOSTAT=IER,ORGANIZATION='INDEXED',
     &	   KEY=(1:12:CHARACTER)) 
 N
	DO WHILE (IER.EQ.0)
	 READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)M
	 IF (IER.EQ.0) WRITE (9) TEMP_USER,
     &			((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX) 
	END DO2
 E
	CLOSE (UNIT=10,STATUS='DELETE')
 Y
	CLOSE (UNIT=9)F
 P
	RETURN 
	END
 D
 R
	SUBROUTINE ERROR_AND_EXIT
 E
	IMPLICIT INTEGER (A-Z)I
	N
	CALL ERRSNS(IDUMMY,IER)
	CALL SYS_GETMSG(IER)A
	CALL ENABLE_CTRL_EXIT
 L
	RETURNT
	END
 I
 N
 S
 X
	SUBROUTINE COPY_ACL(INFILE,OUTFILE)
CN
C  SUBROUTINE COPY_ACL
C)
C  FUNCTION:
C	Copy ACLs from one file to another fileN
CS
	IMPLICIT INTEGER (A-Z)S
 I
	INCLUDE '($ACLDEF)'
 C
	CHARACTER*(*) INFILE,OUTFILEW
 T
	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))
				! Get length needed to store acl outputI
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
 A
	IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)
 D
	CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR)	! Create character string toE
	CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)	! store acl
 
	CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH)
						! Pass location of stringT
	CALL LIB$FREE_VM(ACLLENGTH+8,ACLSTR)h
 n
	RETURNh
	END
 e
 u
	SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH)
CT
C  SUBROUTINE COPY_ACL1r
CS
C  FUNCTION: Called by COPY_ACL to actually do the copy.  Need 2 routinesU
C	since must convert location of string into a character string.
C-
	IMPLICIT INTEGER (A-Z)_
 D
	INCLUDE '($ACLDEF)'
 T
	CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*)
 E
	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),,,,,)N
				! Read input file acl'
 )
	IF (.NOT.IER) THEND
	   IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,)
	   IF (.NOT.IER) RETURN
	   ACLLENGTH = ACL$S_ADDACLENTA
	   CTXT = 0
	   DO WHILE (IER)
	      CALL INIT_ITMLST	! Initialize item list
	      CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT,
     &				%LOC(ACLENT))D
	      CALL END_ITMLST(ACL1_ITMLST)	! Get address of itemlistT
	      IER = SYS$CHANGE_ACLE
     &			(,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,) 
 L
	      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)A
     &				,,,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 IF 
  
	CALL INIT_ITMLST	! Initialize item list
 T
	POINT = 1
	DO WHILE (POINT.LT.ACLLENGTH)	! Transfer all acls to output fileE
	   CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,
     &		%LOC(ACLENT(POINT:)))O
	   POINT = POINT + ICHAR(ACLENT(POINT:POINT))
	END DOC
 E
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
	IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,)
  
	RETURN_
	END
