5.1 Sample LANSA Email Function

This example of a LANSA function will generically copy an IBM i spooled file (i.e. a report) and email it to a nominated address. If you have Visual LANSA you can directly cut-and-paste this example into your system and then check it into your IBM i:

FUNCTION OPTIONS(*DIRECT);

********** COMMENT();

********** COMMENT(Fields that the caller can optionally exchange in);

********** COMMENT(which should really be defined in the dictionary);

********** COMMENT();

DEFINE FIELD(#EMSPLFN) TYPE(*CHAR) LENGTH(010) DESC('Report IBM i Spooled File Name') DEFAULT([email protected]);

DEFINE FIELD(#EMSPLFD) TYPE(*CHAR) LENGTH(001) DESC('Delete Spooled File at Completion') DEFAULT(N);

DEFINE FIELD(#EMORIGIN) TYPE(*CHAR) LENGTH(060) DESC('Email Originator Name') DEFAULT(*FUNCTION);

DEFINE FIELD(#EMRECPNT) TYPE(*CHAR) LENGTH(060) DESC('Email Recpient Name') DEFAULT(*BLANKS);

DEFINE FIELD(#EMSUBJECT) TYPE(*CHAR) LENGTH(060) DESC('Email Subject') DEFAULT(*BLANKS);

********** COMMENT();

********** COMMENT(Local Fields for this function);

********** COMMENT();

DEFINE FIELD(#EMLINE) TYPE(*CHAR) LENGTH(132) DESC('Line of the report');

DEFINE FIELD(#EMRETC) TYPE(*CHAR) LENGTH(002) DESC('Return code');

********** COMMENT();

********** COMMENT(Create the holding file SPOOLDTA in QTEMP);

********** COMMENT();

EXEC_OS400 COMMAND('CRTPF QTEMP/SPOOLDTA RCDLEN(132) AUT(*ALL)') IF_ERROR(*NEXT);

USE BUILTIN(CLR_MESSAGES);

EXEC_OS400 COMMAND('CPYSPLF FILE(#EMSPLFN) TOFILE(QTEMP/SPOOLDTA) SPLNBR(*LAST)');

********** COMMENT();

********** COMMENT(Start the mail and read and send all lines in report);

********** COMMENT();

USE BUILTIN(MAIL_START) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

USE BUILTIN(MAIL_ADD_RECIPIENT) WITH_ARGS(TO #EMRECPNT) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

IF COND('#EMORIGIN *NE *BLANKS');

USE BUILTIN(MAIL_ADD_ORIGINATOR) WITH_ARGS(#EMORIGIN) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

ENDIF;

IF COND('#EMSUBJECT *NE *BLANKS');

USE BUILTIN(MAIL_SET_SUBJECT) WITH_ARGS(#EMSUBJECT) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

ENDIF;

USE BUILTIN(ACCESS_FILE) WITH_ARGS(OPEN SPOOLDTA QTEMP) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

USE BUILTIN(ACCESS_FILE) WITH_ARGS(READ SPOOLDTA QTEMP) TO_GET(#EMRETC #EMLINE);

EXECUTE SUBROUTINE(CHECKERROR);

DOWHILE COND('#EMRETC = OK');

USE BUILTIN(MAIL_ADD_TEXT) WITH_ARGS(#EMLINE) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

USE BUILTIN(ACCESS_FILE) WITH_ARGS(READ SPOOLDTA QTEMP) TO_GET(#EMRETC #EMLINE);

EXECUTE SUBROUTINE(CHECKERROR);

ENDWHILE;

********** COMMENT();

********** COMMENT(Close the temporary file and send the mail);

********** COMMENT();

USE BUILTIN(ACCESS_FILE) WITH_ARGS(CLOSE SPOOLDTA QTEMP) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

USE BUILTIN(MAIL_SEND) TO_GET(#EMRETC);

EXECUTE SUBROUTINE(CHECKERROR);

********** COMMENT();

********** COMMENT(Delete the spool file if required);

********** COMMENT();

IF COND('#EMSPLFD = Y');

EXEC_OS400 COMMAND('DLTSPLF FILE(#EMSPLFN) SPLNBR(*LAST)');

ENDIF;

********** COMMENT(Finished);

RETURN;

********** COMMENT();

********** COMMENT(Error checking subroutine);

********** COMMENT();

SUBROUTINE NAME(CHECKERROR);

IF COND('(#EMRETC *NE OK) *AND (#EMRETC *NE EF)');

ABORT MSGTXT('Fatal error detected during Email transfer. See previous messages for cause.');

ENDIF;

ENDROUTINE;

Once you have this function compiled on your IBM i you could add code like this to the end of new or existing reporting programs :

 

<< PRODUCE THE REPORT >>>

ENDPRINT 

CHANGE FIELD(#EMRECPNT) TO('[email protected]');

EXCHANGE FIELDS(#EMRECPNT);

CALL PROCESS(*DIRECT) FUNCTION(<email function name>);

This will send a copy of the report to [email protected]

Similarly:

CHANGE FIELD(#EMRECPNT) TO('[email protected]');

CHANGE FIELD(#EMSUBJECT) TO('YTD Budget Report');

EXCHANGE FIELDS(#EMRECPNT #EMSUBJECT);

CALL PROCESS(*DIRECT) FUNCTION(MAILRPT);

will send a copy of the report under the subject ''YTD Budget Report''.