PROGRAM FTN_MEGA_MAIL
	IMPLICIT NONE


	!
	!  Example program for sending mail from FORTRAN
	!

	INCLUDE '(LIB$ROUTINES)'
	INCLUDE '($MAILDEF)'
	INCLUDE '(MAIL$ROUTINES)'


	STRUCTURE /ITMLST/
	  UNION
	    MAP
	        INTEGER*2   BUFFER_LENGTH
	        INTEGER*2   ITEM_CODE
	        INTEGER*4   BUFFER_ADDRESS
	        INTEGER*4   RETURN_LENGTH
	    END MAP
	    MAP
	        INTEGER*4   TERMINATOR
	    END MAP
	  END UNION
	END STRUCTURE

        INTEGER*4 LIB$GET_LOGICAL
        EXTERNAL  LIB$GET_LOGICAL

!;;;;;
!       Constants we need
!;;;;;


!;;;;;
!	Local variables
!;;;;;
	INTEGER     L_CONTEXT, L_STAT
	INTEGER*2   W_X

	CHARACTER*255   TO_STR, FROM_STR, SUBJECT_STR
        CHARACTER*255   TEXT_FILE, TRANSLATED_NAME


	RECORD  /ITMLST/MAIL_ITEM_1(5), MAIL_ITEM_2(5)


!;;;;;;;;;;
!	Main Logic
!;;;;;;;;;;

	!  Initialize the send
	!
100	L_STAT = MAIL$SEND_BEGIN( L_CONTEXT, 0, 0)
	IF (JIAND( L_STAT, 1).EQ.0) THEN
	    PRINT *, 'Error initializing mail interface'
	    PRINT *, 'Error code ', L_STAT
	    CALL SYS$EXIT( L_STAT)
	END IF

	!   Build the attributes
	!
200	TO_STR                  = 'MEGA_SUPPORT_LIST'
	FROM_STR                = 'HUGHES'
	SUBJECT_STR             = 'MEGA System Notification'

	MAIL_ITEM_1(1).BUFFER_LENGTH    = LEN_TRIM( TO_STR)
	MAIL_ITEM_1(1).ITEM_CODE        = MAIL$_SEND_TO_LINE
	MAIL_ITEM_1(1).BUFFER_ADDRESS   = %LOC(TO_STR)
	MAIL_ITEM_1(1).RETURN_LENGTH    = 0

	MAIL_ITEM_1(2).BUFFER_LENGTH    = LEN_TRIM( FROM_STR)
	MAIL_ITEM_1(2).ITEM_CODE        = MAIL$_SEND_FROM_LINE
	MAIL_ITEM_1(2).BUFFER_ADDRESS   = %LOC(FROM_STR)
	MAIL_ITEM_1(2).RETURN_LENGTH    = 0

	MAIL_ITEM_1(3).BUFFER_LENGTH    = LEN_TRIM( SUBJECT_STR)
	MAIL_ITEM_1(3).ITEM_CODE        = MAIL$_SEND_SUBJECT
	MAIL_ITEM_1(3).BUFFER_ADDRESS   = %LOC(SUBJECT_STR)
	MAIL_ITEM_1(3).RETURN_LENGTH    = 0
	
	MAIL_ITEM_1(4).TERMINATOR       = 0


	L_STAT = MAIL$SEND_ADD_ATTRIBUTE( L_CONTEXT, MAIL_ITEM_1, 0)

	IF (JIAND( L_STAT, 1).EQ.0) THEN
	    PRINT *, 'Error setting up mail header'
	    PRINT *, 'Error code ', L_STAT
	    CALL SYS$EXIT( L_STAT)
	END IF

	! Add message body
	!
300	TEXT_FILE                       = 'HELLO.TXT'
	MAIL_ITEM_2(1).BUFFER_LENGTH    = LEN_TRIM( TEXT_FILE)
	MAIL_ITEM_2(1).ITEM_CODE        = MAIL$_SEND_FILENAME
	MAIL_ITEM_2(1).BUFFER_ADDRESS   = %LOC( TEXT_FILE)
	MAIL_ITEM_2(1).RETURN_LENGTH    = 0

	L_STAT = MAIL$SEND_ADD_BODYPART( L_CONTEXT, MAIL_ITEM_2, 0)


	IF (JIAND( L_STAT, 1).EQ.0) THEN
	    PRINT *, 'Error creating message body'
	    PRINT *, 'Error code ', L_STAT
	    CALL SYS$EXIT( L_STAT)
	END IF


	! Now we have to actually fill in the addresses
	! Mail does not use the address information setup
	! in the message header.
	!
400	TRANSLATED_NAME = ' '

	L_STAT = LIB$GET_LOGICAL( TRIM(TO_STR), TRANSLATED_NAME,,,,,)

	IF ( TRANSLATED_NAME(1:1) .EQ. ' ') THEN
	    CALL FTN_ADD_MAIL_ADDRESS( TO_STR, L_CONTEXT)
	ELSE
	    CALL FTN_PARSE_MAIL_LOGICAL( TRANSLATED_NAME, L_CONTEXT)
	END IF

	! Send the message
	!
500	L_STAT = MAIL$SEND_MESSAGE( L_CONTEXT, 0, 0)


	IF (JIAND( L_STAT, 1).EQ.0) THEN
	    PRINT *, 'Error creating message body'
	    PRINT *, 'Error code ', L_STAT
	    CALL SYS$EXIT( L_STAT)
	END IF

	! Clean up
	!
600	L_STAT = MAIL$SEND_END( L_CONTEXT, 0, 0)

	IF (JIAND( L_STAT, 1).EQ.0) THEN
	    PRINT *, 'Error ending mail interface'
	    PRINT *, 'Error code ', L_STAT
	    CALL SYS$EXIT( L_STAT)
	END IF

	STOP
	END

!;;;;;;;;;;
!   Subroutine to parse the mail logical translated value
!;;;;;;;;;;
	SUBROUTINE FTN_PARSE_MAIL_LOGICAL( THE_STR, L_CONTEXT)
	IMPLICIT NONE

	CHARACTER*(*) THE_STR
        INTEGER       L_CONTEXT


        CHARACTER*255 WORK_STR, TO_STR
        INTEGER       L_COMMA



        WORK_STR = THE_STR

        DO 800, WHILE (LEN_TRIM( WORK_STR) .GT. 0)

            L_COMMA = INDEX( WORK_STR, ',')

            !
            !  Last name won't have a comma
            !
            IF (L_COMMA > 0) THEN
                TO_STR = WORK_STR(1:L_COMMA-1)
                WORK_STR = WORK_STR(L_COMMA+1:LEN(WORK_STR))
            ELSE
                TO_STR = WORK_STR
                WORK_STR = ' '
            END IF

            CALL FTN_ADD_MAIL_ADDRESS( TO_STR, L_CONTEXT)

800     CONTINUE


	RETURN
	END
!;;;;;;;;;;
!   Subroutine to add a new username to email destination
!;;;;;;;;;;
        SUBROUTINE FTN_ADD_MAIL_ADDRESS( THE_STR, L_CONTEXT)
        IMPLICIT NONE

        CHARACTER*(*) THE_STR
        INTEGER       L_CONTEXT



	INCLUDE '($MAILDEF)'
	INCLUDE '(MAIL$ROUTINES)'

	STRUCTURE /ITMLST/
	  UNION
	    MAP
	        INTEGER*2   BUFFER_LENGTH
	        INTEGER*2   ITEM_CODE
	        INTEGER*4   BUFFER_ADDRESS
	        INTEGER*4   RETURN_LENGTH
	    END MAP
	    MAP
	        INTEGER*4   TERMINATOR
	    END MAP
	  END UNION
	END STRUCTURE


        RECORD /ITMLST/ITM1(5)

        INTEGER*2     W_USER_TYPE
        INTEGER       L_STAT



        ITM1(1).BUFFER_LENGTH   = LEN_TRIM( THE_STR)
        ITM1(1).ITEM_CODE       = MAIL$_SEND_USERNAME
        ITM1(1).BUFFER_ADDRESS  = %LOC( THE_STR)
        ITM1(1).RETURN_LENGTH   = 0

        W_USER_TYPE             = MAIL$_TO

        ITM1(2).BUFFER_LENGTH   = 2 !size of word
        ITM1(2).ITEM_CODE       = MAIL$_SEND_USERNAME_TYPE
        ITM1(2).BUFFER_ADDRESS  = %LOC( W_USER_TYPE)
        ITM1(2).RETURN_LENGTH   = 0

        ITM1(3).TERMINATOR      = 0

        L_STAT = MAIL$SEND_ADD_ADDRESS( L_CONTEXT,ITM1, 0)


	IF (JIAND( L_STAT, 1).EQ.0) THEN
	    PRINT *, 'Error adding user ', THE_STR
	    PRINT *, 'Error code ', L_STAT
	    CALL SYS$EXIT( L_STAT)
	END IF

        RETURN
        END