C
C  BULLETIN9.FOR, Version 1/15/93
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
	SUBROUTINE DELETE_NODE
C
C  SUBROUTINE DELETE_NODE
C
C  FUNCTION: Deletes files sent via ADD/NODES at remote hosts.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
     &				NODE_ERROR,POINT_NODE
	CHARACTER*32 NODES(10)
	LOGICAL LOCAL_NODE_FOUND,NODE_ERROR

    	CHARACTER INLINE*80

	CALL GET_NODE_INFO

 	IF (NODE_ERROR) GO TO 940

	IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN
	   WRITE (6,'('' ERROR: Cannot specify local node.'')')
	   GO TO 999
	END IF

	IER = CLI$GET_VALUE('SUBJECT',DESCRIP)

	DO POINT_NODE=1,NODE_NUM	   	! Write out command to nodes
	   NLEN = TRIM(NODES(POINT_NODE))	! Length of node name
	   INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))
	   WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE
	   READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE
	   IF (INLINE.EQ.'END') THEN
	      WRITE (6,'('' Message successfully deleted from node '',A)')
     &				NODES(POINT_NODE)
	   ELSE
	      WRITE (6,'('' Error while deleting message to node '',A)')
     &				NODES(POINT_NODE)
	      WRITE (6,'(A)') INLINE
	   END IF
	END DO

	GO TO 999

910	WRITE (6,1010)
	GO TO 999

940	WRITE (6,1015) NODES(POINT_NODE)

999	DO WHILE (NODE_NUM.GT.0)
	   CLOSE(UNIT=9+NODE_NUM)
	   NODE_NUM = NODE_NUM - 1
	END DO

	RETURN

1010	FORMAT (' ERROR: Deletion aborted.')
1015	FORMAT (' ERROR: Unable to reach node ',A)

	END




	SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME)
C
C  SUBROUTINE SET_FOLDER_FLAG
C
C  FUNCTION: Sets or clears specified flag for folder
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFILES.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*(*) FLAGNAME

	IF (REMOTE_SET.EQ.3.OR.(REMOTE_SET.EQ.4.AND.FLAG.NE.1)) THEN
	   WRITE (6,'('' ERROR: Command invalid for folder.'')')
	ELSE IF (FLAG.EQ.7.AND..NOT.SETPRV_PRIV()) THEN
	   WRITE (6,'('' ERROR: Privileges required for this command.'')')
	ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
           IF (REMOTE_SET.NE.4) THEN
	      CALL OPEN_BULLFOLDER		! Open folder file
	   ELSE
	      CALL OPEN_BULLNEWS_SHARED
	   END IF

	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)

	   IF (SETTING) THEN
	      FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG)
	   ELSE
	      FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG)
	   END IF

	   CALL REWRITE_FOLDER_FILE(IER)

	   CALL CLOSE_BULLFOLDER

	   WRITE (6,'(1X,A,'' has been modified for folder.'')')
     &		FLAGNAME
	ELSE
	   WRITE (6,'(1X,'' You are not authorized to modify '',A)')
     &		FLAGNAME//'.'
	END IF

	RETURN
	END




	SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT)
C
C  SUBROUTINE SET_FOLDER_EXPIRE_LIMIT
C
C  FUNCTION: Sets folder expiration limit.
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFILES.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	IF (REMOTE_SET.EQ.3) THEN
	   WRITE (6,'('' ERROR: Command invalid for folder. '')')
	ELSE IF (LIMIT.LT.0) THEN
	   WRITE (6,'('' ERROR: Invalid expiration length specified.'')')
	ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
	   CALL OPEN_BULLFOLDER		! Open folder file

	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)

	   F_EXPIRE_LIMIT = LIMIT

	   CALL REWRITE_FOLDER_FILE(IER)

	   CALL CLOSE_BULLFOLDER
	   WRITE (6,'('' Folder expiration date modified.'')')
	ELSE
	   WRITE (6,'('' You are not allowed to modify folder.'')')
	END IF

	RETURN
	END





	SUBROUTINE MERGE

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE

	ENTRY INITIALIZE_MERGE(IER1)

	DO WHILE (FILE_LOCK(IER1,IER2))
	   OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &		//'.TMPDIR',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')
	END DO

	IF (IER1.NE.0) RETURN

	NBULL = 0

	WRITE(24,IOSTAT=IER1) BULLDIR_HEADER
	CALL CONVERT_HEADER_FROMBIN

	TO_POINTER = 1

	RETURN

	ENTRY ADD_MERGE_TO(IER1)
 
	IER1 = 0

	DO WHILE (IER1.EQ.0)

	   BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY

	   CALL READDIR(TO_POINTER,IER)

	   DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM)
	   IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN
	      BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE
	      CALL CONVERT_ENTRY_FROMBIN
	      RETURN
	   END IF

	   NBULL = NBULL + 1
	   MSG_NUM = NBULL

	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	   WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY

	   NEWEST_DATE = DATE
	   NEWEST_TIME = TIME

	   TO_POINTER = TO_POINTER + 1

	   BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE
	END DO

	CLOSE (UNIT=24)

	RETURN

	ENTRY ADD_MERGE_FROM(IER1)

	NEWEST_DATE = DATE
	NEWEST_TIME = TIME

	DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)
	IF (DIFF.GT.0) THEN
	   NEWEST_EXDATE = EXDATE
	   NEWEST_EXTIME = EXTIME
	ELSE IF (DIFF.EQ.0) THEN
	   DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)
	   IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME
	END IF

	IF ((SYSTEM.AND.4).EQ.4) THEN
	   SHUTDOWN = SHUTDOWN + 1
	   SHUTDOWN_DATE = DATE
	   SHUTDOWN_TIME = TIME
	END IF

	BLOCK = NBLOCK - LENGTH

	NBULL = NBULL + 1
	MSG_NUM = NBULL

	CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY

	RETURN

	ENTRY ADD_MERGE_REST(IER1)

	CALL UPDATE_LOGIN(.TRUE.)

	DO WHILE (IER1.EQ.0)

	   CALL READDIR(TO_POINTER,IER)
	   IF (TO_POINTER+1.NE.IER) THEN
	      READ (24,KEYID=0,KEY=0,IOSTAT=IER1)
	      CALL CONVERT_HEADER_TOBIN
	      REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER
	      IF (IER1.EQ.0) THEN
	         CLOSE (UNIT=24,DISPOSE='KEEP')
	         CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
     &		  '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR')
	      ELSE
		 CLOSE (UNIT=24)
	      END IF
	      RETURN
	   END IF

	   NBULL = NBULL + 1
	   MSG_NUM = NBULL

	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	   WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY

	   NEWEST_DATE = DATE
	   NEWEST_TIME = TIME

	   TO_POINTER = TO_POINTER + 1
	END DO

	CLOSE (UNIT=24)

	RETURN
	END




	SUBROUTINE SET_NOKEYPAD

	IMPLICIT INTEGER (A-Z)

	COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID

	COMMON /KEYPAD/ KEYPAD_MODE

	INCLUDE '($SMGDEF)'

	KEYPAD_MODE = 0

	TERM = SMG$M_KEY_TERMINATE

	IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)

	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',)

	RETURN
	END





	SUBROUTINE SET_KEYPAD

	IMPLICIT INTEGER (A-Z)

	COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID

	COMMON /KEYPAD/ KEYPAD_MODE

        COMMON /KEYLOAD/ LOAD_KEY

	INCLUDE '($SMGDEF)'

	KEYPAD_MODE = 1

	TERM = SMG$M_KEY_TERMINATE

	IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)

	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD')
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM,
     &		'SHOW KEYPAD/PRINT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM,
     &		'SHOW FOLDER/FULL',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)n
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)r
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',) 
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',)C
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',)A
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',)R
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',)6
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)O
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)=
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',)c
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',) 
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',)'

        LOAD_KEY = SMG$LOAD_KEY_DEFS(KEY_TABLE_ID,'BULL_INIT',
     &				'SYS$LOGIN:BULL.INI',1)9

	RETURNR
	END



	SUBROUTINE SHOW_KEYPAD(LIBRARY)

	IMPLICIT INTEGER (A-Z)O
	EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT9
	CHARACTER*(*) LIBRARY

	COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID

        COMMON /KEYLOAD/ LOAD_KEYd

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING

	INCLUDE '($HLPDEF)'

	CHARACTER KEY*10,EQU*50,ST*20,IFS*20F

	OUT = 6

	IF (CLI$PRESENT('PRINT')) THEN
	   OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT',
     &			IOSTAT=IER)
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')')
	      RETURNR
	   END IF
	   OUT = 8R
	END IF      C

	IF (CLI$GET_VALUE('SHOW_KEY',KEY,I)) THEN
	   DO WHILE (CLI$GET_VALUE('STATE',IFS,J)) 
              IER = SMG$GET_KEY_DEF(
     &			KEY_TABLE_ID,KEY(:I),IFS(:J),ATT,EQU,ST)T
              WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'//
     &                                  EQU(:TRIM(EQU))//'"'
	      IF (TRIM(ST).GT.0) THEN
	         WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST))O
	      END IF
              IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN 
                 WRITE (OUT,'(A,$)') '+ '//'ifstate='//IFS(:TRIM(IFS))
              END IF
	      WRITE (OUT,'(A)') '+'
	   END DO
	   RETURN
 	ELSE IF (LOAD_KEY) THEN 
	   C = 0
	   IER = 1I
	   WRITE (OUT,'(1X,A)') 'Keypad definitions:'
	   L = 1R
	   DO WHILE (IER)
	      IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST)T
	      IF (IER) THEN
		 WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'//
     &					EQU(:TRIM(EQU))//'"'
	         IF (TRIM(ST).GT.0) THENI
		    WRITE (OUT,'(A,$)') '+ '//'state='//ST(:TRIM(ST))
		 END IF:
                 IF (TRIM(IFS).GT.0.AND.IFS.NE.'DEFAULT') THEN
                    WRITE (OUT,'(A,$)') '+ '//'ifstate='
     &						//IFS(:TRIM(IFS))M
                 END IFE
		 WRITE (OUT,'(A)') '+'
 		 L = L + 1 
                 IF (PAGING.AND.L.EQ.PAGE_LENGTH-1.AND.OUT.EQ.6) THEN 
                    L = 0                        ! Reinitialize screen counter
	            CALL LIB$PUT_OUTPUT(' ')A
		    CALL GET_INPUT_NOECHO_PROMPT( 
     &				KEY(:1),'Press key to continue ... ') 
             	    IER = LIB$ERASE_PAGE(1,1)         ! Erase displayM
		 END IFA
	      END IFE
	   END DO
           IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE')r
	   RETURN
	END IF'

	IF (OUT.EQ.8) THEN 
	   CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD')
     &		,LIBRARY,HLP$M_HELP)
	   CLOSE (UNIT=8,DISP='PRINT/DELETE')
	ELSEE
	   CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD''
     &		,LIBRARY,HLP$M_HELP)
	END IFL

	RETURND
	END

	INTEGER FUNCTION PRINT_OUTPUT(INPUT)
	IMPLICIT INTEGER (A-Z)I
	CHARACTER*(*) INPUT
	WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT))
	IF (IER.EQ.0) PRINT_OUTPUT = 1U
	RETURND
	END



	SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY)
C/
C  SUBROUTINE OUTPUT_HELPN
CE
C  FUNCTION:
C	To create interactive help session.  Prompting is enabled.
C  INPUTS:
C	PARAMETER - Character string. Optional input parameter
C		    containing a list of help keys.
C	LIBRARY   - Character string. Name of help library.R
C
	IMPLICIT INTEGER (A-Z)1

	INCLUDE '($LBRDEF)'

	COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN
	COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO
	CHARACTER*80 HELP_INPUT

	COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTE
	CHARACTER*20 KEY(10) 
	DIMENSION KEYL(10)D

	EXTERNAL PUT_OUTPUT

	CHARACTER*(*) LIBRARY,PARAMETER

	CHARACTER*80 PROMPT

	DATA DISPLAY_ID/0/,KEYBOARD_ID/0/

	IF (KEYBOARD_ID.EQ.0) THEN_
	   IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)
	   IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)
	END IF 

	CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN)	! Trim input

	CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ)		! Init library readF
	CALL LBR$OPEN(LINDEX,LIBRARY)			! Specify library name

	DO I=1,10					! Initialize key lengths)
	   KEYL(I) = 0 
	END DO 

	NKEY = 0					! Number of help keysM

	DO WHILE (1)		! Do until CTRL-Z entered or no more keys

	   HELP_PAGE = 0				! Init line counter
	   NEED_ERASE = .TRUE.				! Need to erase screenM

	   OLD_NKEY = NKEY				! Save old key count
	   EXACT = .TRUE.				! Exact key matchT

	   DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND.L
     &					   HELP_INPUT(:1).NE.'?')
							! Break input into keys
	      NKEY = NKEY + 1				! Increment key counter

	      DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0)
		 HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN)	! Strip spaces(
		 HELP_INPUT_LEN = HELP_INPUT_LEN - 1	! at start of input
	      END DO 

	      NEXT_KEY = 2T

	      DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN		! Search forI
     &		  .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' '	! space or
     &		  .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/')	! backslash
		 NEXT_KEY = NEXT_KEY + 1	! indicating start of next keyR
	      END DO

	      IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN	! Found the last key
		 KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN)	! Key stringG
		 KEYL(NKEY) = HELP_INPUT_LEN			! Key lengthA
		 HELP_INPUT_LEN = 0
	      ELSE					! Found the next key
		 KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1)
		 HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN)D
		 KEYL(NKEY) = NEXT_KEY - 1
		 HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1E
	      END IFA
	   END DO
	   HELP_INPUT_LEN = 0
	   IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,,	! Display help
     &		   KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)),E
     &		   KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)),
     &		   KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)),
     &		   KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10)))G

	   IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1_
		! IER = 0 special case means input given to full screen prompt

	   IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN	! If not exact matchT
	      DO I=OLD_NKEY+1,NKEY			! then don't updateD
		 KEYL(I) = 0				! new keys
	      END DOA
	      NKEY = OLD_NKEY
	   END IF

	   IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics?
	      KEYL(NKEY) = 0				! Back up one key level
	      NKEY = NKEY - 1
	   END IF

	   DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0)
	      IF (NKEY.EQ.0) THEN	! If top level, prompt for topicG
	         IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
     &		   HELP_INPUT,'Topic? ',HELP_INPUT_LEN)K
	      ELSE			! If not top level, prompt for subtopicD
		 LPROMPT = 0		! Create subtopic prompt lineL
		 DO I=1,NKEY		! Put spaces in between keys
		    PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' '
		    LPROMPT = LPROMPT + KEYL(I) + 1A
		 END DOK
		 PROMPT = PROMPT(:LPROMPT)//'Subtopic? '
		 LPROMPT = LPROMPT + 10,
	         IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
     &		   HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN)
	      END IF,
	      CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN)
	      IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN	! If RETURN entered
		 KEYL(NKEY) = 0				! Back up one key level
		 NKEY = NKEY - 1
	      END IFT
	   END DO

	   IF (.NOT.IER.OR.NKEY.LT.0) THEN	! If CTRL-Z above top level,
	      CALL LIB$PUT_OUTPUT(' ')		! Skip line
	      CALL LBR$CLOSE(LINDEX)		! then close library,
	      RETURN				! and end help session.
	   END IF

	END DOK

	END



	INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL)K
C,
C  FUNCTION PUT_OUTPUT
CG
C  FUNCTION:
C	Output routine for input from LBR$GET_HELP.  DisplaysS
C	help text on terminal with full screen prompting.R
C  INPUTS:
C	INPUT - Character string.  Line of input text.
C	INFO  - Longword.  Contains help flag bits.S
C	DATA  - Longword.  Not presently used.
C	LEVEL - Longword.  Contains current key level.
CR
	IMPLICIT INTEGER (A-Z)B

	INCLUDE '($HLPDEF)'

	COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTM
	CHARACTER*20 KEY(10),
	DIMENSION KEYL(10)Y

	COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN
	COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO
	CHARACTER*80 HELP_INPUT

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING

	CHARACTER INPUT*(*)

	CHARACTER SPACES*20
	DATA SPACES /' '/

	OTHERINFO = INFO.AND.HLP$M_OTHERINFOE

	IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN	! Key cannot be foundZ
	   NEED_ERASE = .FALSE.				! Don't erase screen
	   IF (HELP_PAGE.EQ.0) THEN		! If first line of help text
	      DO I=OLD_NKEY+1,NKEY		! remove any new keys thatG
		 KEYL(I) = 0			! were inputted, as they areF
	      END DO				! not valid, as no matchF
	      NKEY = OLD_NKEY			! could be found.
	   END IF
	ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND.
     &		 LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND.I
     &		 %LOC(INPUT).NE.0) THEN		! If text contains key names 
			! Update if not wildcard search and they are new keys
	   IF (KEYL(LEVEL).GT.0) THEN		! If key already updated
	      EXACT = .FALSE.		! Must be more than one match possible
	   END IF			! so indicate not exact match.R
	   START_KEY = 1		! String preceeding spaces.
	   DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ')
	      START_KEY = START_KEY + 1
	   END DO
	   KEY(LEVEL) = INPUT(START_KEY:)			! Store new key
	   CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL))	! & key length.
	ELSE IF (HELP_PAGE.EQ.0) THEN		! If first line of text,
	   DO I=OLD_NKEY+1,NKEY			! remove any new keys that 
	      KEYL(I) = 0			! were just inputted, allowing	
	   END DO				! this routine to fill them.
	END IF 

	IF (NEED_ERASE) THEN			! Need to erase screen? 
	   IER = LIB$ERASE_PAGE(1,1)		! i.e. start of new topic.Y
	   NEED_ERASE = .FALSE.
	END IF 

	HELP_PAGE = HELP_PAGE + 1		! Increment screen counter
	IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN		! End of page?
	   HELP_PAGE = 0			! Reinitialize screen counter+
	   CALL LIB$PUT_OUTPUT(' ')	! Skip line and prompt for next screenF
	   IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
     &		HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN)
	   CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN)	! Trim input
	   IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN	! CTRL-Z or Text input? 
	      EXACT = .TRUE.	! If more than one match was found and being
				! displayed, text input specifies that the
				! current displayed match is desired.&
	      PUT_OUTPUT = 0	! Stop any more of current help display.
	   ELSE					! Else if RETURN entered 
	      IER = LIB$ERASE_PAGE(1,1)		! Erase display 
	      NSPACES = LEVEL*2		! Number of spaces to indent output 
	      IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2P
		! Key name lines are indented 2 less than help description. 
	      IF (NSPACES.GT.0) THEN	! Add spaces if present to outputB
		 PUT_OUTPUT =  LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)
	      ELSE			! Else just output text.
		 PUT_OUTPUT =  LIB$PUT_OUTPUT(INPUT)
	      END IFA
	      HELP_PAGE = 1		! Increment page counter.I
	   END IF
	ELSE				! Else if not end of page
	   NSPACES = LEVEL*2		! Just output text line
	   IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2
	   IF (NSPACES.GT.0) THEN
	      PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)A
	   ELSE
	      PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)	
	   END IF
	END IFt

	RETURNy
	END




	SUBROUTINE SHOW_VERSION

	IMPLICIT INTEGER (A-Z)P

	CHARACTER VERSION*12,DATE*24'

	CALL READ_HEADER(VERSION,DATE)A

	WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION))

	WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE))

	RETURNV
	END




	SUBROUTINE FULL_DIR(INDEX_COUNT) 
C(
C	Add INDEX command to BULLETIN, display directories of ALLT
C	folders.
CP
	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLDIR.INC'
	INCLUDE 'BULLFILES.INC'
	INCLUDE 'BULLFOLDER.INC' 
	INCLUDE 'BULLUSER.INC'L

	COMMON /POINT/ BULL_POINT

	COMMON /TAGS/ BULL_TAG,READ_TAG

        COMMON /NEW_DIR/ NEW

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	DATA FOLDER_Q1/0/

	CHARACTER NEWS_ACCESS*132

	BULL_POINT = 0

	IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART')
     &		.AND.INDEX_COUNT.EQ.1) THENg
	   INDEX_COUNT = 2 
	   DIR_COUNT = 0 
	END IF 

	IF (INDEX_COUNT.EQ.1) THENL
	  CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM) 

	  FOLDER_Q = FOLDER_Q1	

	  SET = CLI$PRESENT('SET')E
	  NEW = CLI$PRESENT('NEW')a
	  INEW = NEW 

	  IREAD_TAG = IBSET(0,1) + IBSET(0,2)
	  IF (CLI$PRESENT('MARKED')) THEN
	     IREAD_TAG = 1 + IBSET(0,1)
	  ELSE IF (CLI$PRESENT('SEEN')) THEN	
	     IREAD_TAG = 1 + IBSET(0,2)
	  ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT
     &		   ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN_
	     IREAD_TAG = 1 + IBSET(0,1) + IBSET(0,3)H
	  ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT
     &		   ('SEEN').EQ.%LOC(CLI$_NEGATED)) THENa
	     IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3)_
 	  END IF

	  NEW = NEW.AND..NOT.IREAD_TAGN

	  SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')_
	  IF (SUBSCRIBE) THEN
	     CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT)U
	     SUBNUM = 1
	     CALL OPEN_BULLNEWS_SHAREDE
	  ELSEK
	     CALL OPEN_BULLFOLDER_SHAREDe
	  END IFE

	  NUM_FOLDERS = 0
	  IER = 0
	  DO WHILE (IER.EQ.0)			! Copy all bulletins from fileH
	    IF (SUBSCRIBE) THEN
	       IER = 1	
	       DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)
	          CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) 
		  IF (SUBNUM.NE.0) THENL
	             CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)P
		     IF (IER.NE.0) THEN 
			SUBNUM = -1
		     ELSE IF (NEW.AND.(MSGNUM.GE.F1_NBULL.OR.F1_NBULL 
     &			  .EQ.0.OR.F1_START.GT.F1_NBULL)) THEN 
		        IER = 1L
	             END IF
		  END IF
	       END DO
	       IF (SUBNUM.EQ.0) IER = 1
	    ELSEK
	       FOUND = .FALSE.E
	       DO WHILE (.NOT.FOUND.AND.IER.EQ.0)
	          CALL READ_FOLDER_FILE_TEMP(IER)
	          IF (IER.EQ.0) THENE
		     IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER)E
     &			.OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THENt
			FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM
     &			   (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0D
                     END IFd
	          END IFY
	       END DO
	    END IF 
	    IF (IER.EQ.0) THENL
	      IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THENQ
		 FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))o
     &					//FOLDER1
	         IF (SUBSCRIBE) THEN 
	            CALL CHECK_ACCESS
     &		     (NEWS_ACCESS(FOLDER_DESCRIP),
     &		      USERNAME,READ_ACCESS,-1)
	         ELSE
	            CALL CHECK_ACCESS
     &		     (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',
     &		      USERNAME,READ_ACCESS,-1)
	         END IF
	      ELSEM
		 READ_ACCESS = 1
	      END IFn
	      IF (READ_ACCESS) THEN
	         NUM_FOLDERS = NUM_FOLDERS + 1(
	         CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)I
	      END IFD
	    END IF 
	  END DOP

	  CALL CLOSE_BULLFOLDER			! We don't need file anymore 

	  FOLDER_Q = FOLDER_Q1			! Init queue pointer to header
	  IF (NEW) THEN
	     WRITE (6,1010)
	  ELSE)
	     WRITE (6,1000)
	  END IF$
	  IF (SUBSCRIBE) THEN
	     WRITE (6,1025)
	  ELSEI
	     WRITE (6,1020)
	  END IF!
	  DO J = 1,NUM_FOLDERSY
	   CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
	   IF (SUBSCRIBE) THEN 
	      WRITE (6,1035) FOLDER1_DESCRIP(:72),F1_NBULL 
	   ELSE
	      WRITE (6,1030) FOLDER1,F1_NBULL
	   END IF
	  END DOL
	  IF (NUM_FOLDERS.EQ.0) THENs
	     WRITE (6,1050)
	     INDEX_COUNT = 0e
	     RETURN
	  END IFD
	  WRITE (6,1060)
	  FOLDER_Q = FOLDER_Q1			! Init queue pointer to header
	  INDEX_COUNT = 2
	  DIR_COUNT = 0
	  RETURNt
	ELSE IF (INDEX_COUNT.EQ.2) THEN
	 READ_TAG = IREAD_TAG
	 IF (DIR_COUNT.LE.0) THEN
	  F1_NBULL = 0
	  DIR_COUNT = 0
	  DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0)
	     NUM_FOLDERS = NUM_FOLDERS - 1s
	     CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
	     IF (F1_NBULL.GT.0) THENe
	      FOLDER_NUMBER = -1A
	      CALL SELECT_FOLDER(.FALSE.,IER)
	      IF (.NOT.IER) F1_NBULL = 0C
	     END IF
	  END DO,

	  IF (F1_NBULL.EQ.0) THEN
	     WRITE (6,1050)
	     INDEX_COUNT = 0N
	     RETURN
	  END IFS
	 END IF
     _
	 IF (READ_TAG) THEN
	    CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)G
	 ELSE IF (INEW) THENA
	    NEW = INEW
            IF (REMOTE_SET.GE.3) THEN/
	       CALL NEWS_GET_NEWEST_MESSAGE(IER)
	       IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1	
	    ELSED
	       CALL FIND_NEWEST_BULLs
	    END IF 
	 END IF

	 CALL DIRECTORY(DIR_COUNT) 
	 IF (DIR_COUNT.GT.0) RETURN

	 IF (NUM_FOLDERS.GT.0) THEN
	    WRITE (6,1040)=
	 ELSE
	    INDEX_COUNT = 0
	 END IF
	END IF	

	RETURNl

1000	FORMAT (' The following folders are present'/)o
1010	FORMAT (' The following folders with new messages are present'/).
1020	FORMAT (' Name',42X,'Count'/)
1025	FORMAT (' Name',70X,'Count'/)
1030	FORMAT (1X,A,1X,I6)
1035	FORMAT (1X,A,1X,I6)
1040	FORMAT (' Type Return to continue to the next folder...')
1050	FORMAT (' End of folder search.')
1060	FORMAT (' Type Return to continue...')A

	END





	SUBROUTINE SHOW_USERb
C
C  SUBROUTINE SHOW_USERe
Ct
C  FUNCTION: Shows information for specified users.g
Ca
	IMPLICIT INTEGER (A-Z)(

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'Y

	INCLUDE 'BULLDIR.INC'

	COMMON /POINT/ BULL_POINT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /CTRLC_FLAG/ FLAGI

	DIMENSION NOLOGIN_BTIM(2),START_BTIM(2)

	CHARACTER DATETIME*17

	DIMENSION LAST(2,FOLDER_MAX) 
	INTEGER*2 LAST2(4,FOLDER_MAX)
	EQUIVALENCE (LAST,LAST2)N

	ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')I
     &				.OR.CLI$PRESENT('LOGIN')

	SETPRV = SETPRV_PRIV()		! SETPRV_PRIV rewrites TEMP_USER=

	IF (.NOT.ALL) THENm
	   IER = CLI$GET_VALUE('USERNAME',TEMP_USER)T
	   IF (.NOT.IER) TEMP_USER = USERNAME
	END IFG

	IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THENU
	   WRITE (6,'('' ERROR: No privs to use command.'')')
	   RETURN
	END IFI

	CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)U

	FOLDER_PRESENT = CLI$PRESENT('FOLDER')A

	IF (FOLDER_PRESENT) THENN
	   IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME)
	   IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME
	   NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1)
     &			.GE.'a'.AND.FOLDER1_NAME(:1).LE.'z')p
           IF (.NOT.NEWS) THEN
	      CALL OPEN_BULLFOLDER_SHARED
	   ELSE
	      CALL OPEN_BULLNEWS_SHARED
	      CALL LOWERCASE(FOLDER1_NAME)R
	   END IF
	   CALL READ_FOLDER_FILE_KEYNAME_TEMP
     &				(FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)o
	   CALL CLOSE_BULLFOLDER
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR: Folder not found.'')')
	      RETURNi
	   END IF
	END IFe

	SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START')c
	IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN
	   IF (.NOT.NEWS) THEN)
	      IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM)
	      IF (.NOT.IER) THEN)
	         WRITE (6,'('' ERROR: Invalid date specified.'')')t
		 RETURNN
	      END IF!
	   ELSE
	      WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')')
	      RETURNL
	   END IF
	ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN 
	   IF (NEWS) THEN
	      IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), 
     &				    STARTMSG,,%VAL(1))
	      IF (.NOT.IER) THENt
		 WRITE (6,'('' ERROR: Invalid number specified.'')')
		 RETURNN
	      END IF
	   ELSE
	      WRITE (6,'('' ERROR: /START not valid with folder.'')')
	      RETURNB
	   END IF
	ELSE IF (SINCE) THENR
	   IF (BULL_POINT.EQ.0) THENn
	      WRITE (6,'('' ERROR: No current message.'')')
	      RETURNU
	   ELSE IF (NEWS) THEN
	      STARTMSG = BULL_POINT
	   ELSE
	      START_BTIM(1) = MSG_BTIM(1)
	      START_BTIM(2) = MSG_BTIM(2)
	   END IF
	ELSE IF (.NOT.NEWS) THENN
	   CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM)
	ELSEO
	   STARTMSG = 1
	END IFM

	CALL DISABLE_CTRL
	CALL DECLARE_CTRLC_AST/
	IF (FOLDER_PRESENT) THENM
	   CALL OPEN_BULLINF_SHARED
	   IER = 0 
	   DO WHILE (IER.EQ.0.AND.FLAG.NE.1)1
	      IF (ALL) THEN
	         DO WHILE (REC_LOCK(IER))
	            READ (9,IOSTAT=IER) TEMP_USER,LASTE
	         END DO
	      ELSE 
		 IF (NEWS) THEN 
		    LU = TRIM(TEMP_USER)
		    TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU))) 
		    IF (LU.GT.1) THEN
		       TEMP_USER(LU-1:LU-1) =N
     &			        CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))I
		    ELSE
		       TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2)))
	 	    END IF,
	 	 END IF
	         DO WHILE (REC_LOCK(IER))
	            READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST'
	         END DO
	      END IF 
	      UNLOCK 9$
	      IF (IER.EQ.0) THENA
	         LU = TRIM(TEMP_USER)
		 I = MAX(LU,2)
		 DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7))
		    I = I - 1)
		 END DO 
		 IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND._
     &		     BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THENS
		    TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127)
		    TEMP_USER(I-1:I-1) =
     &				 CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127)
		    I = 0E
		    NEWSMSG = 1 
		    DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBERS
     &					.AND.NEWSMSG.LE.FOLDER_MAX)
		       NEWSMSG = NEWSMSG + 1
	            END DOE
		    IF (NEWSMSG.LE.FOLDER_MAX) THENI
		       FOUND = LAST(2,NEWSMSG).GE.STARTMSG
		    ELSE
		       FOUND = .FALSE.
		    END IF
		 ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN
		    FOUND = COMPARE_BTIM
     &			(START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0	
		 ELSE 
		    FOUND = .FALSE.F
		 END IFF
		 IF (FOUND.AND.NEWS) THEN.
	            WRITE (6,'(1X,A,'' latest message read '', 
     &			I<LOG10(REAL(LAST(2,NEWSMSG)))+1>,''.'')')(
     &			TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG)
		 ELSE IF (FOUND) THENN
		    CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),)
	            WRITE (6,'(1X,A,'' latest message read '',A,''.'')')2
     &				TEMP_USER(:TRIM(TEMP_USER)),DATETIME
		 ELSE IF (.NOT.ALL) THEN
	            WRITE (6,'('' User has never read or not subscribed'', 
     &			'' to specified folder.'')').
	         END IF
	      END IF
	      IF (.NOT.ALL) THEN 
		 IF (IER.NE.0) THEN 
		    WRITE (6,'('' User info does not exist.'')')
		 END IFO
		 IER = 2
	      END IFF
	   END DO
	   CALL CLOSE_BULLINF
	ELSE IF (.NOT.ALL) THEN
	   CALL OPEN_BULLUSER_SHARED(
	   CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)
	   IF (IER.EQ.0) THEN
	      IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN
	         WRITE (6,'('' NOLOGIN set for specified user.'')')
	      ELSE:
	         CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)
	         WRITE (6,'('' User last logged in at '',A,''.'')')
     &						DATETIME
	      END IFI
	   ELSE
	      WRITE (6,'('' Entry for specified user not found.'')') 
	   END IF
	   CALL CLOSE_BULLUSERR
	ELSEE
	   CALL OPEN_BULLUSER_SHAREDE
	   CALL READ_USER_FILE(IER)
	   DO WHILE (IER.EQ.0.AND.FLAG.NE.1) 
	      CALL READ_USER_FILE(IER)Q
	      IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.N
     &				TEMP_USER(:1).NE.'*') THEN
		 IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)H
		 IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN
	            WRITE (6,'('' NOLOGIN set for '',A,''.'')')
     &					TEMP_USER(:TRIM(TEMP_USER))
		 ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND.
     &			  COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THENR
	            CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)S
	            WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') 
     &				TEMP_USER(:TRIM(TEMP_USER)),DATETIME
		 END IFR
	      END IFe
	   END DO
	   CALL CLOSE_BULLUSER=
	END IFR
	CALL CANCEL_CTRLC_AST
	CALL ENABLE_CTRLN

	RETURNN
	END




	SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER)
CU
C  SUBROUTINE INIT_MESSAGE_ADD
C.
C  FUNCTION:  Opens specified folder in order to add message. 
CA
C  INPUTS:
C	IN_FOLDER  - Character string containing folder name
C	IN_FROM	   - Character string containing name of owner of message.
C		     If empty, the message is searched for either a
C		     Reply-to: field or a From: field.  If none, then
C		     the owner of the process is used.  If IN_FROME
C		     ends with a %, it is assumed that it is simply
C		     the prefix that should be when responding to the
C		     address via MAIL.  I.e. the PMDF interface sends
C		     IN%, so when the From: field is found, the message
C		     owner becomes IN%"from-address".
C	IN_DESCRIP - Character string containing subject of message.
C		     If empty, the message is searched for a line
C		     which starts with "Subj:" or "Subject:".
C  OUTPUTS:
C	IER - Error status.  True if properly connected to folder.
C		False if folder not found.R
C 
	IMPLICIT INTEGER (A - Z)e

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'e

	INCLUDE 'BULLDIR.INC'

	COMMON /BCP/ BULLCP
	LOGICAL BULLCP5

	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROA
	CHARACTER*12 PROTOCOL
	DATA LPRO/0/)

	COMMON /DIGEST/ LDESCR,FIRST_BREAKe

	CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP 

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

	COMMON /TEXT_PRESENT/ TEXTi

	COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
	CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ
	DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./

	COMMON /SCRTYPE/ SCRTYPEG
	DATA SCRTYPE/0/

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER)
	IF (IER.EQ.1.AND.LEN_P.GT.0
     &	    .AND.BULL_PARAMETER(:LEN_P).NE.'ENABLE') CALL SYS$DELPRC(,)

	BULLCP = 1			! Inhibit folder cleanup subprocess.

	CALL CHECK_DIR_ACCESS()

	CALL INIT_COMPRESST

	CALL OPEN_BULLFOLDER			! Get folder fileR

	CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER)R

	CALL CLOSE_BULLFOLDER

	IF (IER.NE.0) THENe
	   CALL ERRSNS(IDUMMY,IER)E
	   RETURN
	ELSE_
	   IER = 1-
	END IF0

        FOLDER_NAME = FOLDER

	ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER)

	TEXT = .FALSE.			! No text written, as of yet

	FIRST_BREAK = .TRUE.O

	IF (FOLDER_NUMBER.EQ.0) THEN	! If GENERAL folderM
	   FOLDER_SET = .FALSE.		! indicate it	
	ELSE				! Else it's another folderp
	   FOLDER_SET = .TRUE.		! indicate it
	END IFN

	FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
     &		FOLDER			! set folder file names

	ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER)

	CALL OPEN_BULLDIR		! Open directory file 

	CALL OPEN_BULLFIL		! Open data file

	CALL READDIR(0,IER1)		! Get NBLOCKo
	IF (IER1.EQ.0) NBLOCK = 0	! If new file, NBLOCK is 0I

	NBLOCK = NBLOCK + 1
	LENGTH = NBLOCK			! Initialize line count

	LEN_FROM = TRIM(IN_FROM)A

	IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN	! Just protocol
	   PROTOCOL = IN_FROM(:LEN_FROM)//'"'
	   LPRO = LEN_FROM + 1 
	   LEN_FROM = 0
	END IFI

	IF (LEN_FROM.GT.0) THEN
	   INFROM = IN_FROM
	   IF (.NOT.BTEST(FOLDER_FLAG,5)) THENR
	      CALL STORE_FROM(INFROM,LEN_FROM))
	   ELSE	IF (INDEX(INFROM,'%"').GT.0) THEN	! Store any protocolL
	      LPRO = INDEX(INFROM,'%"') + 1
	      PROTOCOL = INFROM(:LPRO)(
	   END IF
	   LEN_DESCRP = TRIM(IN_DESCRIP)G
	   IF (LEN_DESCRP.GT.0) THEN)
	      INDESCRIP = IN_DESCRIP 
	      IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
	         CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)R
	      END IFl
	   ELSE
	      DESCRIP = ' '
	   END IF
	ELSEE
	   OPEN (UNIT=3,DISPOSE='DELETE',FILE='SYS$LOGIN:BULL.SCR',
     &	    FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1,STATUS='NEW')
	   SCRTYPE = 0 
	   IF (IER1.NE.0) THENT
	      OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL.SCR',S
     &		FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW')W
	      SCRTYPE = 1
	   END IF
	   SAVE_IN_DESCRIP = IN_DESCRIP
	   SAVE_IN_FROM = ' '
	END IFI

	OLD_BUFFER = ' 'T

	OLD_BUFFER_SUBJ = .FALSE.
	OLD_BUFFER_FROM = .FALSE.

	INEXDATE = .FALSE.H

	RETURNE
	END



	SUBROUTINE WRITEOUT_STOREDE

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'I

	CHARACTER*256 BUFFER9

	REWIND (UNIT=3)

	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(A)',IOSTAT=IER) BUFFER
	   IF (IER.EQ.0) THEN
	      CALL WRITE_MESSAGE_LINE(BUFFER)
	   END IF
	END DO 

	IF (BTEST(FOLDER_FLAG,5)) RETURNS
	IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3)H
        IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3)

	RETURN 
	END



	SUBROUTINE WRITE_MESSAGE_LINE(BUFFER)
C 
C  SUBROUTINE WRITE_MESSAGE_LINE
CK
C  FUNCTION:  Writes one line of message into folder.T
C_
C  INPUTS:
C	BUFFER - Character string containing line to be put into message..
CT

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'T

	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO 
	CHARACTER*12 PROTOCOL

	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPM
	COMMON /MAIN_HEADER_INFO/ INEXDATEP
	CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP

	COMMON /DIGEST/ LDESCR,FIRST_BREAK&
	DATA FIRST_BREAK/.TRUE./-

	COMMON /TEXT_PRESENT/ TEXT

	COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
	CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM

	CHARACTER*(*) BUFFERM

	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(INPUT_LENGTH) OLD_BUFFER

	COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ

	COMMON /DATE/ DATE_LINE
	CHARACTER*(INPUT_LENGTH) DATE_LINEN

	CHARACTER*24 TODAY	

	DATA STORED /.FALSE./  

	LEN_BUFFER = TRIM(BUFFER)

	IF (LEN_FROM.EQ.0) THEN
	   WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))
	   IF (LEN_BUFFER.GT.LINE_LENGTH) THEN'
	      WRITE (3,'(A)') ' '//BUFFER(LINE_LENGTH+1:LEN_BUFFER)
	   END IF
	   IF (OLD_BUFFER_FROM.AND.(BUFFER(:1).EQ.' '.OR.
     &		BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN
	      SAVE_IN_FROM = 
     &		SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER)
	      RETURN2
	   ELSE IF (OLD_BUFFER_SUBJ.AND.(BUFFER(:1).EQ.' '.OR. 
     &		BUFFER(:1).EQ.CHAR(9)).AND.LEN_BUFFER.GT.1) THEN
	      INDESCRIP = r
     &		INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER)
	      LDESCR = LDESCR + LEN_BUFFER.
	      RETURN
	   ELSE IF (BUFFER(:5).EQ.'From:') THEN
	      IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)2
	      OLD_BUFFER_FROM = .TRUE. 
	      OLD_BUFFER_SUBJ = .FALSE.
	      RETURN 
	   ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN
	      LDESCR = LEN_BUFFER - 9
	      INDESCRIP = BUFFER(10:)
	      OLD_BUFFER_SUBJ = .TRUE.B
	      OLD_BUFFER_FROM = .FALSE.
	      RETURN 
	   ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN
	      IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:) 
	      OLD_BUFFER_FROM = .TRUE.&
	      OLD_BUFFER_SUBJ = .FALSE.
	      RETURNW
	   ELSE IF (LEN_BUFFER.EQ.0) THEN
	      IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM)
	      LEN_FROM = TRIM(SAVE_IN_FROM)
	      IF (LEN_FROM.GT.0) THEN
		 OLD_BUFFER_FROM = .FALSE.
		 INFROM = SAVE_IN_FROM
		 IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
		    CALL STORE_FROM(INFROM,LEN_FROM)
		 ELSE IF (INDEX(INFROM,'%"').GT.0) THEN_
		    LPRO = INDEX(INFROM,'%"') + 1 
		    PROTOCOL = INFROM(:LPRO)
		 END IFH
		 IF (LDESCR.GT.0) THEN
		    LEN_DESCRP = LDESCR'
	            CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
		 ELSET
	            LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)&
	            IF (LEN_DESCRP.GT.0) THEN
	               INDESCRIP = SAVE_IN_DESCRIPA
	               IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN 
	                  CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
	               END IF
	            ELSED
		       DESCRIP = ' '
		    END IF
		 END IFI
	         STORED = .TRUE.
	         IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STOREDM
	         STORED = .FALSE.
	      END IF)
	   END IF
	   OLD_BUFFER_FROM = .FALSE. 
	   OLD_BUFFER_SUBJ = .FALSE.d
	   RETURN
	END IFs
	IF (BTEST(FOLDER_FLAG,5)) THENE
	   IF (INDEX(BUFFER,'-------------').EQ.1) THEN
	      BREAK = .TRUE.r
	      DO I=1,LEN_BUFFER
		 IF (BUFFER(I:I).NE.'-') BREAK = .FALSE.
	      END DOo
	   ELSE
	      BREAK = .FALSE.
	   END IF
	   IF (BREAK) THENn
	      IF (.NOT.FIRST_BREAK) THENi
		 CALL FINISH_MESSAGE_ADD
	         CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER)
	      ELSEh
		 FIRST_BREAK = .FALSE.
                 CLOSE (UNIT=3)I
	      END IFt
	      LFROM = 0
	      LDESCR = 0e
	      RETURN 
	   ELSE IF (.NOT.FIRST_BREAK) THENo
	      IF (LDESCR.EQ.0) THEN
	         IF (BUFFER(:9).EQ.'Subject: ') THEN 
		    LDESCR = LEN_BUFFER - 9 
	            CALL STORE_DESCRP(BUFFER(10:),LDESCR)
		    IF (LFROM.EQ.0) THEN
		       LFROM = LEN_FROMo
	               CALL STORE_FROM(INFROM,LFROM).
		    END IF
		 ELSE IF (BUFFER(:6).EQ.'From: ') THEN
		    LFROM = LEN_BUFFER - 6
		    IF (LFROM.LE.0) THEN
		       LFROM = TRIM(SAVE_IN_FROM)
		       IF (LPRO.GT.0) THEN
		          LFROM = LFROM + LPRO + 1
	                  CALL STORE_FROM(PROTOCOL(:LPRO)//
     &			   SAVE_IN_FROM//'"',LFROM)
		       ELSE(
	                  CALL STORE_FROM(SAVE_IN_FROM,LFROM)
		       END IFE
		    ELSE IF (LPRO.GT.0) THEN
		       LFROM = LFROM + LPRO + 1C
	               CALL STORE_FROM(PROTOCOL(:LPRO)// 
     &			BUFFER(7:LEN_BUFFER)//'"',LFROM)A
		    ELSE
	               CALL STORE_FROM(BUFFER(7:),LFROM)E
		    END IF
		 END IFM
		 RETURNU
	      END IFR
	   ELSE
	      IF (LEN_BUFFER.GT.0) THEN
	         WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))
	      ELSEA
		 WRITE (3,'(A)') ' '
	      END IFM
	      TEXT = .TRUE.
	      RETURN/
	   END IF
	END IFR

	IF (LEN_BUFFER.EQ.0) THEN		! If empty lineM
	   CALL STORE_BULL(1,' ',NBLOCK)	! just store one space
	ELSE)
	   IF (LEN_DESCRP.EQ.0) THEN
	      IF (BUFFER(:9).EQ.'Subject: ') THEN
		 DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)	
		 LEN_DESCRP = LEN_BUFFER
	      END IFL
	   END IF
	   IF (.NOT.INEXDATE) THENS
	      IF (BUFFER(:9).EQ.'Expires: '.OR.
     &		  BUFFER(:11).EQ.'X-Expires: ') THEN
		 I = INDEX(BUFFER,' ')+1
		 NODATE = .FALSE.O
		 DO J=I,LEN_BUFFER
		    IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN
		       BUFFER(J:J) = ' '
		    END IF
		 END DOR
	         CALL STR$UPCASE(BUFFER(I:),BUFFER(I:))
		 NODATE = .TRUE.
		 I = INDEX(BUFFER,' ')+1
		 EXDATE(3:3) = '-'
		 EXDATE(7:7) = '-'
		 DO WHILE (I.LE.LEN_BUFFER)G
		    IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THENE
		       IF (NODATE) THENf
			  IF (INDEX(BUFFER(I:),' ').EQ.2) THEN 
			     EXDATE(1:2) = '0'//BUFFER(I:I)
			     I = I + 1R
			  ELSE)
			     EXDATE(1:2) = BUFFER(I:I+1)e
			     I = I + 2I
			  END IF_
			  NODATE = .FALSE.I
		       ELSE 
			  IF (LEN_BUFFER-I.EQ.1.OR.
     &			     INDEX(BUFFER(I:),' ').EQ.3) THEN   ! No century?
			     IER = SYS$ASCTIM(,TODAY,,)	   ! Get today's date
			     YEAR = INDEX(TODAY(6:),'-')K
			     EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1)
			     I = I + 2A
			  ELSE_
			     EXDATE(8:) = BUFFER(I:I+3)
			     I = I + 4 
			  END IFI
		       END IF/
		    ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN
		       EXDATE(4:6) = BUFFER(I:I+2)
		       I = I + 3
		    ELSE
		       I = I + 1
		    END IF
		 END DOO
		 INEXDATE = .TRUE.
	      END IFO
	   END IF
	   CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK)
	   IF (.NOT.STORED.AND.BTEST(FOLDER_FLAG,11)) THEN 
	      WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH)))
	   END IF
	   TEXT = .TRUE. 
	END IFI

	RETURNS
	END




	SUBROUTINE FINISH_MESSAGE_ADD
CR
C  SUBROUTINE FINISH_MESSAGE_ADD
CI
C  FUNCTION:  Writes message entry into directory file and closes folder
CO
C  NOTE:  Only should be run if INIT_MESSAGE_ADD was successful.
CE

	IMPLICIT INTEGER (A-Z)S

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'T

	INCLUDE 'BULLUSER.INC'S

	COMMON /DIGEST/ LDESCR,FIRST_BREAKO

	COMMON /SCRTYPE/ SCRTYPET

	COMMON /TEXT_PRESENT/ TEXTE

	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPM
	COMMON /MAIN_HEADER_INFO/ INEXDATET
	CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP

	COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
	CHARACTER*(INPUT_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM

	CHARACTER*24 TODAYU

	DIMENSION BIN_EXTIME(2)

	IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN
	   IF (LEN_FROM.GT.0) THEN)
	      CALL STORE_FROM(INFROM,LEN_FROM)H
	   ELSE
	      CALL GETUSER(FROM)F
	      INFROM = FROM
	      LEN_FROM = TRIM(INFROM)
	   END IF
	   IF (LEN_DESCRP.GT.0) THEN)
	      CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
	   END IF
	   LDESCRP = 1R
	   FIRST_BREAK = .FALSE. 
	   CALL WRITEOUT_STORED
	   CLOSE (UNIT=3)
	ELSE IF (LEN_FROM.EQ.0) THENT
	   CALL GETUSER(FROM)
	   INFROM = FROMr
	   LEN_FROM = TRIM(INFROM)-
	   LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)
	   IF (LEN_DESCRP.GT.0) THENI
	      INDESCRIP = SAVE_IN_DESCRIP
	      IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
	         CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP) 
	      END IFM
	   ELSE
	      DESCRIP = ' '
	   END IF
	   CALL WRITEOUT_STORED
	END IFD

	CALL FLUSH_BULL(NBLOCK)

	CALL CLOSE_BULLFIL			! Finished adding bulletin

	IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR.	! End of digest msgS
     &				.NOT.TEXT) THEN	! or no message text found
	   CALL CLOSE_BULLDIR			! then don't add message entry_
	   RETURN
	END IF)

	EXTIME = '00:00:00.00'U
	IF (INEXDATE) THENA
	   IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME)
	   IF (IER) THEN			! If good date formatO
	      IER = SYS$ASCTIM(,TODAY,,)	! Get today's date
	      IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's
	      IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great?E
     &		.OR.IER.LE.0) THEN		! or expiration date not futureE
	         INEXDATE = .FALSE.		! Don't use it
	      END IFE
	   ELSE
	      INEXDATE = .FALSE.		! Don't use it1
	   END IF
	END IF	

	IF (.NOT.INEXDATE) THEN
	   IF (FOLDER_BBEXPIRE.EQ.-1) THEN	! Folder has expiration time?:
	      EXDATE = '5-NOV-2000'		! no, so set date far in futureL
	      SYSTEM = 2			! indicate permanent message
	   ELSE					! Else set expiration dateB
	      CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
	      SYSTEM = 0E
	   END IF
	END IFB

	LENGTH = NBLOCK - LENGTH + 1		! Number of records

	CALL ADD_ENTRY				! Add the new directory entry

	CALL CLOSE_BULLDIR			! Totally finished with add

	IF (BTEST(FOLDER_FLAG,11)) THEN
	   SLIST = INDEX(FOLDER_DESCRIP,'<')R
	   IF (SLIST.GT.0) THEN
	      INPUT = FOLDER_DESCRIP(SLIST+1:) 
	      ILEN = INDEX(INPUT,'>') - 1
	      IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)E
	      INPUT = INPUT(:ILEN).
              CALL ADD_PROTOCOL(INPUT,ILEN)9
	      CLOSE (UNIT=3,STATUS='SAVE')'
	      IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THENU
	         IER = LIB$SET_LOGICALM
     &			('MX_REPLY_TO',INFROM(:TRIM(INFROM)))
	      ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN 
	         IER = LIB$SET_LOGICALS
     &			('PMDF_REPLY_TO',INFROM(:TRIM(INFROM)))
	      ELSEI
		 USERNAME = FOLDER
	      END IF_
	      IF (SCRTYPE.EQ.0) THEN 
	         CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT,A
     &	   	   	   INDESCRIP(:LEN_DESCRP),STATUS)
                 CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
	      ELSEL
	         CALL RESPOND_MAIL('BULL.SCR',INPUT,0
     &	   	   	   INDESCRIP(:LEN_DESCRP),STATUS)
                 CALL LIB$DELETE_FILE('BULL.SCR;*') 
	      END IFS
	   END IF
	END IFS

	CALL UPDATE_FOLDER 

	RETURN.
	END




	SUBROUTINE STORE_FROM(IFROM,LEN_INFROM)

	IMPLICIT INTEGER (A-Z)B

	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO 
	CHARACTER*12 PROTOCOL

	INCLUDE 'BULLDIR.INC'

	CHARACTER*(*) IFROM

	CHARACTER*(INPUT_LENGTH) INFROM

	INFROM = IFROM	

	IF (LPRO.GT.0) THEN			! Protocol present?
	   I = INDEX(INFROM,'%"') + 2		! Make usable for VMS MAIL
	   IF (I.EQ.2) THEN
	      INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"' 
	      I = LPRO + 1 
	      LEN_INFROM = LEN_INFROM + LPRO + 1T
	   END IF
	   DO WHILE (I.LT.LEN_INFROM)
	      IF (INFROM(I:I).EQ.'"') THENB
		 INFROM(I:I) = ''''D
	      ELSE IF (INFROM(I:I).EQ.'\') THEN
		 INFROM(I+1:) = '\'//INFROM(I+1:) 
		 LEN_INFROM = LEN_INFROM + 1
		 I = I + 1
	      ELSE IF (INFROM(I:I).EQ.''''.AND.
     &		       INDEX(INFROM,'@').GT.I) THEN 
		 INFROM(I:) = '\s'//INFROM(I+1:)
		 LEN_INFROM = LEN_INFROM + 1
		 I = I + 2
	      END IF
	      I = I + 1
	   END DO
	END IF 

	DO I=1,LEN_INFROM			! Remove control characters
	   IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' 'o
	END DOI

	DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ')b
	   INFROM = INFROM(2:)S
	   LEN_INFROM = LEN_INFROM - 1 
	END DOR

	TWO_SPACE = INDEX(INFROM,'  ') 
	DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM)
	   INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:)
	   LEN_INFROM = LEN_INFROM - 1'
	   TWO_SPACE = INDEX(INFROM,'  ')
	END DOF

	CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM),
     &		NBLOCK) 

	IF (INDEX(INFROM,'%"').GT.0)		! Strip off protocol programC
     &		INFROM = INFROM(INDEX(INFROM,'%"')+2:)

	IF (INDEX(INFROM,'::').GT.0)		! Strip off node name
     &		INFROM = INFROM(INDEX(INFROM,'::')+2:)	! I.e. HOST::USER

	CALL GET_FROM(INFROM,LEN_INFROM)M

	RETURNL
	END


	SUBROUTINE GET_FROM(INFROM,LEN_INFROM):

	IMPLICIT INTEGER (A-Z):

	INCLUDE 'BULLDIR.INC'

	CHARACTER*(*) INFROM 

	DO WHILE (INDEX(INFROM,'!').GT.0.AND.	! Unix address go backwards.R
     &		INDEX(INFROM,'!').LT.INDEX(INFROM,'@'))E
	   INFROM = INFROM(INDEX(INFROM,'!')+1:)	! I.e. host!user
	END DOE

	DO WHILE (INDEX(INFROM,'<').GT.0.AND.	! Name may be of form
     &		INDEX(INFROM,'@').GT.INDEX(INFROM,'<'))E
	   INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name <net-name>E
	END DO 

	DO WHILE (INDEX(INFROM,'(').GT.0.AND.	! personal-name (net-name)E
     &		INDEX(INFROM,'@').GT.INDEX(INFROM,'('))	
	   INFROM = INFROM(INDEX(INFROM,'(')+1:)	
	END DOR

	I = 1	! Trim username to start at first alpha character
	DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR.
     &		INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR.
     &		INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR.
     &		INFROM(I:I).EQ.'\'.OR.
     &		INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')):
	   I = I + 1 
	END DO	
	INFROM = INFROM(I:)
	J = LEN_INFROM - I + 1B

	I = 1		! Trim username to end at a alpha character)
	DO WHILE (I.LE.J.AND.INFROM(I:I).NE.' '.AND.
     &		INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND.
     &		INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND.
     &		INFROM(I:I).NE.'\'.AND.,
     &		INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.''''):
	   I = I + 1 
	END DO	
	FROM = INFROM(:I-1)

	DO J=2,TRIM(FROM)
	   IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND.
     &	       ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR.
     &	        (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THENS
	      FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a'))6
	   END IF
	END DOA

	RETURND
	END




	SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP)

	IMPLICIT INTEGER (A-Z)F

	INCLUDE 'BULLDIR.INC'

	CHARACTER*(*) INDESCRIP

	CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP)

	DO I=1,LEN_DESCRP			! Remove control characters
	   IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' ' 
	END DO+

	DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ')
	   INDESCRIP = INDESCRIP(2:)L
	   LEN_DESCRP = LEN_DESCRP - 1E
	END DOF

	IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN(
				! Is length > allowable subject length?)
	   CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//N
     &		INDESCRIP(:LEN_DESCRP),NBLOCK)
	END IFE

	DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))O

	RETURNH
	END





	SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER)i
Ct
C  SUBROUTINE STRIP_HEADER
C
C  FUNCTION:  Indicates whether line is part of mail message header.
CI
C  INPUTS:
C	BUFFER	- Character string containing input line of message.C
C	BLEN	- Length of character string.  If = 0, initialize subroutine.
C
C  OUTPUTS:Y
C	IER	- If true, line should be stripped.  Else, end of header.D
CI
	IMPLICIT INTEGER (A - Z)R

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'C

	COMMON /DATE/ DATE_LINE
	CHARACTER*(INPUT_LENGTH) DATE_LINEE

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*(*) BUFFER_

	IF (TRIM(BUFFER).EQ.0) THEN
			! If STRIP not set for folder or empty line
	   IER = .FALSE.F
	   CONT_LINE = .FALSE.(
	   RETURN
	END IF

	IF (BLEN.EQ.0) THEN
	   DATE_LINE = ' ' 
	   CONT_LINE = .FALSE.(
	END IF 

	IER = .TRUE.M

	IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR.   ! If line is continuationE
     &		BUFFER(:1).EQ.CHAR(9))) RETURN	   ! of previous header lineD

	I = 1
	DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ')
	   IF (BUFFER(I:I).EQ.':') THEN	! Header line found
	      CONT_LINE = .TRUE.	! Next line might be continuationR
	      IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN
		 DATE_LINE = 'Message sent'//BUFFER(5:BLEN)P
		 IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THENF
		    DATE_LINE(TRIM(DATE_LINE)+1:) = '.'N
	         END IF
	      END IFI
	      RETURN 
	   ELSE
	      I = I + 1
	   END IF
	END DO_

	IER = .FALSE.
	CONT_LINE = .FALSE.

	RETURNL
	END
