C
C  BULLETIN9.FOR, Version 1/27/94
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 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

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

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.OR.FLAG.EQ.14).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',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)
	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',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)
	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',)
	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)

	RETURN
	END



	SUBROUTINE SHOW_KEYPAD(LIBRARY)

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

	COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID

        COMMON /KEYLOAD/ LOAD_KEY

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING

	INCLUDE '($HLPDEF)'

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

	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.'')')
	      RETURN
	   END IF
	   OUT = 8
	END IF      

	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)
              WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'//
     &                                  EQU(:TRIM(EQU))//'"'
	      IF (TRIM(ST).GT.0) THEN
	         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))
              END IF
	      WRITE (OUT,'(A)') '+'
	   END DO
	   RETURN
 	ELSE IF (LOAD_KEY) THEN
	   C = 0
	   IER = 1
	   WRITE (OUT,'(1X,A)') 'Keypad definitions:'
	   L = 1
	   DO WHILE (IER)
	      IER = SMG$LIST_KEY_DEFS(KEY_TABLE_ID,C,KEY,IFS,ATT,EQU,ST)
	      IF (IER) THEN
		 WRITE (OUT,'(3X,A,$)') KEY(:TRIM(KEY))//' = '//'"'//
     &					EQU(:TRIM(EQU))//'"'
	         IF (TRIM(ST).GT.0) THEN
		    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))
                 END IF
		 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(' ')
		    CALL GET_INPUT_NOECHO_PROMPT(
     &				KEY(:1),'Press key to continue ... ')
             	    IER = LIB$ERASE_PAGE(1,1)         ! Erase display
		 END IF
	      END IF
	   END DO
           IF (OUT.EQ.8) CLOSE (UNIT=8,DISP='PRINT/DELETE')
	   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')
	ELSE
	   CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD'
     &		,LIBRARY,HLP$M_HELP)
	END IF

	RETURN
	END

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



	SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY)
C
C  SUBROUTINE OUTPUT_HELP
C
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.
C
	IMPLICIT INTEGER (A-Z)

	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,EXACT
	CHARACTER*20 KEY(10)
	DIMENSION KEYL(10)

	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 read
	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 keys

	DO WHILE (NKEY.GE.0)	! Do until CTRL-Z entered or no more keys

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

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

	   DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND.
     &					   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 = 2

	      DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN		! Search for
     &		  .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 key
	      END DO

	      IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN	! Found the last key
		 KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN)	! Key string
		 KEYL(NKEY) = HELP_INPUT_LEN			! Key length
		 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)
		 KEYL(NKEY) = NEXT_KEY - 1
		 HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1
	      END IF
	   END DO
	   HELP_INPUT_LEN = 0
	   IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,,	! Display help
     &		   KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)),
     &		   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)))

	   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 match
	      DO I=OLD_NKEY+1,NKEY			! then don't update
		 KEYL(I) = 0				! new keys
	      END DO
	      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 topic
	         IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
     &		   HELP_INPUT,'Topic? ',HELP_INPUT_LEN)
	      ELSE			! If not top level, prompt for subtopic
		 LPROMPT = 0		! Create subtopic prompt line
		 DO I=1,NKEY		! Put spaces in between keys
		    PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' '
		    LPROMPT = LPROMPT + KEYL(I) + 1
		 END DO
		 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 IF
	   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 DO

	END



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

	INCLUDE '($HLPDEF)'

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

	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_OTHERINFO

	IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN	! Key cannot be found
	   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 that
		 KEYL(I) = 0			! were inputted, as they are
	      END DO				! not valid, as no match
	      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.
     &		 %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.
	   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.
	   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 screen
	   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 - 2
		! Key name lines are indented 2 less than help description.
	      IF (NSPACES.GT.0) THEN	! Add spaces if present to output
		 PUT_OUTPUT =  LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)
	      ELSE			! Else just output text.
		 PUT_OUTPUT =  LIB$PUT_OUTPUT(INPUT)
	      END IF
	      HELP_PAGE = 1		! Increment page counter.
	   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)
	   ELSE
	      PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)
	   END IF
	END IF

	RETURN
	END




	SUBROUTINE SHOW_VERSION

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	CHARACTER VERSION*12,DATE*24

	INTEGER BTIM(2)

	CALL READ_HEADER(VERSION,DATE)

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

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

	RETURN

	ENTRY SHOW_NEW_VERSION

	CALL READ_HEADER(VERSION,DATE)

	IER = SYS$BINTIM(DATE(:TRIM(DATE)),BTIM)
	IF (.NOT.IER) RETURN

	IF (COMPARE_BTIM(READ_BTIM,BTIM).LT.0) THEN
	   WRITE (6,'(A)') ' A new BULLETIN executable has been '//
     &			   'installed since your last use.'
	   WRITE (6,'(A)') 
     &		' Type HELP NEW_FEATURES for help on any new features.'
	END IF

	RETURN
	END




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

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

	COMMON /POINT/ BULL_POINT

	COMMON /TAGS/ BULL_TAG,READ_TAG

        COMMON /NEW_DIR/ NEW

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
	LOGICAL PAGING

	DATA FOLDER_Q1/0/

	CHARACTER NEWS_ACCESS*132,DATETIME*20

	BULL_POINT = 0

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

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

	  FOLDER_Q = FOLDER_Q1

	  SET = CLI$PRESENT('SET')
	  NEW = CLI$PRESENT('NEW')
	  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)
	  ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT
     &		   ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN
	     IREAD_TAG = 1 + IBSET(0,2) + IBSET(0,3)
 	  END IF

	  NEW = NEW.AND..NOT.IREAD_TAG

	  SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')
	  IF (SUBSCRIBE) THEN
	     CALL NEWS_GET_SUBSCRIBE(0,F1_COUNT)
	     SUBNUM = 1
	     CALL OPEN_BULLNEWS_SHARED
	  ELSE
	     CALL OPEN_BULLFOLDER_SHARED
	  END IF

	  NUM_FOLDERS = 0
	  IER = 0
	  DO WHILE (IER.EQ.0)			! Copy all bulletins from file
	    IF (SUBSCRIBE) THEN
	       IER = 1
	       DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)
	          CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)
		  IF (SUBNUM.NE.0) THEN
	             CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)
		     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 = 1
	             END IF
		  END IF
	       END DO
	       IF (SUBNUM.EQ.0) IER = 1
	    ELSE
	       FOUND = .FALSE.
	       DO WHILE (.NOT.FOUND.AND.IER.EQ.0)
	          CALL READ_FOLDER_FILE_TEMP(IER)
	          IF (IER.EQ.0) THEN
		     IF (.NOT.SET.OR.TEST2(SET_FLAG,FOLDER1_NUMBER)
     &			.OR.TEST2(BRIEF_FLAG,FOLDER1_NUMBER)) THEN
			FOUND = .NOT.NEW.OR.COMPARE_BTIM(LAST_READ_BTIM
     &			   (1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM).LT.0
                     END IF
	          END IF
	       END DO
	    END IF
	    IF (IER.EQ.0) THEN
	      IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN7
		 FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) 
     &					//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
	      ELSEa
		 READ_ACCESS = 1
	      END IF
	      IF (READ_ACCESS) THEN
	         NUM_FOLDERS = NUM_FOLDERS + 1O
	         CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)I
	      END IFZ
	    END IFE
	  END DOI

	  CALL CLOSE_BULLFOLDER			! We don't need file anymore,

	  FOLDER_Q = FOLDER_Q1			! Init queue pointer to header
	  IF (NEW) THEN
	     WRITE (6,1010)
	  ELSEO
	     WRITE (6,1000)
	  END IFI
	  IF (.NOT.SUBSCRIBE) THENF
	     WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'',
     &		2X,''Owner'',/,1X,80(''-''))')
	  ELSEc
	     WRITE (6,'(1X,''News group'',<PAGE_WIDTH-80+39>X,1X,
     &		''First        Last   Last Read'',/,1X,<PAGE_WIDTH>(''-''))') 
	  END IF 
          NUM_FOLDER = 0
	  IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+42)E
	  DO I = 1,NUM_FOLDERSS
	   CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
	   IF (SUBSCRIBE) THENN
	      J = INDEX(FOLDER1_DESCRIP,' ')
	      IF (J.GT.0.AND.FOLDER1_DESCRIP(J+1:J+1).NE.'=') THENs
                 FOLDER1_DESCRIP = FOLDER1_DESCRIP(:J-1)
              END IF
	      IF (F1_START.LE.F1_NBULL) THENn
                 NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER
		 CALL NEWS_GET_NEWEST_MESSAGE1(NEWS_NEW)
	         WRITE (6,1015) '*'//FOLDER1_DESCRIP(:FLEN-1),T
     &					F1_START,F1_NBULL,NEWS_NEW-1 
              ELSE
	         WRITE (6,1015) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0,0
	      END IFR
	   ELSE
	      IF (F1_NBULL.GT.0) THEN
	         CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,)
	      ELSEB
	         DATETIME = '      NONE'N
	      END IFc
	      WRITE (6,1030) FOLDER1,DATETIME(:17),F1_NBULL, 
     &							FOLDER1_OWNER
	   END IF
	   NUM_FOLDER = NUM_FOLDER + 1U
	   IF (I.NE.NUM_FOLDERS.AND.PAGING.AND.((NUM_FOLDER+6.EQ.PAGE_LENGTH
     &		.AND.I.EQ.NUM_FOLDER).OR.(NUM_FOLDER+2.EQ.PAGE_LENGTH.AND.
     &		I.NE.NUM_FOLDER))) THEN 
	      NUM_FOLDER = 0i
	      WRITE(6,1080)	! Ask for input to proceed to next page
	      CALL GET_INPUT_NOECHO_PROMPT(DATETIME(:1),O
     &			'HIT any key for next page....')'
	   END IF
	  END DOC
	  IF (NUM_FOLDERS.EQ.0) THEN_
	     WRITE (6,1050)
	     INDEX_COUNT = 0 
	     RETURN
	  END IFL
	  WRITE (6,1060)d
	  FOLDER_Q = FOLDER_Q1			! Init queue pointer to header
	  INDEX_COUNT = 2
	  DIR_COUNT = 0
	  RETURNR
	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 - 1L
	     CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
	     IF (F1_NBULL.GT.0) THEN
	      FOLDER_NUMBER = -1a
	      CALL SELECT_FOLDER(.FALSE.,IER)
	      IF (.NOT.IER) F1_NBULL = 0R
	     END IF
	  END DOB

	  IF (F1_NBULL.EQ.0) THEN
	     WRITE (6,1050)
	     INDEX_COUNT = 0_
	     RETURN
	  END IFS
	 END IF
     t
	 IF (READ_TAG) THEN
	    CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)C
	 ELSE IF (INEW) THEN
	    NEW = INEWE
            IF (REMOTE_SET.GE.3) THENE
	       CALL NEWS_GET_NEWEST_MESSAGE(IER)H
	       IF (IER.GT.0.AND.IER.LE.F_NBULL) BULL_POINT = IER - 1	
	    ELSEI
	       CALL FIND_NEWEST_BULL'
	    END IFl
	 END IF

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

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

	RETURNO

1000	FORMAT (' The following folders are present'/)W
1010	FORMAT (' The following folders with new messages are present'/) 
1015    FORMAT(1X,A<FLEN>,<PAGE_WIDTH-FLEN-36-1>X,2X,I10,2X,I10,2X,I10) 
1030	FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)I
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...')R
1080	FORMAT(' ',/)

	END





	SUBROUTINE SHOW_USERF
C_
C  SUBROUTINE SHOW_USERN
CN
C  FUNCTION: Shows information for specified users./
CM
	IMPLICIT INTEGER (A-Z)U

	INCLUDE 'BULLFOLDER.INC'Y

	INCLUDE 'BULLUSER.INC'E

	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/ FLAGR

	DIMENSION NOLOGIN_BTIM(2),START_BTIM(2)

	CHARACTER DATETIME*17

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

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

	SETPRV = SETPRV_PRIV()		! SETPRV_PRIV rewrites TEMP_USER_

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

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

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

	FOLDER_PRESENT = CLI$PRESENT('FOLDER')N

	IF (FOLDER_PRESENT) THEND
	   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') 
           IF (.NOT.NEWS) THEN
	      CALL OPEN_BULLFOLDER_SHARED
	   ELSE
	      CALL OPEN_BULLNEWS_SHARED
	      CALL LOWERCASE(FOLDER1_NAME)T
	   END IF
	   CALL READ_FOLDER_FILE_KEYNAME_TEMP
     &				(FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)E
	   CALL CLOSE_BULLFOLDER
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR: Folder not found.'')')
	      RETURNS
	   END IF
	END IF)

	SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START')T
	IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN
	   IF (.NOT.NEWS) THEN
	      IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM)
	      IF (.NOT.IER) THENR
	         WRITE (6,'('' ERROR: Invalid date specified.'')')R
		 RETURN 
	      END IFO
	   ELSE
	      WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')')
	      RETURNP
	   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),S
     &				    STARTMSG,,%VAL(1))
	      IF (.NOT.IER) THENN
		 WRITE (6,'('' ERROR: Invalid number specified.'')')
		 RETURNT
	      END IFM
	   ELSE
	      WRITE (6,'('' ERROR: /START not valid with folder.'')')
	      RETURNT
	   END IF
	ELSE IF (SINCE) THEN_
	   IF (BULL_POINT.EQ.0) THENE
	      WRITE (6,'('' ERROR: No current message.'')')
	      RETURNP
	   ELSE IF (NEWS) THENC
	      STARTMSG = BULL_POINT
	   ELSE
	      START_BTIM(1) = MSG_BTIM(1)
	      START_BTIM(2) = MSG_BTIM(2)
	   END IF
	ELSE IF (.NOT.NEWS) THENR
	   CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM)
	ELSEK
	   STARTMSG = 1
	END IFT

	CALL DISABLE_CTRL
	CALL DECLARE_CTRLC_ASTT
	IF (FOLDER_PRESENT) THEN 
	   CALL OPEN_BULLINF_SHARED
	   IER = 0,
	   DO WHILE (IER.EQ.0.AND.FLAG.NE.1)_
	      IF (ALL) THEN
	         DO WHILE (REC_LOCK(IER))
	            READ (9,IOSTAT=IER) TEMP_USER,LAST_
	         END DO
	      ELSEY
		 IF (NEWS) THEND
		    LU = TRIM(TEMP_USER)
		    TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU)))B
		    IF (LU.GT.1) THEN)
		       TEMP_USER(LU-1:LU-1) =E
     &			        CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))D
		    ELSE
		       TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2)))
	 	    END IFF
	 	 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) THENT
	         LU = TRIM(TEMP_USER)
		 I = MAX(LU,2)
		 DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7))
		    I = I - 1S
		 END DOD
		 IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND.R
     &		     BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN'
		    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 = 0K
		    NEWSMSG = 1,
		    DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER,
     &					.AND.NEWSMSG.LE.FOLDER_MAX)
		       NEWSMSG = NEWSMSG + 1
	            END DO
		    IF (NEWSMSG.LE.FOLDER_MAX) THENK
		       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.K
		 END IF,
		 IF (FOUND.AND.NEWS) THENS
	            WRITE (6,'(1X,A,'' latest message read '',)
     &			I<LOG10(REAL(LAST(2,NEWSMSG)))+1>,''.'')')P
     &			TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG)
		 ELSE IF (FOUND) THEN
		    CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),)
	            WRITE (6,'(1X,A,'' latest message read '',A,''.'')'),
     &				TEMP_USER(:TRIM(TEMP_USER)),DATETIME
		 ELSE IF (.NOT.ALL) THEN
	            WRITE (6,'('' User has never read or not subscribed'',S
     &			'' to specified folder.'')')R
	         END IF
	      END IFY
	      IF (.NOT.ALL) THENG
		 IF (IER.NE.0) THENI
		    WRITE (6,'('' User info does not exist.'')')
		 END IFI
		 IER = 2
	      END IFB
	   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.'')')
	      ELSEA
	         CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)
	         WRITE (6,'('' User last logged in at '',A,''.'')')
     &						DATETIME
	      END IFG
	   ELSE
	      WRITE (6,'('' Entry for specified user not found.'')')Y
	   END IF
	   CALL CLOSE_BULLUSER
	ELSEC
	   CALL OPEN_BULLUSER_SHARED 
	   CALL READ_USER_FILE(IER)
	   DO WHILE (IER.EQ.0.AND.FLAG.NE.1)A
	      CALL READ_USER_FILE(IER) 
	      IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.T
     &				TEMP_USER(:1).NE.'*') THEN
		 IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)E
		 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) THENQ
	            CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,) 
	            WRITE (6,'(1X,A,'' last logged in at '',A,''.'')') 
     &				TEMP_USER(:TRIM(TEMP_USER)),DATETIME
		 END IFU
	      END IF 
	   END DO
	   CALL CLOSE_BULLUSER/
	END IF=
	CALL CANCEL_CTRLC_AST
	CALL ENABLE_CTRL 

	RETURN(
	END




	SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER)
C 
C  SUBROUTINE INIT_MESSAGE_ADD
C)
C  FUNCTION:  Opens specified folder in order to add message.I
C=
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_FROMG
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:t
C	IER - Error status.  True if properly connected to folder.
C		False if folder not found.
C 
	IMPLICIT INTEGER (A - Z) 

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	COMMON /BCP/ BULLCP
	LOGICAL BULLCP_

	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROB
	CHARACTER*12 PROTOCOL
	DATA LPRO/0/P

	COMMON /DIGEST/ LDESCR,FIRST_BREAKO

	CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIPL

	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP 
	COMMON /MAIN_HEADER_INFO/ INEXDATEE
	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/ SCRTYPEy
	DATA SCRTYPE/-1/h

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

        COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY
        CHARACTER*80 FOLDER1_DIRECTORY

	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 subprocessR

	CALL CHECK_DIR_ACCESS()

	CALL INIT_COMPRESSB

	FOLDER1_DIRECTORY = FOLDER_DIRECTORY

	IER = 1
	DO WHILE (IER.NE.0)
	   CALL OPEN_BULLFOLDER			! Get folder file

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

	   CALL CLOSE_BULLFOLDERp

	   IF (IER.NE.0) THEN
	      IER1 = 1A
	      DO WHILE (IER1)
	         IER2 = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',
     &			   FOLDER_DIRECTORY)e
	         IF (IER2.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN e
		    IER1 = 1
	         ELSE
		    IER1 = 0
		 END IF 
      	      END DO 
	      IF (IER2) THENi
		 CALL ADD_DIRECTORIESE
	      ELSE	
		 CALL ERRSNS(IDUMMY,IER)
	         RETURN
	      END IFl
	   END IF
	END DOC
	IER = 1

        FOLDER_NAME = FOLDER

	ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER)

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

	FIRST_BREAK = .TRUE. 

	IF (FOLDER_NUMBER.EQ.0) THEN	! If GENERAL folderL
	   FOLDER_SET = .FALSE.		! indicate itL
	ELSE				! Else it's another folder2
	   FOLDER_SET = .TRUE.		! indicate it
	END IFE

	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 filer

	CALL OPEN_BULLFIL		! Open data file

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

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

	LEN_FROM = TRIM(IN_FROM)N

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

	IF (LEN_FROM.EQ.0.OR.
     &		(BTEST(FOLDER_FLAG,11).AND.INDEX(FOLDER_DESCRIP,'<').GT.0)
     &		.OR.(BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK)) THEN
	   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) THEN&
	      OPEN (UNIT=3,DISPOSE='DELETE',FILE='BULL_DIR:BULL.SCR',
     &		FORM='FORMATTED',RECL=LINE_LENGTH,STATUS='NEW')
	      SCRTYPE = 1
	   END IF
	   SAVE_IN_DESCRIP = IN_DESCRIP
	   SAVE_IN_FROM = ' '
	END IF 

	IF (LEN_FROM.GT.0) THEN
	   INFROM = IN_FROM
	   IF (.NOT.BTEST(FOLDER_FLAG,5)) THENQ
	      CALL STORE_FROM(INFROM,LEN_FROM)a
	   ELSE	IF (INDEX(INFROM,'%"').GT.0) THEN	! Store any protocol(
	      LPRO = INDEX(INFROM,'%"') + 1
	      PROTOCOL = INFROM(:LPRO)F
	   END IF
	   LEN_DESCRP = TRIM(IN_DESCRIP)0
	   IF (LEN_DESCRP.GT.0) THENK
	      INDESCRIP = IN_DESCRIPk
	      IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
	         CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)K
	      END IF 
	   ELSE
	      DESCRIP = ' '
	   END IF
	END IF

	OLD_BUFFER = ' '$

	OLD_BUFFER_SUBJ = .FALSE.
	OLD_BUFFER_FROM = .FALSE.

	INEXDATE = .FALSE.P

	RETURN
	END



	SUBROUTINE WRITEOUT_STOREDt

	IMPLICIT INTEGER (A-Z)=

	INCLUDE 'BULLFOLDER.INC'l

	CHARACTER*256 BUFFERu

	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)) RETURN 
	IF (.NOT.BTEST(FOLDER_FLAG,11)) CLOSE (UNIT=3)E
        IF (BTEST(FOLDER_FLAG,11)) REWIND (UNIT=3)

	RETURN 
	END



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

	IMPLICIT INTEGER (A-Z)T

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'U

	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROL
	CHARACTER*12 PROTOCOL

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

	COMMON /DIGEST/ LDESCR,FIRST_BREAK:
	DATA FIRST_BREAK/.TRUE./t

	COMMON /TEXT_PRESENT/ TEXT

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

	CHARACTER*(*) BUFFERo

	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_LINE/

	CHARACTER*24 TODAY,

	DATA STORED /.FALSE./ 0

	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) THENE
	      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)
	      RETURN 
	   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:)_
	      OLD_BUFFER_FROM = .TRUE.E
	      OLD_BUFFER_SUBJ = .FALSE.
	      RETURN 
	   ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN
	      LDESCR = LEN_BUFFER - 9
	      INDESCRIP = BUFFER(10:)
	      OLD_BUFFER_SUBJ = .TRUE. 
	      OLD_BUFFER_FROM = .FALSE.
	      RETURNc
	   ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN
	      IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)T
	      OLD_BUFFER_FROM = .TRUE. 
	      OLD_BUFFER_SUBJ = .FALSE.
	      RETURNE
	   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) THENE
		    LPRO = INDEX(INFROM,'%"') + 1n
		    PROTOCOL = INFROM(:LPRO)
		 END IFt
		 IF (LDESCR.GT.0) THEN
		    LEN_DESCRP = LDESCR
	            CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
		 ELSE 
	            LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)n
	            IF (LEN_DESCRP.GT.0) THEN
	               INDESCRIP = SAVE_IN_DESCRIPU
	               IF (.NOT.BTEST(FOLDER_FLAG,5)) THENE
	                  CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
	               END IF
	            ELSE'
		       DESCRIP = ' '
		    END IF
		 END IFL
	         STORED = .TRUE.r
	         IF (.NOT.BTEST(FOLDER_FLAG,5)) CALL WRITEOUT_STOREDZ
	         STORED = .FALSE.
	      END IFf
	   END IF
	   OLD_BUFFER_FROM = .FALSE.	
	   OLD_BUFFER_SUBJ = .FALSE.f
	   RETURN
	END IFu
	IF (BTEST(FOLDER_FLAG,5)) THEN
	   IF (INDEX(BUFFER,'-------------').EQ.1) THEN
	      BREAK = .TRUE.E
	      DO I=1,LEN_BUFFER
		 IF (BUFFER(I:I).NE.'-') BREAK = .FALSE.
	      END DO 
	   ELSE
	      BREAK = .FALSE.
	   END IF
	   IF (BREAK) THEN 
	      IF (.NOT.FIRST_BREAK) THEN0
		 CALL FINISH_MESSAGE_ADD
	         CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER)
	      ELSEP
		 FIRST_BREAK = .FALSE.
                 CLOSE (UNIT=3)O
	      END IFT
	      LFROM = 0
	      LDESCR = 0 
	      RETURNe
	   ELSE IF (.NOT.FIRST_BREAK) THENL
	      IF (LDESCR.EQ.0) THEN
	         IF (BUFFER(:9).EQ.'Subject: ') THENc
		    LDESCR = LEN_BUFFER - 9!
	            CALL STORE_DESCRP(BUFFER(10:),LDESCR)
		    IF (LFROM.EQ.0) THEN
		       LFROM = LEN_FROM)
	               CALL STORE_FROM(INFROM,LFROM)T
		    END IF
		 ELSE IF (BUFFER(:6).EQ.'From: ') THEN
		    LFROM = LEN_BUFFER - 6
		    IF (LFROM.LE.0) THEN
		       LFROM = TRIM(SAVE_IN_FROM)R
		       IF (LPRO.GT.0) THEN
		          LFROM = LFROM + LPRO + 1
	                  CALL STORE_FROM(PROTOCOL(:LPRO)//
     &			   SAVE_IN_FROM//'"',LFROM)
		       ELSEE
	                  CALL STORE_FROM(SAVE_IN_FROM,LFROM)
		       END IFV
		    ELSE IF (LPRO.GT.0) THEN
		       LFROM = LFROM + LPRO + 1R
	               CALL STORE_FROM(PROTOCOL(:LPRO)//A
     &			BUFFER(7:LEN_BUFFER)//'"',LFROM)E
		    ELSE
	               CALL STORE_FROM(BUFFER(7:),LFROM)I
		    END IF
		 END IFH
		 RETURNT
	      END IF 
	   ELSE
	      IF (LEN_BUFFER.GT.0) THEN
	         WRITE (3,'(A)') BUFFER(:MIN(LEN_BUFFER,LINE_LENGTH))
	      ELSEH
		 WRITE (3,'(A)') ' '
	      END IFa
	      TEXT = .TRUE.
	      RETURN
	   END IF
	END IFU

	IF (LEN_BUFFER.EQ.0) THEN		! If empty lineo
	   CALL STORE_BULL(1,' ',NBLOCK)	! just store one space
	ELSE 
	   IF (LEN_DESCRP.EQ.0) THENL
	      IF (BUFFER(:9).EQ.'Subject: ') THEN
		 DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)
		 LEN_DESCRP = LEN_BUFFER
	      END IFT
	   END IF
	   IF (.NOT.INEXDATE) THEN/
	      IF (BUFFER(:9).EQ.'Expires: '.OR.
     &		  BUFFER(:11).EQ.'X-Expires: ') THEN
		 I = INDEX(BUFFER,' ')+1
		 NODATE = .FALSE. 
		 DO J=I,LEN_BUFFER
		    IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN
		       BUFFER(J:J) = ' '
		    END IF
		 END DO
	         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)L
		    IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN=
		       IF (NODATE) THENE
			  IF (INDEX(BUFFER(I:),' ').EQ.2) THENE
			     EXDATE(1:2) = '0'//BUFFER(I:I)
			     I = I + 1 
			  ELSE(
			     EXDATE(1:2) = BUFFER(I:I+1))
			     I = I + 2_
			  END IFE
			  NODATE = .FALSE.$
		       ELSEE
			  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:),'-')Q
			     EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1)
			     I = I + 2	
			  ELSE
			     EXDATE(8:) = BUFFER(I:I+3)
			     I = I + 4P
			  END IFR
		       END IFB
		    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 DOL
		 INEXDATE = .TRUE.
	      END IFR
	   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 IFA

	RETURNL
	END




	SUBROUTINE FINISH_MESSAGE_ADD
CT
C  SUBROUTINE FINISH_MESSAGE_ADD
C(
C  FUNCTION:  Writes message entry into directory file and closes folder
CN
C  NOTE:  Only should be run if INIT_MESSAGE_ADD was successful.
C 

	IMPLICIT INTEGER (A-Z)U

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'U

	COMMON /DIGEST/ LDESCR,FIRST_BREAKF

	COMMON /SCRTYPE/ SCRTYPE 

	COMMON /TEXT_PRESENT/ TEXTI

	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPB
	COMMON /MAIN_HEADER_INFO/ INEXDATEF
	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 TODAY 

	CHARACTER USER_SAVE*12)

	DIMENSION BIN_EXTIME(2)

	IF (TEXT.AND.BTEST(FOLDER_FLAG,5).AND.FIRST_BREAK) THEN
	   IF (LEN_FROM.GT.0) THENE
	      CALL STORE_FROM(INFROM,LEN_FROM) 
	   ELSE
	      CALL GETUSER(FROM) 
	      INFROM = FROM
	      LEN_FROM = TRIM(INFROM)
	   END IF
	   IF (LEN_DESCRP.GT.0) THENE
	      CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
	   END IF
	   LDESCRP = 1_
	   FIRST_BREAK = .FALSE.'
	   CALL WRITEOUT_STORED
	   CLOSE (UNIT=3)
	ELSE IF (LEN_FROM.EQ.0) THENE
	   CALL GETUSER(FROM)
	   INFROM = FROM 
	   LEN_FROM = TRIM(INFROM) 
	   LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)
	   IF (LEN_DESCRP.GT.0) THEN(
	      INDESCRIP = SAVE_IN_DESCRIP
	      IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
	         CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)r
	      END IF_
	   ELSE
	      DESCRIP = ' '
	   END IF
	   CALL WRITEOUT_STORED
	END IF6

	CALL FLUSH_BULL(NBLOCK)

	CALL CLOSE_BULLFIL			! Finished adding bulletin

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

	EXTIME = '00:00:00.00'E
	IF (INEXDATE) THEN 
	   IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME)
	   IF (IER) THEN			! If good date format 
	      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?
     &		.OR.IER.LE.0) THEN		! or expiration date not future 
	         INEXDATE = .FALSE.		! Don't use it
	      END IF 
	   ELSE
	      INEXDATE = .FALSE.		! Don't use it	
	   END IF
	END IF_

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

	LENGTH = NBLOCK - LENGTH + 1		! Number of records

	CALL ADD_ENTRY				! Add the new directory entry

	CALL CLOSE_BULLDIR			! Totally finished with addE

	CALL UPDATE_FOLDERM

	IF (BTEST(FOLDER_FLAG,11).AND.SCRTYPE.GE.0) THEN
	   SLIST = INDEX(FOLDER_DESCRIP,'<')_
	   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)O
              CALL ADD_PROTOCOL(INPUT,ILEN) 
	      CLOSE (UNIT=3,STATUS='SAVE')E
              USER_SAVE = USERNAME
	      USERNAME = FOLDER
	      IF (CONFIRM_USER(USERNAME).EQ.0) THEN
	        CALL SETUSER(USERNAME)_
	      END IF	
	      IF (SYS_TRNLNM('MX_NODE_NAME','DEFINED')) THEND
	         IER = LIB$SET_LOGICALF
     &			('MX_REPLY_TO',INFROM(:TRIM(INFROM)))
	      ELSE IF (SYS_TRNLNM('PMDF_ROOT','DEFINED')) THEN 
	         IER = LIB$SET_LOGICALG
     &			('PMDF_REPLY_TO',INFROM(:TRIM(INFROM)))
	      ELSE IF (FOLDER1_BBOARD(:4).NE.'NONE') THEN
		 USERNAME = FOLDER_BBOARD(
	      END IFT
	      IF (SCRTYPE.EQ.0) THEN 
	         CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INPUT,.
     &	   	   	   INDESCRIP(:LEN_DESCRP),STATUS)
                 CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')N
	      ELSE 
	         CALL RESPOND_MAIL('BULL.SCR',INPUT,D
     &	   	   	   INDESCRIP(:LEN_DESCRP),STATUS)
                 CALL LIB$DELETE_FILE('BULL.SCR;*')I
	      END IF 
	      CALL SETUSER(USER_SAVE)
	      USERNAME = USER_SAVES
	   ELSE
	      CLOSE (UNIT=3)A
	   END IF
	   SCRTYPE = -1
	END IF	

	RETURNI
	END




	SUBROUTINE STORE_FROM(IFROM,LEN_INFROM)

	IMPLICIT INTEGER (A-Z)U

	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROF
	CHARACTER*12 PROTOCOL

	INCLUDE 'BULLDIR.INC'

	CHARACTER*(*) IFROM

	CHARACTER*(INPUT_LENGTH) INFROM

	INFROM = IFROMe

	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)//'"'F
	      I = LPRO + 1X
	      LEN_INFROM = LEN_INFROM + LPRO + 10
	   END IF
	   DO WHILE (I.LT.LEN_INFROM)
	      IF (INFROM(I:I).EQ.'"') THEN 
		 INFROM(I:I) = ''''F
	      ELSE IF (INFROM(I:I).EQ.'\') THEN
		 INFROM(I+1:) = '\'//INFROM(I+1:)S
		 LEN_INFROM = LEN_INFROM + 1
		 I = I + 1
	      ELSE IF (INFROM(I:I).EQ.''''.AND.
     &		       INDEX(INFROM,'@').GT.I) THENA
		 INFROM(I:) = '\s'//INFROM(I+1:)
		 LEN_INFROM = LEN_INFROM + 1
		 I = I + 2
	      END IFO
	      I = I + 1
	   END DO
	END IF_

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

	DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ')S
	   INFROM = INFROM(2:)R
	   LEN_INFROM = LEN_INFROM - 1,
	END DOX

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

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

	IF (INDEX(INFROM,'%"').GT.0)		! Strip off protocol programE
     &		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)N

	RETURNL
	END


	SUBROUTINE GET_FROM(INFROM,LEN_INFROM)'

	IMPLICIT INTEGER (A-Z)T

	INCLUDE 'BULLDIR.INC'

	CHARACTER*(*) INFROMF

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

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

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

	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 + 1T
	END DO 
	INFROM = INFROM(I:)
	J = LEN_INFROM - I + 1R

	I = 1		! Trim username to end at a alpha characterO
	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.'''')d
	   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'))) THEN)
	      FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a'))N
	   END IF
	END DOS

	RETURN6
	END




	SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP)

	IMPLICIT INTEGER (A-Z)T

	INCLUDE 'BULLDIR.INC'

	CHARACTER*(*) INDESCRIP

	CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP)

	DO I=1,LEN_DESCRP			! Remove control characters
	   IF (INDESCRIP(I:I).LT.' '.OR.ICHAR(INDESCRIP(I:I)).GT.127)
     &			INDESCRIP(I:I) = ' 'S
	END DO 

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

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

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

	RETURN_
	END





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

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

	COMMON /DATE/ DATE_LINE
	CHARACTER*(INPUT_LENGTH) DATE_LINE 

	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.T
	   RETURN
	END IF=

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

	IER = .TRUE.N

	IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR.   ! If line is continuationS
     &		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 continuationM
	      IF (REMOTE_SET.LT.3.AND.BUFFER(:5).EQ.'Date:') THEN
		 DATE_LINE = 'Message sent'//BUFFER(5:BLEN)E
		 IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THENs
		    DATE_LINE(TRIM(DATE_LINE)+1:) = '.'E
	         END IF
	      END IFE
	      RETURNL
	   ELSE
	      I = I + 1
	   END IF
	END DO 

	IER = .FALSE.
	CONT_LINE = .FALSE.

	RETURNd
	END
