	program send

*   The send program was written to eliminate the need to have the DEC
*   command REPLY installed with OPER privilege.  
*    
*   Author: Linda Chumbley - 7-Oct-1985
*           
*   VAX/VMS Version 4.1 - Fortran Version 4.2

	structure	/namelst/
	  integer*2	buflen,
     *    		code
	  integer*4	bufadr,
     *			retlenadr,
     *                  end_list /0/
	end structure
	record		/namelst/ jpi_list
	character*15	name
	integer*4	name_len
	
	integer*4	status, 
     *			sys$brkthruw,
     *			cli$present,
     *			cli$get_value,
     *			sys$getjpi

	include         '($ssdef)'
	include		'($clidef)'
	include		'($brkdef)'
	include		'($jpidef)'
	integer*2	iosb(4)          
	integer*4	receive_type, qual_size, msg_size, name_size
	integer*4	screen_flags
	character	time_now*5
	character       message*132
	character	qual_value*64
	character       bel*1
	parameter	(bel = char(7))

	call sys$asctim (, time_now,, %val(1))
	name = ' '
	receive_type = 0
	if (.not. cli$get_value ('p1', message, )) call lib$signal(%val(status))
	if (cli$present ('terminal')) then
           status = cli$get_value('terminal', qual_value, )
	   receive_type = brk$c_device
	end if
	if (cli$present ('user')) then
           status = cli$get_value('user', qual_value, )
	   receive_type = brk$c_username
	end if
	call str$trim (qual_value, qual_value, qual_size)
	jpi_list.buflen = 12
	jpi_list.code = jpi$_username
	jpi_list.bufadr = %loc (name)
	jpi_list.retlenadr = %loc (name_len)
	status = sys$getjpi(, , , jpi_list, , ,)
	if (.not. status) call lib$signal(%val(status))
	call str$trim (name, name, name_size)
	if (cli$present ('bell')) then 
            message = '%SEND: ' // bel // time_now // ' - User: '
     *                // name (1:name_size) // ' - ' // message
        else
          message = '%SEND: ' // time_now // ' - User: ' 
     *              // name (1:name_size) // ' - ' // message
	end if
	call str$trim (message, message, msg_size)

	screen_flags = brk$m_screen .or. brk$m_bottom
        status = sys$brkthruw( , %descr(message(:msg_size)),
     *			         %descr(qual_value(:qual_size)),
     *                           %val(receive_type),
     *                           iosb, %val(48), %val(screen_flags),
     *                           %val(brk$c_user1), 5, ,)
	if (.not. status) call lib$signal(%val(status))
	if (.not. iosb(1)) call lib$signal(%val(status))
	if (cli$present ('log')) type 100, iosb(2), iosb(3), iosb(4)
100	format (/, ' %SEND-I-SNDLOG, Log of SEND Message',/,
     *          4x,i3,' Successful Deliveries'/,
     *		4x,i3,' Time Outs',/,
     *		4x,i3,' Deliveries Rejected')
	end
