CRTLIB EMAIL CRTSRCPF EMAIL/EMAILSRC Copy all the source members to EMAILSRC source file ADDLIBLE EMAIL CRTCLPGM PGM(EMAIL/EDTVARC) SRCFILE(EMAIL/EMAILSRC) CRTCMD CMD(EMAIL/EDTVAR) PGM(EMAIL/EDTVARC) ALLOW(*BPGM *IPGM) SRCFILE(EMAIL/EMAILSRC) CRTPF FILE(EMAIL/CVTOUTQP) SRCFILE(EMAIL/EMAILSRC) LVLCHK(*NO) CRTRPGPGM PGM(EMAIL/CVTOUTQR) SRCFILE(EMAIL/EMAILSRC) IGNDECERR(*YES) CRTCLPGM PGM(EMAIL/CVTOUTQC) SRCFILE(EMAIL/EMAILSRC) CRTCMD CMD(EMAIL/CVTOUTQ) PGM(EMAIL/CVTOUTQC) SRCFILE(EMAIL/EMAILSRC) CRTCLPGM PGM(EMAIL/SPLEMAIL1) SRCFILE(EMAIL/EMAILSRC) DSPFD FILE(EMAIL/CVTOUTQP) TYPE(*MBRLIST) OUTPUT(*OUTFILE) OUTFILE(QTEMP/SPOOLOUTF) CRTCLPGM PGM(EMAIL/SPLEMAIL2) SRCFILE(EMAIL/EMAILSRC) CRTCLPGM PGM(EMAIL/EMAILOUTQ) SRCFILE(EMAIL/EMAILSRC) CRTCMD CMD(EMAIL/EMAILOUTQ) PGM(EMAIL/EMAILOUTQ) SRCFILE(EMAIL/EMAILSRC) /*********************************************************************/ /* CL PROGRAM : CVTOUTQC */ /* */ /* CONVERT OUT QUEUE TO DATA BASE FILE */ /* */ /*********************************************************************/ PGM PARM(&FULLOUTQ) DCL &FULLOUTQ *CHAR LEN(20) DCL &OUTQ *CHAR LEN(10) DCL &OUTQLIB *CHAR LEN(10) DCL &RTNLIB *CHAR LEN(10) DCL &SYSNAM *CHAR LEN(8) DCL &RTNCDE *CHAR LEN(8) DCL &COUNT *DEC LEN(5 0) DCL &COUNTA *CHAR LEN(22) RTVNETA SYSNAME(&SYSNAM) CHGVAR &OUTQ %SST(&FULLOUTQ 1 10) /* Extract OUTQ */ CHGVAR &OUTQLIB %SST(&FULLOUTQ 11 10) /* Extract */ CHKOBJ QTEMP/CVTOUTQTMP OBJTYPE(*FILE) MONMSG MSGID(CPF9801) EXEC(DO) /* No temp file */ CRTPF QTEMP/CVTOUTQTMP RCDLEN(134) LVLCHK(*NO) ENDDO /* No temp file */ OVRPRTF QPRTSPLQ HOLD(*YES) WRKOUTQ &OUTQLIB/&OUTQ OUTPUT(*PRINT) /* Spl output */ CPYSPLF QPRTSPLQ TOFILE(QTEMP/CVTOUTQTMP) + SPLNBR(*LAST) MBROPT(*REPLACE) /* Copy */ DLTSPLF QPRTSPLQ SPLNBR(*LAST) /* Dlt spooled file */ CLRPFM FILE(CVTOUTQP) OVRDBF LISTING TOFILE(QTEMP/CVTOUTQTMP) /* RPG file */ CALL PGM(CVTOUTQR) PARM(&COUNT &SYSNAM + &RTNLIB &RTNCDE) SNDPGMMSG MSGID(CPI9801) MSGF(QCPFMSG) TOPGMQ(*EXT) + MSGTYPE(*STATUS) IF (&RTNCDE *EQ 'NONE') SNDPGMMSG MSGID(CPF9898) + MSGF(QCPFMSG) MSGDTA('There were no spool + files to convert from ' *CAT &OUTQ *TCAT + ' in ' *CAT &RTNLIB) MSGTYPE(*ESCAPE) IF (&RTNCDE *EQ 'GOOD') DO /* Good return */ EDTVAR &COUNTA &COUNT SNDPGMMSG MSG(&COUNTA *TCAT ' entries converted from + Outq ' *CAT &OUTQ *BCAT ' to file + CVTOUTQP ') MSGTYPE(*COMP) RETURN /* Good return */ ENDDO /* Good return */ ENDPGM /*********************************************************************/ /* CL PROGRAM : EDTVARC */ /* */ /* EDIT VARIABLE CPP FOR EDTVAR */ /* */ /*********************************************************************/ PGM PARM(&CHARVAR &NUMVAR &NBRDEC &EDTCDE &LDGSYM) DCL &CHARVAR *CHAR LEN(22) /* Return variable */ DCL &NUMVAR *DEC LEN(15 0) /* Input variable */ DCL &NUMVAR2 *DEC LEN(15 0) /* Copy of input */ DCL &NBRDEC *DEC LEN(1 0) /* Number of decimals */ DCL &EDTCDE *CHAR LEN(1) /* Edit code */ DCL &LDGSYM *CHAR LEN(4) /* Leading currency sym */ DCL &CURSYM *CHAR LEN(1) /* For next 2, assume QDECFMT is 'I' or 'J' */ DCL &DECCHAR *CHAR LEN(1) VALUE(',') DCL &SEPCHAR *CHAR LEN(1) VALUE(' ') DCL &NUMVARC *CHAR LEN(15) /* Input as character */ DCL &PRTSW *CHAR LEN(1) /* Print switch */ DCL &X *DEC LEN(3 0) VALUE(1) /* Input index */ DCL &Y *DEC LEN(3 0) VALUE(1) /* Output index */ DCL &Z *DEC LEN(3 0) /* Separator index */ DCL &DECFMT *CHAR LEN(1) IF ((&EDTCDE *EQ 'W') *OR (&EDTCDE *EQ 'Y') + *OR (&EDTCDE *EQ 'Z')) DO /* W Y Z edit */ IF (&NBRDEC *NE 0) SNDPGMMSG MSGID(CPF9898) + MSGF(QCPFMSG) MSGTYPE(*ESCAPE) + MSGDTA('If EDTCDE is W, Y or Z, the + NBRDEC must be 0') ENDDO /* W Y Z edit */ CHGVAR &CHARVAR ' ' /* Initialize return var */ /* If K M or Z edit, check 0 value */ IF ((&EDTCDE *EQ 'K') *OR (&EDTCDE *EQ 'M') + *OR (&EDTCDE *EQ 'Z')) DO /* K M Z edit */ IF (&NUMVAR *EQ 0) GOTO ENDPGM ENDDO /* K M Z edit code */ /* Rtv decimal format and set values */ RTVSYSVAL QDECFMT RTNVAR(&DECFMT) IF (&DECFMT *EQ ' ') DO /* USA Format */ CHGVAR &DECCHAR '.' CHGVAR &SEPCHAR ',' ENDDO /* USA Format */ /* Initialize work area and index */ CHGVAR &Z (1 + &NBRDEC) /* Separator index */ CHGVAR &NUMVAR2 &NUMVAR /* Work variable */ IF (&NUMVAR *LT 0) /* If negative input */ + CHGVAR &NUMVAR2 (0 - &NUMVAR) /* Make positive */ CHGVAR &NUMVARC &NUMVAR2 /* Make into character */ /* Put in currency symbol if needed */ IF (&LDGSYM *EQ '*YES') DO /* Currency symbol */ RTVSYSVAL QCURSYM RTNVAR(&CURSYM) CHGVAR %SST(&CHARVAR &Y 1) &CURSYM /* Insert */ CHGVAR &Y (&Y + 1) /* Bump output index */ ENDDO /* Currency symbol */ /* Move one character at a time */ LOOP: IF ((16 - &X) *EQ &NBRDEC) DO /* Decimal place */ CHGVAR %SST(&CHARVAR &Y 1) &DECCHAR /* Insert dec */ CHGVAR &Y (&Y + 1) /* Bump output index */ CHGVAR &PRTSW 'Y' /* Set to print */ ENDDO /* Decimal place */ IF (&DECFMT *EQ 'J') DO /* J format - ldg 0 */ IF ((15 - &X) *EQ &NBRDEC) CHGVAR &PRTSW 'Y' ENDDO /* J format ldg 0 */ /* If EDTCDE W or Y set prt switch after 1st * IF ((&EDTCDE *EQ 'W') *OR (&EDTCDE *EQ 'Y')) DO IF (&Z *EQ 11) CHGVAR &PRTSW 'Y' ENDDO /* W or Y edit code */ IF ((&PRTSW *EQ 'Y') *OR + (%SST(&NUMVARC &X 1) *NE '0')) DO /* Prt */ CHGVAR %SST(&CHARVAR &Y 1) %SST(&NUMVARC &X 1) CHGVAR &Y (&Y + 1) /* Bump output index */ CHGVAR &PRTSW 'Y' /* Set on the print switch */ /* Put in separator character for J and K */ IF ((&EDTCDE *EQ 'J') *OR (&EDTCDE *EQ 'K')) DO IF ((&Z *EQ 3) *OR (&Z *EQ 6) *OR (&Z *EQ 9) + *OR (&Z *EQ 12)) DO /* Separator loc */ CHGVAR %SST(&CHARVAR &Y 1) &SEPCHAR /* Sep char */ IF (&SEPCHAR *NE ' ') CHGVAR &Y (&Y + 1) ENDDO /* Separator loc */ ENDDO /* Use separator symbol */ /* Insert date or time separator if needed */ IF ((&EDTCDE *EQ 'W') *OR (&EDTCDE *EQ 'Y')) DO IF ((&Z *EQ 11) *OR (&Z *EQ 13)) DO /* Date sep */ IF (&EDTCDE *EQ W) CHGVAR %SST(&CHARVAR &Y 1) ':' IF (&EDTCDE *EQ Y) CHGVAR %SST(&CHARVAR &Y 1) '/' CHGVAR &Y (&Y + 1) /* Next output position */ ENDDO /* Separator loc */ ENDDO /* Date or time separator */ ENDDO /* Print */ CHGVAR &Z (&Z + 1) /* Bump separator symbol index */ CHGVAR &X (&X + 1) /* Input index */ /* Force one zero in units position */ IF (&X *EQ 15) CHGVAR &PRTSW 'Y' /* Force last */ IF (&X *NE 16) GOTO LOOP /* Next character */ /* If variable is negative, insert minus */ IF (&NUMVAR *LT 0) CHGVAR %SST(&CHARVAR &Y 1) '-' ENDPGM: ENDPGM /*********************************************************************/ /* CL PROGRAM : EMAILOUTQ */ /* */ /* CONVERT OUTQ TO FOLDER EMAIL */ /* */ /*********************************************************************/ PGM PARM(&OUTQ &LIB) DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10) DCL VAR(&LIB) TYPE(*CHAR) LEN(10) ADDLIBLE LIB(EMAIL) MONMSG MSGID(CPF0000) CALL PGM(*LIBL/SPLEMAIL1) PARM(&OUTQ &LIB) MONMSG MSGID(CPF0000) CALL PGM(*LIBL/SPLEMAIL2) MONMSG MSGID(CPF0000) RMVLIBLE LIB(EMAIL) MONMSG MSGID(CPF0000) ENDPGM /*********************************************************************/ /* CL PROGRAM : SPLEMAIL1 */ /* */ /* COPY SPOOL FILES TO A PHYSICAL FILE */ /* */ /*********************************************************************/ PGM PARM(&OUTQ &LIB) DCL VAR(&MEMBER) TYPE(*CHAR) LEN(10) DCL VAR(&SPLNUM2) TYPE(*DEC) LEN(4 0) VALUE(0) DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10) DCL VAR(&LIB) TYPE(*CHAR) LEN(10) DCLF FILE(CVTOUTQP) DLTF FILE(QTEMP/PCSPOOL) MONMSG MSGID(CPF0000) CRTPF FILE(QTEMP/PCSPOOL) RCDLEN(198) + MAXMBRS(*NOMAX) SIZE(*NOMAX) CVTOUTQ OUTQ(&LIB/&OUTQ) LOOP: RCVF MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(END)) /* CREATE AN UNIQUE MEMBER NAME ACCORDING TO THE SPOOL FILE */ CHGVAR VAR(&SPLNUM2) VALUE(&SPFNBR) CHGVAR VAR(&SPFNBR) VALUE(&SPLNUM2) CHGVAR VAR(%SST(&MEMBER 1 1)) VALUE('@') CHGVAR VAR(%SST(&MEMBER 2 3)) VALUE(%SST(&SPFNBR 2 3)) CHGVAR VAR(%SST(&MEMBER 5 6)) VALUE(&SPJNBR) /* CPYSPLF TO XMIT FILE */ CPYSPLF FILE(&SPFILE) TOFILE(QTEMP/PCSPOOL) + JOB(&SPJNBR/&SPUSER/&SPJNAM) + SPLNBR(&SPFNBR) TOMBR(&MEMBER) + MBROPT(*ADD) CTLCHAR(*FCFC) MONMSG MSGID(CPF0000) GOTO CMDLBL(LOOP) END: ENDPGM /*****************************************************************/ /* CL PROGRAM : SPLEMAIL2 */ /* */ /* COPY SPOOL FILES TO FOLDER EMAIL */ /* */ /*****************************************************************/ PGM DCL VAR(&MNAME) TYPE(*CHAR) LEN(12) DCLF FILE(SPOOLOUTF) DLTF FILE(QTEMP/SPOOLOUTF) MONMSG MSGID(CPF0000) DLTDLO DLO(*ALL) FLR(EMAIL) MONMSG MSGID(CPF0000) CRTFLR FLR(EMAIL) TEXT('Spool Files') AUT(*ALL) MONMSG MSGID(CPF0000) DSPFD FILE(QTEMP/PCSPOOL) TYPE(*MBRLIST) + OUTPUT(*OUTFILE) OUTFILE(QTEMP/SPOOLOUTF) OVRDBF FILE(SPOOLOUTF) TOFILE(QTEMP/SPOOLOUTF) + LVLCHK(*NO) C: RCVF MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(END)) /* CHANGE DOCUMENT NAME TO 8 DIGIT AND .RDY FORMAT .................*/ CHGVAR VAR(%SUBSTRING(&MNAME 1 8)) + VALUE(%SST(&MLNAME 1 8)) CHGVAR VAR(%SUBSTRING(&MNAME 9 1)) VALUE('.') CHGVAR VAR(%SUBSTRING(&MNAME 10 3)) VALUE('RDY') DOCOPY1: CPYTOPCD FROMFILE(QTEMP/PCSPOOL) TOFLR(EMAIL) + FROMMBR(&MLNAME) TODOC(&MNAME) + REPLACE(*YES) TRNFMT(*TEXT) MONMSG MSGID(CPF0000) GOTO CMDLBL(C) END: DLTF FILE(QTEMP/PCSPOOL) MONMSG MSGID(CPF0000) DLTF FILE(QTEMP/SPOOLOUTF) MONMSG MSGID(CPF0000) ENDPGM /*********************************************************************/ /* COMMAND : CVTOUTQ */ /*********************************************************************/ CMD PROMPT('Convert Output Queue') PARM KWD(OUTQ) TYPE(QUAL1) MIN(1) + SNGVAL((*NONE)) PROMPT('Output queue') QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL)) EXPR(*YES) + PROMPT('Library name') /*********************************************************************/ /* COMMAND : EDTVAR */ /*********************************************************************/ CMD PROMPT('Edit Variable') PARM KWD(CHROUT) TYPE(*CHAR) LEN(22) RTNVAL(*YES) + MIN(1) PROMPT('Character return var + (22)') PARM KWD(NUMINP) TYPE(*DEC) LEN(15 0) MIN(1) + PROMPT('Dec input (up to 15 digits)') PARM KWD(NBRDEC) TYPE(*DEC) LEN(1 0) DFT(0) + RANGE(0 9) PROMPT('Number of decimals') PARM KWD(EDTCDE) TYPE(*CHAR) LEN(1) RSTD(*YES) + DFT(J) VALUES(J K L M W Y Z) PROMPT('Edit + code') PARM KWD(LDGSYM) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NO) VALUES('*YES' '*NO') + PROMPT('Leading currency symbol') /*********************************************************************/ /* COMMAND : EMAILOUTQ */ /*********************************************************************/ EMAILOUTQ: CMD PROMPT('EMAIL OUTQ') PARM KWD(OUTQ) TYPE(*CHAR) LEN(10) MIN(1) + PROMPT('OUTPUT QUEUE NAME') PARM KWD(OUTQLIB) TYPE(*CHAR) LEN(10) MIN(1) + PROMPT('OUTPUT QUEUE LIBRARY') A***************************************************************** A* A* CVTOUTQP - Out file used by CVTOUTQ command A* A***************************************************************** A* A R SPLREC A SPSYS 8 COLHDG('System' 'name') A SPOUTQ 10 COLHDG('Output' 'queue' + A 'name') A SPOQLB 10 COLHDG('Output' 'queue' + A 'library') A SPCVTD 6 COLHDG('WRKOUTQ' + A 'convert' 'date') A SPCVTT 6 COLHDG('WRKOUTQ' + A 'convert' 'time') A SPFILE 10 COLHDG('Spool' 'file' + A 'name') A SPUSER 10 COLHDG('User name') A SPUDTA 10 COLHDG('User data') A SPSTS 3 COLHDG('Spool' 'file' + A 'status') A SPNREC 6 0 COLHDG('Nbr of' 'records' + A 'or pages') A SPRECI 1 COLHDG('Rcd/page' + A 'indicator') A TEXT('Diskette records + A or print pages + A R=Records, P=Pages') A SPCPY 3 0 COLHDG('Nbr' 'of' 'copies') A SPFTYP 10 COLHDG('Form type') A SPPTY 3 COLHDG('Spool' 'file' + A 'pty') A SPFNBR 4 COLHDG('Spool' 'file' + A 'number') A SPJNAM 10 COLHDG('Job name') A SPJNBR 6 COLHDG('Job' 'number') A SPDAT 6 COLHDG('Spool' 'file' + A 'date') A SPTIM 6 COLHDG('Spool' 'file' + A 'time') F***************************************************************** F* * F* CONVERT WRKOUTQ TO OUTPUT FILE - CALLED BY CVTOUTQC * F* * F***************************************************************** FLISTING IF F 134 DISK FCVTOUTQPO E DISK E ARA 134 1 Input array I* Read input file into array ILISTING AA 01 I 1 134 ARA C *ENTRY PLIST Parm list C PARM COUNT Entries cvtd C PARM SPSYS System name C PARM SPOQLB Return lib C PARM RTNCDE 8 Return code C BEGIN TAG Begin cvt C READ LISTING 20 Read C 20 GOTO ENDCHK If EOF C* If first 4 are blank, the record should be bypassed C MOVEAARA,2 SAVE4 4 4 characters C SAVE4 CABEQ*BLANKS BEGIN Goto if blk C* Top of page record has 5728 beginning in column 2 C SAVE4 IFEQ '5728' Top of page C* If first time, move OUTQ name, command date etc C HDGSW IFEQ ' ' Heading sw C MOVEAARA,66 SPOUTQ OUTQ name C MOVEAARA,82 SPOQLB OUTQ lib C MOVEAARA,94 SAVE8 Date C EXSR CVTDAT Exsr CVTDAT C MOVE SAVE6 SPCVTD Convert date C MOVEAARA,105 SAVE8 Time C EXSR CVTDAT Exsr CVTDAT C MOVE SAVE6 SPCVTT Convert time C MOVE 'X' HDGSW 1 Set hdg sw C END Heading sw C GOTO BEGIN Goto begin C END Top of page C* Check for column heading C MOVEAARA,2 SAVE8 8 8 characters C SAVE8 IFEQ 'File ' Col heading C SAVE8 OREQ 'FILE ' Col heading C GOTO BEGIN Goto begin C END Col heading C* It must be a detail line C MOVEAARA,2 SPFILE Spl file nam C MOVEAARA,13 SPUSER User name C MOVEAARA,24 SPUDTA User data C MOVEAARA,36 SPSTS Status C* Diskette records have an R in 47 C MOVEAARA,47 SAVE1 1 R position C SAVE1 IFEQ 'R' Diskette C MOVE 'R' SPRECI Set dskt ind C MOVEAARA,43 SAVE4 4 Dskt rcds C MOVE SAVE4 SPNREC Make numeric C ELSE Printer C MOVE 'P' SPRECI Set prt ind C MOVEAARA,42 SAVE5 Page count C MOVE SAVE5 SPNREC Make numeric C END Printer C MOVEAARA,50 SAVE3 3 Copies C MOVE SAVE3 SPCPY Make numeric C MOVEAARA,55 SPFTYP Form type C MOVEAARA,67 SPPTY Priority C* Spool file number is bbb1, set to return as 0001 by making dec C MOVEAARA,75 CHAR4 4 Move 4 bytes C MOVE CHAR4 NBR4 40 Make dec C MOVE NBR4 SPFNBR Back to char C MOVEAARA,84 SPJNAM Job name C MOVEAARA,95 SPJNBR Job number C MOVEAARA,100 SAVE8 Date C EXSR CVTDAT Exsr CVTDAT C MOVE SAVE6 SPDAT File date C MOVEAARA,109 SAVE8 Time C EXSR CVTDAT Exsr CVTDAT C MOVE SAVE6 SPTIM Time C WRITESPLREC Write rcd C ADD 1 COUNT 50 Increment C GOTO BEGIN Goto begin C ENDCHK TAG End of chk C COUNT IFEQ 0 Count of 0 C MOVE 'NONE 'RTNCDE None cvtd C ELSE Else C MOVE 'GOOD 'RTNCDE Good return C END Count of 0 C SETON LR Seton LR C RETRN Return C* Convert date and time from 8 character fields to 6 character C CVTDAT BEGSR CVTDTA C MOVELSAVE8 SAVE6 6 Move L 6 C MOVE SAVE8 SAVE5 5 Move R 5 C MOVELSAVE5 SAVE4 Move L 4 C MOVE SAVE5 SAVE2 2 Move R 2 C MOVE SAVE2 SAVE4 Move R 2 C MOVE SAVE4 SAVE6 Move R 4 C ENDSR CVTDAT