Function SET001A: Email a report (AS400 only)
* =======================================================
* Process ........: SET_001
* Function .......: SET001A
* Created on .....: 21/01/00 at 14:43:32
* Description ....: Email a report
* Version.........: 1
*
* Full Description: The purpose of this function is to
* produce a simple report and email it using function
* It uses data from the employee file in the personnel
* system.
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* Minimum LANSA release: 8.0
*
* =======================================================
* Function control options
Function Options(*DIRECT)
*
* Group and field definitions
*
Define Field(#S_POS) Type(*DEC) Length(003) Decimals(0) Desc('Position of a character found in string')
*
* Define the following fields if they have not been
* imported into the data dictionary.
*
* FIELD(#S_EMORG) TYPE(*CHAR) LENGTH(40) DESC('E-mail Add
* ress - Originator') INPUT_ATR(LC)
* FIELD(#S_EMRCP) TYPE(*CHAR) LENGTH(40) DESC('E-mail Add
* ress - Recipient') INPUT_ATR(LC)
* FIELD(#S_EMSBJ) TYPE(*CHAR) LENGTH(40) DESC('Subject')
* INPUT_ATR(LC)
* FIELD(#S_EMSPLN) TYPE(*CHAR) LENGTH(10) DESC('Spool fil
* e name')
* FIELD(#S_EMSPLD) TYPE(*CHAR) LENGTH(40) DESC('Delete sp
* ool file Y/N') DEFAULT('N')
*
Group_By Name(#S_GRP1) Fields((#S_EMSPLN *L3 *P2) (#S_EMSPLD *L4 *P2) (#S_EMORG *L5 *P2) (#S_EMRCP *L6 *P2) (#S_EMSBJ *L7 *P2))
Group_By Name(#S_GRPPSL) Fields(#EMPNO #SURNAME #GIVENAME #SALARY)
Def_Line Name(#S_LINPSL) Fields((#EMPNO *L001 *P002) (#SURNAME *L001 *P011) (#GIVENAME *L001 *P032) (#SALARY *L001 *P053))
*
* Mainline
*
Def_Cond Name(*AS400) Cond('*CPUTYPE = AS400')
If Cond(*AS400)
Else
Message Msgtxt('Not available on PC')
Menu
Endif
Begin_Loop
Request Fields(#S_GRP1) Design(*DOWN) Identify(*DESC)
Begincheck
* Validate that the to & from email addresses are valid
* because if they are not, no email will get sent.
Use Builtin(SCANSTRING) With_Args(#S_EMORG '@') To_Get(#S_POS)
If Cond('#S_POS *LT 2')
Set_Error For_Field(#S_EMORG) Msgtxt('Originators email address is invalid')
Endif
Use Builtin(SCANSTRING) With_Args(#S_EMRCP '@') To_Get(#S_POS)
If Cond('#S_POS *LT 2')
Set_Error For_Field(#S_EMRCP) Msgtxt('To email address is invalid')
Endif
Endcheck
* Build report
Select Fields(#S_GRPPSL) From_File(PSLMST)
Print Line(#S_LINPSL)
Endselect
Endprint
*
* Email Spool file to email address
Exchange Fields(#S_GRP1)
Call Process(*DIRECT) Function(SET001B)
End_Loop
* =======================================================
* Process ........: SET_001
* Function .......: SET001A
* Created on .....: 21/01/00 at 14:43:32
* Description ....: Email a report
* Version.........: 1
*
* Full Description: The purpose of this function is to
* produce a simple report and email it using function
* It uses data from the employee file in the personnel
* system.
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* Minimum LANSA release: 8.0
*
* =======================================================
* Function control options
Function Options(*DIRECT)
*
* Group and field definitions
*
Define Field(#S_POS) Type(*DEC) Length(003) Decimals(0) Desc('Position of a character found in string')
*
* Define the following fields if they have not been
* imported into the data dictionary.
*
* FIELD(#S_EMORG) TYPE(*CHAR) LENGTH(40) DESC('E-mail Add
* ress - Originator') INPUT_ATR(LC)
* FIELD(#S_EMRCP) TYPE(*CHAR) LENGTH(40) DESC('E-mail Add
* ress - Recipient') INPUT_ATR(LC)
* FIELD(#S_EMSBJ) TYPE(*CHAR) LENGTH(40) DESC('Subject')
* INPUT_ATR(LC)
* FIELD(#S_EMSPLN) TYPE(*CHAR) LENGTH(10) DESC('Spool fil
* e name')
* FIELD(#S_EMSPLD) TYPE(*CHAR) LENGTH(40) DESC('Delete sp
* ool file Y/N') DEFAULT('N')
*
Group_By Name(#S_GRP1) Fields((#S_EMSPLN *L3 *P2) (#S_EMSPLD *L4 *P2) (#S_EMORG *L5 *P2) (#S_EMRCP *L6 *P2) (#S_EMSBJ *L7 *P2))
Group_By Name(#S_GRPPSL) Fields(#EMPNO #SURNAME #GIVENAME #SALARY)
Def_Line Name(#S_LINPSL) Fields((#EMPNO *L001 *P002) (#SURNAME *L001 *P011) (#GIVENAME *L001 *P032) (#SALARY *L001 *P053))
*
* Mainline
*
Def_Cond Name(*AS400) Cond('*CPUTYPE = AS400')
If Cond(*AS400)
Else
Message Msgtxt('Not available on PC')
Menu
Endif
Begin_Loop
Request Fields(#S_GRP1) Design(*DOWN) Identify(*DESC)
Begincheck
* Validate that the to & from email addresses are valid
* because if they are not, no email will get sent.
Use Builtin(SCANSTRING) With_Args(#S_EMORG '@') To_Get(#S_POS)
If Cond('#S_POS *LT 2')
Set_Error For_Field(#S_EMORG) Msgtxt('Originators email address is invalid')
Endif
Use Builtin(SCANSTRING) With_Args(#S_EMRCP '@') To_Get(#S_POS)
If Cond('#S_POS *LT 2')
Set_Error For_Field(#S_EMRCP) Msgtxt('To email address is invalid')
Endif
Endcheck
* Build report
Select Fields(#S_GRPPSL) From_File(PSLMST)
Print Line(#S_LINPSL)
Endselect
Endprint
*
* Email Spool file to email address
Exchange Fields(#S_GRP1)
Call Process(*DIRECT) Function(SET001B)
End_Loop