/*===============================*/
/* THIS IS A CL PROGRAM          */
/* Send email direct from AS/400 */
/*                               */
/* SOURCE FILE QCLSRC            */
/* SOURCE MEMBER NAME EMAILC     */
/*===============================*/
/*                               */
/* Author     Steve Miall        */
/* Company    Genesis V          */
/* Date       2000/10/04         */
/*                               */
/*===============================*/
PGM PARM(&RTN &SUBJ &MSG &TO &FILLIB &MBR)
DCL &RTN  *CHAR   1
DCL &SUBJ *CHAR  80
DCL &USER *CHAR   8 VALUE('INTERNET')
DCL &ADDR *CHAR   7 VALUE('SMTPRTE')
DCL &MSG  *CHAR 256
DCL &TO   *CHAR  80
DCL &FILLIB *CHAR 20
DCL &FIL    *CHAR 10
DCL &LIB    *CHAR 10
DCL &MBR    *CHAR 10
DCL &ATR    *CHAR 10

             CHGVAR     VAR(&FIL) VALUE(%SST(&FILLIB 1 10))
             CHGVAR     VAR(&LIB) VALUE(%SST(&FILLIB 11 10))

             IF         COND(&LIB *EQ ' ') THEN(CHGVAR VAR(&LIB) +
                          VALUE(*LIBL))
             IF         COND(&FIL *EQ ' ') THEN(CHGVAR VAR(&FIL) +
                          VALUE(*NONE))

             CRTPF      FILE(QTEMP/GVEMAIL) RCDLEN(72) TEXT('Email +
                          Transmision file')
             MONMSG  CPF0000
             CLRPFM     FILE(QTEMP/GVEMAIL)
             MONMSG  CPF0000

/* Send the email */
             IF         COND(&FIL *EQ *NONE) THEN(DO)
               SNDDST     TYPE(*LMSG) TOUSRID((&USER &ADDR)) +
                          TOINTNET((&TO *PRI)) DSTD('E-Mail') +
                          LONGMSG(&MSG) DOCFILE(*NONE) SUBJECT(&SUBJ)
               GOTO END
             ENDDO
/* Format the email */
             IF         COND(&FIL *NE *NONE) THEN(DO)
               CHKOBJ     OBJ(&LIB/&FIL) OBJTYPE(*FILE)
               MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
               RTVOBJD    OBJ(&LIB/&FIL) OBJTYPE(*FILE) OBJATR(&ATR)
               IF         COND(&ATR *EQ SAVF) THEN(GOTO CMDLBL(SAVF))

               CHKOBJ     OBJ(&LIB/&FIL) OBJTYPE(*FILE) MBR(&MBR)
               MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

               OVRDBF     FILE(QTXTSRC) TOFILE(&LIB/&FIL) MBR(&MBR)
               OVRDBF     FILE(EMAIL) TOFILE(QTEMP/GVEMAIL) MBR(*FIRST)

               CALL       PGM(XFMTEM)  PARM(&RTN)
               MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

               DLTOVR     FILE(QTXTSRC)
               DLTOVR     FILE(EMAIL)

               SNDDST     TYPE(*FILE) TOUSRID((&USER &ADDR)) +
                          TOINTNET((&TO *PRI)) DSTD('E-Mail') +
                          MSG(&MSG) DOCFILE(QTEMP/GVEMAIL) +
                          DOCTYPE(*FFT) DOCD('E-mail') SUBJECT(&SUBJ)
               MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
               GOTO END
             ENDDO
 SAVF:
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Sorry, +
                          you cannot attach Save files to AS/400 +
                          emails')
             GOTO END

 ERROR:      SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Email +
                          sending failed')
 END:        ENDPGM