How does EMLOUTQ work?
Let's take a stroll through the code and look at what this program is doing, how control language does things and why it's doing it.
This is a relatively high level, overview for newbie CL programmers.
EMLOUTQ OVERVIEW
Let our user enter a OUTQ, EMAIL address and select format of the emails (PDF is default). Press enter and have every *SPLF converted to PDF and emailed. Bish, Bosh, Thankyou Ma’am.
Source code is simple its a CMD and CLP
Copy paste it, compile it and boom check it out
EMLOUTQ Command
Source code for the command looks like this:
CMD PROMPT(' EMAIL OUTQ ')
PARM KWD(OUTQ) TYPE(OUTQ) MIN(1) PROMPT('Output queue')
OUTQ: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL +
*LIBL) (*CURLIB *CURLIB)) PROMPT('Library name')
PARM KWD(FLR) TYPE(*CHAR) LEN(100) DFT(*TMP) +
SPCVAL((*TMP '/tmp')) EXPR(*YES) +
CASE(*MIXED) PMTCTL(*PMTRQS) +
PROMPT('Working IFS Folder for *PDF')
PARM KWD(RCP) TYPE(*CHAR) LEN(100) MIN(1) +
EXPR(*YES) CASE(*MIXED) PROMPT('Email Address')
PARM KWD(SUBJECT) TYPE(*CHAR) LEN(100) +
DFT('EMAIL FROM IBM i POWER SYSTEM') ALWVAR(*YES) +
EXPR(*YES) CASE(*MIXED) PMTCTL(*PMTRQS) +
PROMPT('Email Subject')
PARM KWD(ATTACH) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*TXT) VALUES(*PDF *TXT) EXPR(*YES) +
PMTCTL(*PMTRQS) PROMPT('Format of *SPLF attachment')
PARM KWD(IGNOREHLD) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) EXPR(*YES) +
PMTCTL(*PMTRQS) PROMPT('Ignore *SPLF with STATUS(HLD)')
PARM KWD(DELETE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PMTCTL(*PMTRQS) PROMPT('Delete *SPLF after emailing')
PARM KWD(OUTQ) TYPE(OUTQ) MIN(1) PROMPT('Output queue')
OUTQ: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL +
*LIBL) (*CURLIB *CURLIB)) PROMPT('Library name')
PARM KWD(FLR) TYPE(*CHAR) LEN(100) DFT(*TMP) +
SPCVAL((*TMP '/tmp')) EXPR(*YES) +
CASE(*MIXED) PMTCTL(*PMTRQS) +
PROMPT('Working IFS Folder for *PDF')
PARM KWD(RCP) TYPE(*CHAR) LEN(100) MIN(1) +
EXPR(*YES) CASE(*MIXED) PROMPT('Email Address')
PARM KWD(SUBJECT) TYPE(*CHAR) LEN(100) +
DFT('EMAIL FROM IBM i POWER SYSTEM') ALWVAR(*YES) +
EXPR(*YES) CASE(*MIXED) PMTCTL(*PMTRQS) +
PROMPT('Email Subject')
PARM KWD(ATTACH) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*TXT) VALUES(*PDF *TXT) EXPR(*YES) +
PMTCTL(*PMTRQS) PROMPT('Format of *SPLF attachment')
PARM KWD(IGNOREHLD) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) EXPR(*YES) +
PMTCTL(*PMTRQS) PROMPT('Ignore *SPLF with STATUS(HLD)')
PARM KWD(DELETE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) EXPR(*YES) +
PMTCTL(*PMTRQS) PROMPT('Delete *SPLF after emailing')
Copy this into your QCMDSRC and compile it with CRTCMD CMD(MYLIBRARY/EMLOUTQ) PGM(MYLIBRARY/EMLOUTQ) SRCFILE(MYSRCLIB/QCMDSRC)
EMLOUTQ Command – CLP Processor
/*-------------------------------------------------------------------------*/
/* */
/* Program: EMLOUTQ.CLLE IBM i V7.2+ */
/* */
/* Desc: Generate a list of all spool files in an output queue and email */
/* Annoyingly, WRKOUTQ does not have an output(*OUTFILE) option so */
/* lets user APIs to process all SPLF from a specific OUTQ. */
/* */
/* Author: nick litten */
/* */
/* Date: October 4th 2017 */
/* */
/*-------------------------------------------------------------------------*/
/* Nick Litten May 7th 2021 */
/* Fix 20 char fields to ensure blanks are not truncated */
/*-------------------------------------------------------------------------*/
PGM PARM(&OUTQPARM &IFS_FLR &EMAIL &SUBJECT &TYPE &IGNOREHLD +
&DELETE)
COPYRIGHT TEXT('EMLOUTQ Email all *SPLFS from Outq - Ver.001')
DCL VAR(&OUTQPARM) TYPE(*CHAR) LEN(20)
DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&OUTQLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(4)
DCL VAR(&DELETE) TYPE(*CHAR) LEN(4)
DCL VAR(&IGNOREHLD) TYPE(*CHAR) LEN(4)
DCL VAR(&COUNT) TYPE(*DEC) LEN(7 0)
DCL VAR(&OCTET) TYPE(*CHAR) LEN(10)
DCL VAR(&BIN) TYPE(*CHAR) LEN(10)
DCL VAR(&USERDATA) TYPE(*CHAR) LEN(10) VALUE('*EMAILED') /* SPLF +
will change to this userdata after emailing */
DCL VAR(&IFS_FLR) TYPE(*CHAR) LEN(100) /* IFS Folder to store the +
converted *SPLF PDF's */
DCL VAR(&IFS_SPLF) TYPE(*CHAR) LEN(200) /* full name of PDF in +
format /folder/document.pdf */
DCL VAR(&EMAIL) TYPE(*CHAR) LEN(100) /* Email receiptient - email +
address in form somebody@somewhere.com */
DCL VAR(&SUBJECT) TYPE(*CHAR) LEN(100) /* Title of email - ie: +
"Email from IBM POWER SYSTEM" */
DCL VAR(&EMAILBODY) TYPE(*CHAR) LEN(200) VALUE('<h1>this is the +
body of the email in HTML format</h1>') /* Title of email - +
ie: "Email from IBM POWER SYSTEM" */
DCL VAR(&SYSTEMNAME) TYPE(*CHAR) LEN(8)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNUMBER) TYPE(*CHAR) LEN(6)
DCL VAR(&STATUS) TYPE(*CHAR) LEN(10)
DCL VAR(&SPLNBR) TYPE(*DEC) LEN(4)
DCL VAR(&SPLNBRALF) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTALN) TYPE(*DEC) LEN(9 0)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(80)
DCL VAR(&NO_ERROR) TYPE(*CHAR) LEN(4) VALUE(X'00000000')
DCL VAR(&DFTUSNAME) TYPE(*CHAR) LEN(10) VALUE('UPD_UDTA')
DCL VAR(&DFTUSLIB) TYPE(*CHAR) LEN(10) VALUE('QTEMP')
/* Declares for QUSCRTUS - Create User Space */
DCL VAR(&QCUS_NAME) TYPE(*CHAR) LEN(20)
DCL VAR(&QCUS_EXATR) TYPE(*CHAR) LEN(10) VALUE('USRSPC ')
/* Maximum number of SPLF the User Space will contain */
DCL VAR(&QCUS_SIZE) TYPE(*CHAR) LEN(4) VALUE(X'00010000')
DCL VAR(&QCUS_INIT) TYPE(*CHAR) LEN(1) VALUE(X'00')
DCL VAR(&QCUS_PUBA) TYPE(*CHAR) LEN(10) VALUE('*ALL ')
DCL VAR(&QCUS_TEXT) TYPE(*CHAR) LEN(50)
DCL VAR(&QCUS_REPL) TYPE(*CHAR) LEN(10) VALUE('*YES ')
DCL VAR(&QCUS_DOMN) TYPE(*CHAR) LEN(10) VALUE('*DEFAULT ')
/* Declares for QUSLSPL - List Spooled Files */
DCL VAR(&QLSF_NAME) TYPE(*CHAR) LEN(20)
DCL VAR(&QLSF_FOMT) TYPE(*CHAR) LEN(8) VALUE('SPLF0100')
DCL VAR(&QLSF_USER) TYPE(*CHAR) LEN(10)
DCL VAR(&QLSF_OUTQ) TYPE(*CHAR) LEN(20)
DCL VAR(&QLSF_FORM) TYPE(*CHAR) LEN(10)
DCL VAR(&QLSF_USRD) TYPE(*CHAR) LEN(10)
/* Declares for QUSRTVUS - Retrieve User Space */
DCL VAR(&QRUS_NAME) TYPE(*CHAR) LEN(20)
DCL VAR(&QRUS_STRT) TYPE(*CHAR) LEN(4)
DCL VAR(&QRUS_LENG) TYPE(*CHAR) LEN(4)
DCL VAR(&QRUS_HEAD) TYPE(*CHAR) LEN(16)
DCL VAR(&QRUS_LINE) TYPE(*CHAR) LEN(82)
DCL VAR(&INT_OFFSET) TYPE(*DEC) LEN(9 0)
DCL VAR(&INT_NUMBER) TYPE(*DEC) LEN(9 0)
DCL VAR(&INT_SIZE) TYPE(*DEC) LEN(9 0)
DCL VAR(&INT_POSIT) TYPE(*DEC) LEN(9 0)
/* Variables QUSRSPLA - Get Spooled File Attributes */
DCL VAR(&QGSA_RCV) TYPE(*CHAR) LEN(3772)
DCL VAR(&QGSA_RCVLN) TYPE(*CHAR) LEN(4) VALUE(X'00000EBC')
DCL VAR(&QGSA_FOMT) TYPE(*CHAR) LEN(8) VALUE('SPLA0200')
DCL VAR(&QGSA_JOB) TYPE(*CHAR) LEN(26) VALUE('*INT ')
DCL VAR(&QGSA_IJOB) TYPE(*CHAR) LEN(16)
DCL VAR(&QGSA_ISPL) TYPE(*CHAR) LEN(16)
DCL VAR(&QGSA_SPLF) TYPE(*CHAR) LEN(10) VALUE('*INT ')
DCL VAR(&QGSA_SPLNB) TYPE(*CHAR) LEN(4) VALUE(X'00000000')
/* Declares for QUSDLTUS - Delete User Space */
DCL VAR(&QDUS_NAME) TYPE(*CHAR) LEN(20)
/* Declares for QERRCD - Error Code */
DCL VAR(&QERRCD) TYPE(*CHAR) LEN(96)
/* construct the 20 char API values for OBJECT and NAME */
CHGVAR VAR(&QDUS_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&QRUS_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&QLSF_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&QCUS_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&TYPE) VALUE(%SUBSTRING(&TYPE 2 3)) /* Chop of the '*' +
from front of parm */
CHGVAR VAR(&OUTQ) VALUE(&OUTQPARM)
CHGVAR VAR(&OUTQLIB) VALUE(%SUBSTRING(&OUTQPARM 11 10))
RTVNETA SYSNAME(&SYSTEMNAME)
CHGVAR VAR(&SUBJECT) VALUE(&SUBJECT *BCAT '|System:' *TCAT +
&SYSTEMNAME *TCAT ' Outq:' *TCAT &OUTQ)
/* Create Userspace */
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSCRTUS) PARM(&QCUS_NAME &QCUS_EXATR &QCUS_SIZE +
&QCUS_INIT &QCUS_PUBA &QCUS_TEXT &QCUS_REPL &QERRCD +
&QCUS_DOMN)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
/* List all Spooled Files from a given Output Queue */
CHGVAR VAR(&QLSF_USER) VALUE('*ALL')
CHGVAR VAR(&QLSF_OUTQ) VALUE(&outq *CAT &outqlib)
CHGVAR VAR(&QLSF_FORM) VALUE('*ALL')
CHGVAR VAR(&QLSF_USRD) VALUE('*ALL')
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSLSPL) PARM(&QLSF_NAME &QLSF_FOMT &QLSF_USER &QLSF_OUTQ +
&QLSF_FORM &QLSF_USRD &QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
/* Read Headerdata from Userspace */
CHGVAR VAR(%BIN(&QRUS_STRT)) VALUE(125)
CHGVAR VAR(%BIN(&QRUS_LENG)) VALUE(16)
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSRTVUS) PARM(&QRUS_NAME &QRUS_STRT &QRUS_LENG &QRUS_HEAD +
&QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
CHGVAR VAR(&INT_OFFSET) VALUE(%BIN(&QRUS_HEAD 1 4))
CHGVAR VAR(&INT_NUMBER) VALUE(%BIN(&QRUS_HEAD 9 4))
CHGVAR VAR(&INT_SIZE) VALUE(%BIN(&QRUS_HEAD 13 4))
/* Loop through the Userspace */
CHGVAR VAR(&INT_POSIT) VALUE(0)
LOOP_SPACE: CHGVAR VAR(&INT_POSIT) VALUE(&INT_POSIT + 1)
IF COND(&INT_POSIT *GT &INT_NUMBER) THEN(GOTO CMDLBL(END_SPACE))
/* Read next Userspace detail line */
CHGVAR VAR(%BIN(&QRUS_STRT)) VALUE(&INT_OFFSET + ((&INT_POSIT - 1) * +
&INT_SIZE) + 1)
CHGVAR VAR(%BIN(&QRUS_LENG)) VALUE(82)
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSRTVUS) PARM(&QRUS_NAME &QRUS_STRT &QRUS_LENG &QRUS_LINE +
&QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
/* Get Spooled File Attributes */
CHGVAR VAR(&QGSA_IJOB) VALUE(%SST(&QRUS_LINE 51 16))
CHGVAR VAR(&QGSA_ISPL) VALUE(%SST(&QRUS_LINE 67 16))
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSRSPLA) PARM(&QGSA_RCV &QGSA_RCVLN &QGSA_FOMT &QGSA_JOB +
&QGSA_IJOB &QGSA_ISPL &QGSA_SPLF &QGSA_SPLNB &QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
CHGVAR VAR(&JOBNAME) VALUE(%SST(&QGSA_RCV 49 10))
CHGVAR VAR(&FILE) VALUE(%SST(&QGSA_RCV 75 10))
CHGVAR VAR(&USER) VALUE(%SST(&QGSA_RCV 59 10))
CHGVAR VAR(&JOBNUMBER) VALUE(%SST(&QGSA_RCV 69 10))
CHGVAR VAR(&SPLNBR) VALUE(%BIN(&QGSA_RCV 85 4))
CHGVAR VAR(&STATUS) VALUE(%sst(&QGSA_RCV 110 4))
/* Ignore *SPLF if they are HOLD(*YES) if selected */
IF COND(&IGNOREHLD *EQ *YES *AND &STATUS *EQ 'HELD') THEN(GOTO +
CMDLBL(LOOP_SPACE))
/* construct unique name for SPLF in PDF format */
CHGVAR VAR(&SPLNBRALF) VALUE(&SPLNBR)
CHGVAR VAR(&IFS_SPLF) VALUE(&IFS_FLR *TCAT '/EMLOUTQ from' *BCAT +
&SYSTEMNAME *TCAT ' outq' *BCAT &OUTQ *TCAT ' file' *BCAT +
&FILE *TCAT ' number' *BCAT &SPLNBRALF *TCAT '.' *TCAT &TYPE)
CHGVAR VAR(&EMAILBODY) VALUE('<H1>IBM i SPOOL EMAIL</H1><P>Spool +
file' *BCAT &IFS_SPLF *TCAT ' is attached in PDF +
format.</p>')
/* copy spool into IFS location as a PDF */
IF COND(&TYPE *EQ 'TXT') THEN(DO)
CPYSPLF FILE(&FILE) TOFILE(*TOSTMF) JOB(&JOBNUMBER/&USER/&JOBNAME) +
SPLNBR(&SPLNBR) TOSTMF(&IFS_SPLF) WSCST(*NONE) +
STMFOPT(*REPLACE)
CHGVAR VAR(&OCTET) VALUE('*PLAIN')
CHGVAR VAR(&BIN) VALUE('*TXT')
ENDDO
ELSE CMD(DO)
CPYSPLF FILE(&FILE) TOFILE(*TOSTMF) JOB(&JOBNUMBER/&USER/&JOBNAME) +
SPLNBR(&SPLNBR) TOSTMF(&IFS_SPLF) WSCST(*PDF) +
STMFOPT(*REPLACE)
CHGVAR VAR(&OCTET) VALUE('*OCTET')
CHGVAR VAR(&BIN) VALUE('*BIN')
ENDDO
/* send PDF as email */
SNDSMTPEMM RCP((&EMAIL *PRI)) SUBJECT(&SUBJECT) NOTE(&EMAILBODY) +
ATTACH((&IFS_SPLF &OCTET &BIN)) CONTENT(*HTML)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('* Email NOT sent to' +
*BCAT &EMAIL *TCAT ' with *PDF of' *BCAT &IFS_SPLF) +
TOPGMQ(*PRV) MSGTYPE(*COMP)
GOTO CMDLBL(LOOP_SPACE)
ENDDO
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Email sent to' *BCAT +
&EMAIL *TCAT ' with *' *TCAT &TYPE *BCAT 'of' *BCAT +
&IFS_SPLF) TOPGMQ(*PRV) MSGTYPE(*COMP)
IF COND(&DELETE *EQ *YES) THEN(DO)
DLTSPLF FILE(&FILE) JOB(&JOBNUMBER/&USER/&JOBNAME) SPLNBR(&SPLNBR)
RMVLNK OBJLNK(&IFS_SPLF)
ENDDO
ELSE CMD(DO)
CHGSPLFA FILE(&FILE) JOB(&JOBNUMBER/&USER/&JOBNAME) SPLNBR(&SPLNBR) +
SAVE(*NO) USRDTA(&USERDATA)
ENDDO
/* Read next Spooled File from User Space */
GOTO CMDLBL(LOOP_SPACE)
/* Delete Userspace */
END_SPACE: CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSDLTUS) PARM(&QDUS_NAME &QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
ENDPROGRAM: RETURN
/* API-Error */
ERROR_API: CHGVAR VAR(&MSGID) VALUE(%SST(&QERRCD 9 7))
CHGVAR VAR(&MSGDTALN) VALUE(%BIN(&QERRCD 5 4))
CHGVAR VAR(&MSGDTALN) VALUE(&MSGDTALN - 16)
CHGVAR VAR(&MSGDTA) VALUE(%SST(&QERRCD 17 &MSGDTALN))
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
/* Error */
ERROR: SNDPGMMSG MSGID(CPF9899) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
ENDPGM: ENDPGM
/* */
/* Program: EMLOUTQ.CLLE IBM i V7.2+ */
/* */
/* Desc: Generate a list of all spool files in an output queue and email */
/* Annoyingly, WRKOUTQ does not have an output(*OUTFILE) option so */
/* lets user APIs to process all SPLF from a specific OUTQ. */
/* */
/* Author: nick litten */
/* */
/* Date: October 4th 2017 */
/* */
/*-------------------------------------------------------------------------*/
/* Nick Litten May 7th 2021 */
/* Fix 20 char fields to ensure blanks are not truncated */
/*-------------------------------------------------------------------------*/
PGM PARM(&OUTQPARM &IFS_FLR &EMAIL &SUBJECT &TYPE &IGNOREHLD +
&DELETE)
COPYRIGHT TEXT('EMLOUTQ Email all *SPLFS from Outq - Ver.001')
DCL VAR(&OUTQPARM) TYPE(*CHAR) LEN(20)
DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&OUTQLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(4)
DCL VAR(&DELETE) TYPE(*CHAR) LEN(4)
DCL VAR(&IGNOREHLD) TYPE(*CHAR) LEN(4)
DCL VAR(&COUNT) TYPE(*DEC) LEN(7 0)
DCL VAR(&OCTET) TYPE(*CHAR) LEN(10)
DCL VAR(&BIN) TYPE(*CHAR) LEN(10)
DCL VAR(&USERDATA) TYPE(*CHAR) LEN(10) VALUE('*EMAILED') /* SPLF +
will change to this userdata after emailing */
DCL VAR(&IFS_FLR) TYPE(*CHAR) LEN(100) /* IFS Folder to store the +
converted *SPLF PDF's */
DCL VAR(&IFS_SPLF) TYPE(*CHAR) LEN(200) /* full name of PDF in +
format /folder/document.pdf */
DCL VAR(&EMAIL) TYPE(*CHAR) LEN(100) /* Email receiptient - email +
address in form somebody@somewhere.com */
DCL VAR(&SUBJECT) TYPE(*CHAR) LEN(100) /* Title of email - ie: +
"Email from IBM POWER SYSTEM" */
DCL VAR(&EMAILBODY) TYPE(*CHAR) LEN(200) VALUE('<h1>this is the +
body of the email in HTML format</h1>') /* Title of email - +
ie: "Email from IBM POWER SYSTEM" */
DCL VAR(&SYSTEMNAME) TYPE(*CHAR) LEN(8)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNUMBER) TYPE(*CHAR) LEN(6)
DCL VAR(&STATUS) TYPE(*CHAR) LEN(10)
DCL VAR(&SPLNBR) TYPE(*DEC) LEN(4)
DCL VAR(&SPLNBRALF) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTALN) TYPE(*DEC) LEN(9 0)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(80)
DCL VAR(&NO_ERROR) TYPE(*CHAR) LEN(4) VALUE(X'00000000')
DCL VAR(&DFTUSNAME) TYPE(*CHAR) LEN(10) VALUE('UPD_UDTA')
DCL VAR(&DFTUSLIB) TYPE(*CHAR) LEN(10) VALUE('QTEMP')
/* Declares for QUSCRTUS - Create User Space */
DCL VAR(&QCUS_NAME) TYPE(*CHAR) LEN(20)
DCL VAR(&QCUS_EXATR) TYPE(*CHAR) LEN(10) VALUE('USRSPC ')
/* Maximum number of SPLF the User Space will contain */
DCL VAR(&QCUS_SIZE) TYPE(*CHAR) LEN(4) VALUE(X'00010000')
DCL VAR(&QCUS_INIT) TYPE(*CHAR) LEN(1) VALUE(X'00')
DCL VAR(&QCUS_PUBA) TYPE(*CHAR) LEN(10) VALUE('*ALL ')
DCL VAR(&QCUS_TEXT) TYPE(*CHAR) LEN(50)
DCL VAR(&QCUS_REPL) TYPE(*CHAR) LEN(10) VALUE('*YES ')
DCL VAR(&QCUS_DOMN) TYPE(*CHAR) LEN(10) VALUE('*DEFAULT ')
/* Declares for QUSLSPL - List Spooled Files */
DCL VAR(&QLSF_NAME) TYPE(*CHAR) LEN(20)
DCL VAR(&QLSF_FOMT) TYPE(*CHAR) LEN(8) VALUE('SPLF0100')
DCL VAR(&QLSF_USER) TYPE(*CHAR) LEN(10)
DCL VAR(&QLSF_OUTQ) TYPE(*CHAR) LEN(20)
DCL VAR(&QLSF_FORM) TYPE(*CHAR) LEN(10)
DCL VAR(&QLSF_USRD) TYPE(*CHAR) LEN(10)
/* Declares for QUSRTVUS - Retrieve User Space */
DCL VAR(&QRUS_NAME) TYPE(*CHAR) LEN(20)
DCL VAR(&QRUS_STRT) TYPE(*CHAR) LEN(4)
DCL VAR(&QRUS_LENG) TYPE(*CHAR) LEN(4)
DCL VAR(&QRUS_HEAD) TYPE(*CHAR) LEN(16)
DCL VAR(&QRUS_LINE) TYPE(*CHAR) LEN(82)
DCL VAR(&INT_OFFSET) TYPE(*DEC) LEN(9 0)
DCL VAR(&INT_NUMBER) TYPE(*DEC) LEN(9 0)
DCL VAR(&INT_SIZE) TYPE(*DEC) LEN(9 0)
DCL VAR(&INT_POSIT) TYPE(*DEC) LEN(9 0)
/* Variables QUSRSPLA - Get Spooled File Attributes */
DCL VAR(&QGSA_RCV) TYPE(*CHAR) LEN(3772)
DCL VAR(&QGSA_RCVLN) TYPE(*CHAR) LEN(4) VALUE(X'00000EBC')
DCL VAR(&QGSA_FOMT) TYPE(*CHAR) LEN(8) VALUE('SPLA0200')
DCL VAR(&QGSA_JOB) TYPE(*CHAR) LEN(26) VALUE('*INT ')
DCL VAR(&QGSA_IJOB) TYPE(*CHAR) LEN(16)
DCL VAR(&QGSA_ISPL) TYPE(*CHAR) LEN(16)
DCL VAR(&QGSA_SPLF) TYPE(*CHAR) LEN(10) VALUE('*INT ')
DCL VAR(&QGSA_SPLNB) TYPE(*CHAR) LEN(4) VALUE(X'00000000')
/* Declares for QUSDLTUS - Delete User Space */
DCL VAR(&QDUS_NAME) TYPE(*CHAR) LEN(20)
/* Declares for QERRCD - Error Code */
DCL VAR(&QERRCD) TYPE(*CHAR) LEN(96)
/* construct the 20 char API values for OBJECT and NAME */
CHGVAR VAR(&QDUS_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&QRUS_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&QLSF_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&QCUS_NAME) VALUE(&DFTUSNAME *CAT &DFTUSLIB)
CHGVAR VAR(&TYPE) VALUE(%SUBSTRING(&TYPE 2 3)) /* Chop of the '*' +
from front of parm */
CHGVAR VAR(&OUTQ) VALUE(&OUTQPARM)
CHGVAR VAR(&OUTQLIB) VALUE(%SUBSTRING(&OUTQPARM 11 10))
RTVNETA SYSNAME(&SYSTEMNAME)
CHGVAR VAR(&SUBJECT) VALUE(&SUBJECT *BCAT '|System:' *TCAT +
&SYSTEMNAME *TCAT ' Outq:' *TCAT &OUTQ)
/* Create Userspace */
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSCRTUS) PARM(&QCUS_NAME &QCUS_EXATR &QCUS_SIZE +
&QCUS_INIT &QCUS_PUBA &QCUS_TEXT &QCUS_REPL &QERRCD +
&QCUS_DOMN)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
/* List all Spooled Files from a given Output Queue */
CHGVAR VAR(&QLSF_USER) VALUE('*ALL')
CHGVAR VAR(&QLSF_OUTQ) VALUE(&outq *CAT &outqlib)
CHGVAR VAR(&QLSF_FORM) VALUE('*ALL')
CHGVAR VAR(&QLSF_USRD) VALUE('*ALL')
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSLSPL) PARM(&QLSF_NAME &QLSF_FOMT &QLSF_USER &QLSF_OUTQ +
&QLSF_FORM &QLSF_USRD &QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
/* Read Headerdata from Userspace */
CHGVAR VAR(%BIN(&QRUS_STRT)) VALUE(125)
CHGVAR VAR(%BIN(&QRUS_LENG)) VALUE(16)
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSRTVUS) PARM(&QRUS_NAME &QRUS_STRT &QRUS_LENG &QRUS_HEAD +
&QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
CHGVAR VAR(&INT_OFFSET) VALUE(%BIN(&QRUS_HEAD 1 4))
CHGVAR VAR(&INT_NUMBER) VALUE(%BIN(&QRUS_HEAD 9 4))
CHGVAR VAR(&INT_SIZE) VALUE(%BIN(&QRUS_HEAD 13 4))
/* Loop through the Userspace */
CHGVAR VAR(&INT_POSIT) VALUE(0)
LOOP_SPACE: CHGVAR VAR(&INT_POSIT) VALUE(&INT_POSIT + 1)
IF COND(&INT_POSIT *GT &INT_NUMBER) THEN(GOTO CMDLBL(END_SPACE))
/* Read next Userspace detail line */
CHGVAR VAR(%BIN(&QRUS_STRT)) VALUE(&INT_OFFSET + ((&INT_POSIT - 1) * +
&INT_SIZE) + 1)
CHGVAR VAR(%BIN(&QRUS_LENG)) VALUE(82)
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSRTVUS) PARM(&QRUS_NAME &QRUS_STRT &QRUS_LENG &QRUS_LINE +
&QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
/* Get Spooled File Attributes */
CHGVAR VAR(&QGSA_IJOB) VALUE(%SST(&QRUS_LINE 51 16))
CHGVAR VAR(&QGSA_ISPL) VALUE(%SST(&QRUS_LINE 67 16))
CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSRSPLA) PARM(&QGSA_RCV &QGSA_RCVLN &QGSA_FOMT &QGSA_JOB +
&QGSA_IJOB &QGSA_ISPL &QGSA_SPLF &QGSA_SPLNB &QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
CHGVAR VAR(&JOBNAME) VALUE(%SST(&QGSA_RCV 49 10))
CHGVAR VAR(&FILE) VALUE(%SST(&QGSA_RCV 75 10))
CHGVAR VAR(&USER) VALUE(%SST(&QGSA_RCV 59 10))
CHGVAR VAR(&JOBNUMBER) VALUE(%SST(&QGSA_RCV 69 10))
CHGVAR VAR(&SPLNBR) VALUE(%BIN(&QGSA_RCV 85 4))
CHGVAR VAR(&STATUS) VALUE(%sst(&QGSA_RCV 110 4))
/* Ignore *SPLF if they are HOLD(*YES) if selected */
IF COND(&IGNOREHLD *EQ *YES *AND &STATUS *EQ 'HELD') THEN(GOTO +
CMDLBL(LOOP_SPACE))
/* construct unique name for SPLF in PDF format */
CHGVAR VAR(&SPLNBRALF) VALUE(&SPLNBR)
CHGVAR VAR(&IFS_SPLF) VALUE(&IFS_FLR *TCAT '/EMLOUTQ from' *BCAT +
&SYSTEMNAME *TCAT ' outq' *BCAT &OUTQ *TCAT ' file' *BCAT +
&FILE *TCAT ' number' *BCAT &SPLNBRALF *TCAT '.' *TCAT &TYPE)
CHGVAR VAR(&EMAILBODY) VALUE('<H1>IBM i SPOOL EMAIL</H1><P>Spool +
file' *BCAT &IFS_SPLF *TCAT ' is attached in PDF +
format.</p>')
/* copy spool into IFS location as a PDF */
IF COND(&TYPE *EQ 'TXT') THEN(DO)
CPYSPLF FILE(&FILE) TOFILE(*TOSTMF) JOB(&JOBNUMBER/&USER/&JOBNAME) +
SPLNBR(&SPLNBR) TOSTMF(&IFS_SPLF) WSCST(*NONE) +
STMFOPT(*REPLACE)
CHGVAR VAR(&OCTET) VALUE('*PLAIN')
CHGVAR VAR(&BIN) VALUE('*TXT')
ENDDO
ELSE CMD(DO)
CPYSPLF FILE(&FILE) TOFILE(*TOSTMF) JOB(&JOBNUMBER/&USER/&JOBNAME) +
SPLNBR(&SPLNBR) TOSTMF(&IFS_SPLF) WSCST(*PDF) +
STMFOPT(*REPLACE)
CHGVAR VAR(&OCTET) VALUE('*OCTET')
CHGVAR VAR(&BIN) VALUE('*BIN')
ENDDO
/* send PDF as email */
SNDSMTPEMM RCP((&EMAIL *PRI)) SUBJECT(&SUBJECT) NOTE(&EMAILBODY) +
ATTACH((&IFS_SPLF &OCTET &BIN)) CONTENT(*HTML)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('* Email NOT sent to' +
*BCAT &EMAIL *TCAT ' with *PDF of' *BCAT &IFS_SPLF) +
TOPGMQ(*PRV) MSGTYPE(*COMP)
GOTO CMDLBL(LOOP_SPACE)
ENDDO
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Email sent to' *BCAT +
&EMAIL *TCAT ' with *' *TCAT &TYPE *BCAT 'of' *BCAT +
&IFS_SPLF) TOPGMQ(*PRV) MSGTYPE(*COMP)
IF COND(&DELETE *EQ *YES) THEN(DO)
DLTSPLF FILE(&FILE) JOB(&JOBNUMBER/&USER/&JOBNAME) SPLNBR(&SPLNBR)
RMVLNK OBJLNK(&IFS_SPLF)
ENDDO
ELSE CMD(DO)
CHGSPLFA FILE(&FILE) JOB(&JOBNUMBER/&USER/&JOBNAME) SPLNBR(&SPLNBR) +
SAVE(*NO) USRDTA(&USERDATA)
ENDDO
/* Read next Spooled File from User Space */
GOTO CMDLBL(LOOP_SPACE)
/* Delete Userspace */
END_SPACE: CHGVAR VAR(%SST(&QERRCD 1 8)) VALUE(X'0000006000000000')
CALL PGM(QUSDLTUS) PARM(&QDUS_NAME &QERRCD)
IF COND(%SST(&QERRCD 5 4) *NE &NO_ERROR) THEN(GOTO +
CMDLBL(ERROR_API))
ENDPROGRAM: RETURN
/* API-Error */
ERROR_API: CHGVAR VAR(&MSGID) VALUE(%SST(&QERRCD 9 7))
CHGVAR VAR(&MSGDTALN) VALUE(%BIN(&QERRCD 5 4))
CHGVAR VAR(&MSGDTALN) VALUE(&MSGDTALN - 16)
CHGVAR VAR(&MSGDTA) VALUE(%SST(&QERRCD 17 &MSGDTALN))
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
/* Error */
ERROR: SNDPGMMSG MSGID(CPF9899) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
ENDPGM: ENDPGM
NOTE variable VAR(&QDUS_NAME) is a 20 char field with the userspace name in it. This userspace is a temporary storage area used during the *SPLF to *PDF conversion. It is defined as called UPD_UDTA at posn1 and the library QTEMP at posn 11 – this is because this is how the IBM i *API’s refer to addresses for object NAME in posn(1-10) and LIB in posn (11-20)
Compile Instructions
Compile the command with defaults like this:
CRTCMD CMD(mylib/EMLOUTQ) PGM(*LIBL/EMLOUTQ) SRCFILE(mylib/QCMDSRC) SRCMBR(EMLOUTQ)
CRTBNDCL PGM(mylib/EMLOUTQ) SRCFILE(mylib/QCLLESRC) SRCMBR(EMLOUTQ) TGTRLS(V7R2M0)
EMLOUTQ OUTQ(MYOUTQ) RCP(nick.litten@somewhere.com) SUBJECT('These are some scrummy PDF emails') ATTACH(*PDF) IGNOREHLD(*NO) DELETE(*YES)