Function SET001B: Send a Spool File to an Email Address

LANSA

previous page next page
Function SET001B: Send a Spool File to an Email Address

********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_001);
********** COMMENT(Function .......: SET001B);
********** COMMENT(Created on .....: 21/01/00 at 14:43:32);
********** COMMENT(Description ....: Send a spool file to an email address);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function will send a spool file);
********** COMMENT(for the current job to an email address);
********** COMMENT();
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as an);
********** COMMENT(example only. No warranty is expressed or implied.);
********** COMMENT();
********** COMMENT(=======================================================);
********** COMMENT(Function control options);
FUNCTION OPTIONS(*DIRECT);
********** COMMENT();
********** COMMENT(Group and field definitions);
********** COMMENT();
********** COMMENT(Mainline);
********** COMMENT();
********** 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 iSeries 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') INPUT_ATR(LC) DEFAULT(*FUNCTION);
DEFINE FIELD(#EMRECPNT) TYPE(*CHAR) LENGTH(060) DESC('Email Recpient Name') INPUT_ATR(LC) DEFAULT(*BLANKS);
DEFINE FIELD(#EMSUBJECT) TYPE(*CHAR) LENGTH(060) DESC('Email Subject') INPUT_ATR(LC) 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(Load the work fields from the exchanged database fields);
********** COMMENT();
CHANGE FIELD(#EMSPLFN) TO(#S_EMSPLN);
CHANGE FIELD(#EMSPLFD) TO(#S_EMSPLD);
CHANGE FIELD(#EMORIGIN) TO(#S_EMORG);
CHANGE FIELD(#EMRECPNT) TO(#S_EMRCP);
CHANGE FIELD(#EMSUBJECT) TO(#S_EMSBJ);
********** 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;

previous page start next page