.title	'Send Mail Subroutine'
;
;
;		S M A I L . S B L
;
;

FUNCTION	SNDMA	,%VAL
ADDRESS		,A	;ADDRESS of this message or the To: party
SUBJECT		,A	;Subject of this message
MESSAGE		,A	;Message of File Specification if @ present in string

EXTERNAL	FUNCTION
	MAIL$SEND_BEGIN		,%VAL
	MAIL$SEND_END		,%VAL
	MAIL$SEND_MESSAGE	,%VAL
	MAIL$SEND_ADD_ATTRIBUTE	,%VAL
	MAIL$SEND_ADD_BODYPART	,%VAL
	MAIL$SEND_ADD_ADDRESS	,%VAL
	SYS$GETJPIW		,%VAL
	.page
.include	'maildef.dib'
	.page
.include	'mailmsgdef.dib'
	.page
.include	'$jpidef'	library	'sys$library:dblstarlet'
	.page
RECORD
	GROUP	IN_ITEM_LIST	,[5]A
		Buff_Length	,I2
		Item_Code	,I2
		Buffer_Addr	,I4
		Return_Length	,I4
	ENDGROUP
	In_End_Of_List		,I4

RECORD
	GROUP	OUT_ITEM_LIST	,[5]A
		Buff_Length	,I2
		Item_Code	,I2
		Buffer_Addr	,I4
		Return_Length	,I4
	ENDGROUP
	Out_End_Of_List		,I4


RECORD
SEND_CONTEXT		,I4	;Context Returned from Call to SEND routines
STATUS			,I4	;Status Returned from Call
TEXT			,A80	;Message Text of this Mail Message Record
TEXT_LENGTH		,I4	;Length of "TEXT"
COUNTER			,I2	;Counter for loop control
MESSAGE_ID		,I4	;Message ID
ZERO			,I2,0	;Zero
CURRENT_USERNAME	,A12	;Current Username
CU_LENGTH		,I4	;Length of "CURRENT_USERNAME"
ERROR			,D3	;Error Number
IOSB			,[4]I2	;I/O Status Block
ADDRESS_LEN		,I1	;Length of "ADDRESS" Argument
SUBJECT_LEN		,I1	;Length of "SUBJECT" Argument
MESSAGE_LEN		,I2	;Length of "MESSAGE" Argument
FILENAME		,A80	;File Specification of message to be mailed
FILENAME_LEN		,I1	;Length of File Specification to be mailed
DEF_FILE_EXT		,A4,'.TXT'	;Default File Extension (.TXT)
DEF_FILE_EXT_LEN	,I1,4	;Length of Default File Extension (.TXT)
RESULT_FILE_SPEC	,A80	;Returned File Specification
RESULT_FILE_SPEC_LEN	,I1	;Length of Returned File Specification
ALREADY_OPEN		,I1	;Flag indicating status of current channel
				;	0 - Not Yet Opened
				;	1 - Already Opened
NEXT_AVAILABLE_CHANNEL	,I2,99	;Next Available Channel Number
MESSAGE_FILE		,A80	;File Specification to be mailed
MESSAGE_FILE_LEN	,I1	;Length of "MESSAGE_FILE"
FILE_TO_SEND		,I1	;Switch indicating nature of "MESSAGE" Argument
				;	0 - Message Text (255 Chars max)
				;	1 - File name to be mailed
FUNCTION_ERROR		,I4	;Return Error Code


	PROC

	XCALL FLAGS (0001000000)

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$SEND_BEGIN (%REF(Send_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = %SIZE(CURRENT_USERNAME)
	In_Item_List[1].Item_Code = JPI$_USERNAME
	In_Item_List[1].Buffer_Addr = %ADDR(CURRENT_USERNAME)
	In_Item_List[1].Return_Length = %ADDR(CU_LENGTH)

	In_End_Of_List = Zero

	Status = %SYS$GETJPIW (,,,%REF(In_Item_list),%REF(IOSB),,)
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))
	.subtitle	'Parse MESSAGE Argument'
PARSE_MESSAGE,

	FILE_TO_SEND = %INSTR (1,MESSAGE,'@')	;Look for the @
	MESSAGE_LEN = %SIZE (MESSAGE)	;Get length of MESSAGE argument passed
	ADDRESS_LEN = %SIZE (ADDRESS)	;Get length of ADDRESS argument passed
	SUBJECT_LEN = %SIZE (SUBJECT)	;Get length of SUBJECT argument passed
	IF (FILE_TO_SEND .AND. FILE_TO_SEND .LT. MESSAGE_LEN)
	BEGIN
	DO				;Search for available channel number
		BEGIN
		INCR NEXT_AVAILABLE_CHANNEL
		XCALL DBL$CHOPEN (NEXT_AVAILABLE_CHANNEL,ALREADY_OPEN)
		END
	UNTIL .NOT. ALREADY_OPEN
	INCR FILE_TO_SEND
	MESSAGE_FILE_LEN = MESSAGE_LEN - 1
	MESSAGE_FILE(1:MESSAGE_FILE_LEN) = MESSAGE(FILE_TO_SEND:MESSAGE_LEN)
	ONERROR OPEN_ERROR
	OPEN (NEXT_AVAILABLE_CHANNEL,I,MESSAGE_FILE(1:MESSAGE_FILE_LEN))
	OFFERROR
	CLOSE NEXT_AVAILABLE_CHANNEL
	END
	.subtitle	'Add Attributes to Header'
ADD_ATTRIBUTES_TO_HEADER,

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = ADDRESS_LEN
	In_Item_List[2].Item_Code = MAIL$_SEND_TO_LINE
	In_Item_List[2].Buffer_Addr = %ADDR(ADDRESS(1:ADDRESS_LEN))
	In_Item_List[2].Return_Length = Zero

	In_Item_List[3].Buff_Length = CU_LENGTH
	In_Item_List[3].Item_Code = MAIL$_SEND_FROM_LINE
	In_Item_List[3].Buffer_Addr = %ADDR(CURRENT_USERNAME(1:CU_LENGTH))
	In_Item_List[3].Return_Length = Zero

	In_Item_List[4].Buff_Length = SUBJECT_LEN
	In_Item_List[4].Item_Code = MAIL$_SEND_SUBJECT
	In_Item_List[4].Buffer_Addr = %ADDR(SUBJECT(1:SUBJECT_LEN))
	In_Item_List[4].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$SEND_ADD_ATTRIBUTE (%REF(Send_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))
	.subtitle	'Address Message'
ADDRESS_MESSAGE,

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = ADDRESS_LEN
	In_Item_List[2].Item_Code = MAIL$_SEND_USERNAME
	In_Item_List[2].Buffer_Addr = %ADDR(ADDRESS(1:ADDRESS_LEN))
	In_Item_List[2].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$SEND_ADD_ADDRESS (%REF(Send_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) FUNCTION_ERROR = Status	;Bad "TO:"
	.subtitle	'Format Message'
FORMAT_MESSAGE,

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	IF (FILE_TO_SEND) THEN
	BEGIN

	In_Item_List[2].Buff_Length = MESSAGE_FILE_LEN
	In_Item_List[2].Item_Code = MAIL$_SEND_FILENAME
	In_Item_List[2].Buffer_Addr = %ADDR(MESSAGE_FILE(1:MESSAGE_FILE_LEN))
	In_Item_List[2].Return_Length = Zero

	Out_Item_List[1].Buff_Length = %SIZE(RESULT_FILE_SPEC)
	Out_Item_List[1].Item_Code = MAIL$_SEND_RESULTSPEC
	Out_Item_List[1].Buffer_Addr = %ADDR(RESULT_FILE_SPEC)
	Out_Item_List[1].Return_Length = %ADDR(RESULT_FILE_SPEC_LEN)

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	END
	ELSE
	BEGIN

	In_Item_List[2].Buff_Length = MESSAGE_LEN
	In_Item_List[2].Item_Code = MAIL$_SEND_RECORD
	In_Item_List[2].Buffer_Addr = %ADDR(MESSAGE(1:MESSAGE_LEN))
	In_Item_List[2].Return_Length = Zero

	In_End_Of_List = Zero

	END
	Status = %MAIL$SEND_ADD_BODYPART (%REF(Send_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))
	.subtitle	'Send Message'
SEND_MESSAGE,

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$SEND_MESSAGE (%REF(Send_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

CLEAN_UP_AND_RETURN,

	CALL CLEANUP
	XRETURN FUNCTION_ERROR
	.subtitle	'Clear Item List Arrays'
CLEAR_ITEM_LISTS,

	CLEAR Counter

	FOR Counter FROM 1 THRU 5

	BEGIN
		CLEAR In_Item_list[Counter].Buff_Length
		CLEAR In_Item_List[Counter].Item_Code
		CLEAR In_Item_List[Counter].Buffer_Addr
		CLEAR In_Item_List[Counter].Return_Length

		CLEAR Out_Item_list[Counter].Buff_Length
		CLEAR Out_Item_List[Counter].Item_Code
		CLEAR Out_Item_List[Counter].Buffer_Addr
		CLEAR Out_Item_List[Counter].Return_Length
	END

	RETURN
	.subtitle	'Cleanup and Exit'
CLEANUP,

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$SEND_END (%REF(Send_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))

	RETURN
	.subtitle	'File Open Error'
OPEN_ERROR,

	OFFERROR
	Error = %ERROR
	; Possibilities
	;
	;	17 $ERR_FILSPC - Illegal Characters in File Specification
	;
	;	22 $ERR_IOFAIL - Hardware problem.
	;
	;	24 $ERR_NOSPAC - No space for file
	;
	;	32 $ERR_REPLAC - Already Exists
	;
	CALL CLEAR_ITEM_LISTS

	CLOSE NEXT_AVAILABLE_CHANNEL

	FUNCTION_ERROR = Error		;Return File Open Error

	GOTO CLEAN_UP_AND_RETURN