RDML for SET209E

LANSA

RDML for SET209E
* =======================================================
* Process ........: SET_209
* Function .......: SET209A
* Created on .....: 15/02/00 at 14:43:32
* Description ....: Function Skeleton
* Version.........: 1
*
* Full Description:
*
* this function uses the SMTP Client service provided
* provided by Lansa Integrator to send an email to up to
* three recipient addresses and up to three attachment
* files.
*
* Service used: SMTPCLIENT
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* =======================================================
* Function control options
Function Options(*DIRECT) Rcv_List(#WLST_RCPS #WLST_ATT #EMAIL_TXT)
*
* Group and field definitions
*
Define Field(#CMD) Reffld(#STD_TEXTS)
Define Field(#KEYWORD) Reffld(#STD_TEXT)
Define Field(#KEYW_VAL1) Reffld(#STD_TEXTL)
Define Field(#KEYW_VAL2) Reffld(#STD_TEXTL)
*
Define Field(#MSGDTA) Type(*CHAR) Length(132)
*
Define Field(#W_JSMSTS) Reffld(#S_JSMSTS)
Group_By Name(#EMAIL_DTA) Fields(#S_209FROM #W_JSMSTS #ATT_COUNT #S_209SUBJ #S_209SERV #S_209USER #S_209PSWD)
* Entry counter for attachment working list #WLST_ATT
* and condition to evaluate wether any attachments files
* were specified
Define Field(#ATT_COUNT) Reffld(#LISTCOUNT)
Def_Cond Name(*ATTACHFIL) Cond('#ATT_COUNT > 0')
*
* Recipients working list
Def_List Name(#WLST_RCPS) Fields(#S_209RECP) Type(*WORKING)
*
* Attachments working list
Def_List Name(#WLST_ATT) Fields(#S_209ATTS) Counter(#ATT_COUNT) Type(*WORKING)
*
* Working list of email text
Def_List Name(#EMAIL_TXT) Fields(#S_209TEXT) Type(*WORKING)
*
* Mainline
*
* Load SMTP Client service
Execute Subroutine(LOAD_SERVC)
* If Ok, set parameters
If Cond('#s_jsmsts = OK')
Execute Subroutine(SET_PARMS)
* If Ok, send email
If Cond('#s_jsmsts = OK')
Execute Subroutine(SEND_EMAIL)
Endif
Endif
*
Change Field(#W_JSMSTS) To(#S_JSMSTS)
* Unload the STMP Client service
Execute Subroutine(UNLOAD_SRV)
*
Exchange Fields(#EMAIL_DTA #WLST_RCPS #WLST_ATT #EMAIL_TXT)
Return
*
Subroutine Name(LOAD_SERVC)
* Load SMTPCLIENT service
Execute Subroutine(START_CMD) With_Parms('SERVICE_LOAD')
Execute Subroutine(KEYWRD) With_Parms('SERVICE' 'SMTPCLIENT' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
Execute Subroutine(CHECK_STS)
Endroutine
*
Subroutine Name(SET_PARMS)
* SET Server, user, password, email from parameter
Execute Subroutine(START_CMD) With_Parms('SET')
Execute Subroutine(KEYWRD) With_Parms('SERVER' #S_209SERV *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('TO' '*LIST' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('FROM' #S_209FROM *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('service_list' 'S_209RECP' *BLANKS)
*
* Build USER and PASSWORD parameters if specified
If Cond('#s_209user *NE *BLANKS')
Execute Subroutine(KEYWRD) With_Parms('User' #S_209USER *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('Password' #S_209PSWD *BLANKS)
Endif
*
* Execute previously built SET command and
* keywords.
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG #WLST_RCPS)
Execute Subroutine(CHECK_STS)
* If there are attachment files, ADD them
If Cond(*ATTACHFIL)
Execute Subroutine(START_CMD) With_Parms('ADD')
Execute Subroutine(KEYWRD) With_Parms('attachment' '*list' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('service_list' 's_209atts' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG #WLST_ATT)
Execute Subroutine(CHECK_STS)
Endif
*
Endroutine
*
Subroutine Name(SEND_EMAIL)
*
Execute Subroutine(START_CMD) With_Parms('SEND')
Execute Subroutine(KEYWRD) With_Parms('subject' #S_209SUBJ *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('service_list' 's_209text' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('USER' 's_209user' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('PASSWORD' 's_209PSWD' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG #EMAIL_TXT)
Execute Subroutine(CHECK_STS)
Endroutine
*
Subroutine Name(UNLOAD_SRV)
* Load SMTPCLIENT service
Execute Subroutine(START_CMD) With_Parms('SERVICE_UNLOAD')
Execute Subroutine(KEYWRD) With_Parms('SERVICE' 'SMTPCLIENT' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
Execute Subroutine(CHECK_STS)
Endroutine
*
Subroutine Name(START_CMD) Parms((#CMD *RECEIVED))
Change Field(#S_JSMCMD) To(#cmd)
Endroutine
*
Subroutine Name(KEYWRD) Parms(#KEYWORD #KEYW_VAL1 #KEYW_VAL2)
Use Builtin(BCONCAT) With_Args(#S_JSMCMD #KEYWORD) To_Get(#S_JSMCMD)
Use Builtin(TCONCAT) With_Args(#S_JSMCMD '(' #KEYW_VAL1 #KEYW_VAL2 ')') To_Get(#S_JSMCMD)
Endroutine
*
Subroutine Name(OP_CL_JSM) Parms((#W_ACTION *RECEIVED))
Define Field(#W_ACTION) Type(*CHAR) Length(005)
Group_By Name(#S_EXCHFLD) Fields(#S_JSMSTS #S_JSMMSG #W_ACTION)
Exchange Fields(#S_EXCHFLD)
Call Process(*DIRECT) Function(SETJSMO) Exit_Used(*NEXT) Menu_Used(*NEXT)
Endroutine
*
* Check the status of the JSM command issued
Subroutine Name(CHECK_STS)
*
If Cond('#S_JSMSTS *NE OK')
*
Use Builtin(BCONCAT) With_Args('Error Status Code: ' #S_JSMSTS) To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Use Builtin(BCONCAT) With_Args('Error Message: ' #S_JSMMSG) To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
*
If Cond('#cmd = ADD')
* Error while adding attachments
Use Builtin(BCONCAT) With_Args('Failed to attach one or more files.' 'Verify all the files exist in the' 'specified path.') To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Endif
Endif
*
Endroutine
*