Email all SPLF in an output queue – EMLOUTQ for ISERIES and AS400

AS400

Mar 12

For a couple of years now, I’ve used this little EMLOUTQ utility program (written in IBM i Control Language) to read through an output queue and email each and every spool file as a plain text file. It’s useful but old and a little tired looking. Luckily for me, a quite week means I get to got back and spend a few hours polishing old code to make it a little more modern.

So, this week I tidied up a little and added a little ZING to it’s step.

EMLOUTQ OVERVIEW

This is a little utility program that grabs a list of all spools on an output queue and then emails them to any address you choose. It uses a *USRSPC to list the splfs because IBM (annoyingly) doesnt have a DSPOUTQ *OUTFILE option.

  • EMLOUTQ – Upgrade Mission
  • Allow spool files to be sent in PDF format
  • Allow selection of spolls in *RDY format only
  • Allow cleanup/deletion of spools after they have been successfully emailed
  • Spruce up with a front end command and better parameters

Source code is simple its a CMD and  CLP

Copy paste it, compile it and boom check it out 🙂

EMLOUTQV6 Command

CMD PROMPT(' EMAIL V6 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 ISERIES SYSTEM') +
 EXPR(*YES) 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')

EMLOUTQV6 Command – CLP Processor

/*-------------------------------------------------------------------------+ 
/* Program: EMLOUTQV6.CLLE IBM i V6+ + 
/* 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: March 12th 2013 + 
/*-------------------------------------------------------------------------*/ 
 
 PGM PARM(&OUTQPARM &IFS_FLR &EMAIL &SUBJECT  &TYPE &IGNOREHLD &DELETE) 
 
 COPYRIGHT TEXT('Some Bloke Doing Stuff Ver.000') 
 
 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 recipient - 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') 
 
/* Declares for QUSCRTUS - Create User Space */ 
 
 DCL VAR(&QCUS_NAME) TYPE(*CHAR) LEN(20) + 
 VALUE('UPD_UDTA QTEMP ') 
 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) + 
 VALUE('UPD_UDTA QTEMP ') 
 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) VALUE('UPD_UDTA QTEMP ') 
 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) VALUE('UPD_UDTA QTEMP ') 
 
/* Declares for QERRCD - Error Code */ 
 DCL VAR(&QERRCD) TYPE(*CHAR) LEN(96) 
 
 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 */ 
 DLTF FILE(QTEMP/&FILE) 
 MONMSG MSGID(CPF0000) 
 CRTPF FILE(QTEMP/&FILE) RCDLEN(133) SIZE(1000000)  
 DEL OBJLNK(&IFS_SPLF) 
 MONMSG MSGID(CPF0000) 
 IF COND(&TYPE *EQ 'TXT') THEN(DO) 
 CPYSPLF FILE(&FILE) TOFILE(QTEMP/&FILE) + 
 JOB(&JOBNUMBER/&USER/&JOBNAME) SPLNBR(&SPLNBR) CTLCHAR(*NONE) 
 CPYTOSTMF FROMMBR('/qsys.lib/qtemp.lib/' *TCAT &FILE + 
 *TCAT '.file/' *TCAT &FILE *TCAT '.mbr/') TOSTMF(&IFS_SPLF) 
 CHGVAR VAR(&OCTET) VALUE('*PLAIN') 
 CHGVAR VAR(&BIN) VALUE('*TXT') 
 ENDDO 
 ELSE CMD(DO) 
 CPYSPLF FILE(&FILE) TOFILE(QTEMP/&FILE) + 
 JOB(&JOBNUMBER/&USER/&JOBNAME) + 
 SPLNBR(&SPLNBR) CTLCHAR(*FCFC) 
 OVRPRTF FILE(QSYSPRT) DEVTYPE(*AFPDS) CTLCHAR(*FCFC) + 
 TOSTMF(&IFS_SPLF) WSCST(*PDF) OVRSCOPE(*JOB) 
 CPYF FROMFILE(QTEMP/&FILE) TOFILE(QSYSPRT) 
 DLTOVR FILE(QSYSPRT) LVL(*JOB) 
 
 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

Then you can do a CRTBNDCL PGM(yourlib/EMLOUTQV6) SRCFILE(yourlib/QCLLESRC) SRCMBR(EMLOUTQV6) TGTRLS(V6R1M0)

Follow

About the Author

IBM i Software Developer, Digital Dad, AS400 Anarchist, RPG Modernizer, Alpha Nerd and Passionate Eater of Cheese and Biscuits. Nick Litten Dot Com is a mixture of blog posts that can be sometimes serious, frequently playful and probably down-right pointless all in the space of a day. Enjoy your stay, feel free to comment and in the words of the most interesting man in the world: Stay thirsty my friend.