Page History
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 iIBM i:FUNCTION OPTIONS
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(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 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
<< 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
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''.