8.3.7 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 AS/400 Spooled File Name') DEFAULT(O@PRTF1);
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('name.user@site');
EXCHANGE FIELDS(#EMRECPNT);
CALL PROCESS(*DIRECT) FUNCTION(<email function name>);
This will send a copy of the report to name.user@site.
Similarly:
CHANGE FIELD(#EMRECPNT) TO('name.user@site');
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''.