RDML Function SET181A
* =======================================================;
* =======================================================;
* Process ........: SET_181;
* Function .......: SET181A;
* Created on .....: 11/07/00 at 14:48:43;
* Description ....: Download a file from the IFS;
* Version.........: 1;
*;
* Full Description: The purpose of this function is to;
* show one way of downloading a text file from the IFS;
* into someone's PC.;
*;
* 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 Release of LANSA: 8.0;
*;
* =======================================================;
* Function control options;
FUNCTION OPTIONS(*DIRECT *WEBEVENT);
*;
* These fields are passed as parameters to the CL program;
* that performs the CPYTOIMPF and CPY commands.;
DEFINE FIELD(#S_TOSTMF) TYPE(*CHAR) LENGTH(255) DESC('To Stream File parameter for CPYTOIMPF');
DEFINE FIELD(#S_TOOBJ) TYPE(*CHAR) LENGTH(255) DESC('TOOBJ parameter in CPY command');
DEFINE FIELD(#S_PCASCII) TYPE(*CHAR) LENGTH(008) DEFAULT('''*PCASCII''');
DEFINE FIELD(#S_ACTION) TYPE(*CHAR) LENGTH(010);
DEFINE FIELD(#S_CODEPAG) TYPE(*DEC) LENGTH(005) DECIMALS(0) DESC('ASCII code page for IFS') DEFAULT(819);
*;
* File names that will end up in the IFS without the;
* extension. The OVERRIDEs are used to overlay the nnn;
* portion of NEWF and FNAM so that the file names are;
* created with sequential suffix number each time a;
* department is selected from the browselist. For example;
* setpsl001.txt, setpsl001.xls and so on.;
DEFINE FIELD(#S_181FNAM) TYPE(*CHAR) LENGTH(010) DESC('Created by CPYTOIMPF in IFS (EBCDIC)') DEFAULT('setpslnnn.');
DEFINE FIELD(#S_181NEWF) TYPE(*CHAR) LENGTH(010) DESC('File with downloaded data') DEFAULT('setpslnnn.');
OVERRIDE FIELD(#S_181FSUF) TO_OVERLAY(#S_181NEWF 007);
OVERRIDE FIELD(#S_181TMPS) TO_OVERLAY(#S_181FNAM 007);
*;
* Fields containing the complete link to the file to;
* open. These links are the HREFs behind the Click Here;
* buttons.;
DEFINE FIELD(#S_181LTXT) REFFLD(#S_181FPTH) DESC('Link path of the TXT file to create');
DEFINE FIELD(#S_181LXLS) REFFLD(#S_181FPTH) DESC('Link path of the XLS file to create');
DEFINE FIELD(#S_181LDTA) REFFLD(#S_181FPTH) DESC('Link path of the DTA file to create');
*;
* Field used in ONCONDITION tab to control the display;
* of the component S_181LINKS.;
DEFINE FIELD(#SHOW_LINK) TYPE(*CHAR) LENGTH(001);
* Browselist of Departments;
DEFINE FIELD(#S_181DEPT) REFFLD(#DEPTMENT);
DEFINE FIELD(#S_181ROWN) TYPE(*CHAR) LENGTH(001) DESC('Browselist selection component');
DEF_LIST NAME(#S_181DEPL) FIELDS((#S_181ROWN)(#DEPTMENT *HIDDEN)(#DEPTDESC));
*;
GROUP_BY NAME(#PANELDATA) FIELDS((#STDRENTRY *HIDDEN)(#S_181DEPT *HIDDEN)(#STDROWNUM *HIDDEN)(#SHOW_LINK *HIDDEN)(#S_IFSPATH)(#S_HOSTPRT)(#S_HOSTURL)(#S_181LTXT *HIDDEN)(#S_CODEPAG)(#DEPTDESC *HIDDEN)(#S_181LXLS *HIDDEN)(#S_181LDTA *HIDDEN));
*;
CASE OF_FIELD(#STDRENTRY);
WHEN VALUE_IS('= Y');
EXECUTE SUBROUTINE(CHK_SYSVAR);
EXECUTE SUBROUTINE(OUTPUT_FIL);
OTHERWISE;
CHANGE FIELD(#STDRENTRY) TO(Y);
EXECUTE SUBROUTINE(FILL_BROWS);
ENDCASE;
*;
USE BUILTIN(CLR_MESSAGES);
REQUEST FIELDS(#PANELDATA) BROWSELIST(#S_181DEPL) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
*;
* =======================================================;
* Subroutine ....: OUTPUT_FIL;
* Description ...: Output file into desired IFS directory;
* =======================================================;
*;
SUBROUTINE NAME(OUTPUT_FIL);
*;
* Place QTEMP at the top of the library list by removing;
* and subsequently adding it.;
EXEC_OS400 COMMAND('RMVLIBLE LIB(QTEMP)') IF_ERROR(*NEXT);
EXEC_OS400 COMMAND('ADDLIBLE LIB(QTEMP)') IF_ERROR(*NEXT);
EXEC_OS400 COMMAND('DLTF FILE(QTEMP/SETPSL)') IF_ERROR(*NEXT);
* Create dummy file in QTEMP called SETPSL. This file;
* is a copy of the SETPSL shipped with the export which;
* is a copy of PSLMST.;
EXEC_OS400 COMMAND('CPYF FROMFILE(SETPSL) TOFILE(QTEMP/SETPSL) CRTFILE(*YES)') IF_ERROR(*NEXT);
* Get selected browselist row;
GET_ENTRY NUMBER(#STDROWNUM) FROM_LIST(#S_181DEPL);
CHANGE FIELD(#S_181DEPT) TO(#DEPTMENT);
* SELECT all Employees from the selected department and;
* INSERT into QTEMP file;
SELECT FIELDS(*ALL) FROM_FILE(PSLMST1) WITH_KEY(#S_181DEPT);
INSERT FIELDS(*ALL) TO_FILE(SETPSL);
ENDSELECT;
* Increment the numeric suffix for the file names;
CHANGE FIELD(#S_181TMPS) TO(*AUTONUM03FSUFFIX181);
CHANGE FIELD(#S_181FSUF) TO(#S_181TMPS);
* Build the partial value of the TOSTMF parameter of the;
* CPYTOIMPF command used in the CLP SET181CPYS. For;
* example, TOSTMF will look something like this after;
* the TCONCAT assuming your IFS path is /LANSAIMG:;
* /lansaimg/setpsl010. The extension is missing and will;
* be added by the CLP.;
USE BUILTIN(TCONCAT) WITH_ARGS(#S_IFSPATH '/' #S_181FNAM) TO_GET(#S_TOSTMF);
* The action tells the CLP whether to do the CPYTOIMPF;
* or CPY commands.;
CHANGE FIELD(#S_ACTION) TO(CPYTOIMPF);
* Refer to the comments in the CLP source;
CALL PGM(SET181CPYS) PARM(#S_CODEPAG #S_ACTION #S_PCASCII #S_TOSTMF #S_TOOBJ) NUM_LEN(*DEFINED);
*;
* Build new file name for parameter TOOBJ in CPY command;
*;
USE BUILTIN(TCONCAT) WITH_ARGS(#S_IFSPATH '/' #S_181NEWF) TO_GET(#S_TOOBJ);
*;
CHANGE FIELD(#S_ACTION) TO(CPY);
* The CPYTOIMPf command has a parameter value of *PCASCII;
* in versions V4R3 and later for the parameter TOCODEPAGE;
* In earlier versions you have to specify the actual;
* code page identifier. This is usually the same as the;
* one you specified for the Client CCSID when you;
* configured your system in LANSA for the WEB if you use;
* IBM's http server. Otherwise it will be specified in;
* the I/NET configuration file.;
IF COND('*cpfrel *lt 43');
CHANGE FIELD(#S_PCASCII) TO(*BLANK);
ELSE;
CHANGE FIELD(#S_PCASCII) TO(*DEFAULT);
ENDIF;
*;
CALL PGM(SET181CPYS) PARM(#S_CODEPAG #S_ACTION #S_PCASCII #S_TOSTMF #S_TOOBJ) NUM_LEN(*DEFINED);
*;
* Build the complete link behind the href of the Click;
* Here buttons in S_181LINKS component;
*;
USE BUILTIN(TCONCAT) WITH_ARGS(#S_URLPORT #S_IFSPATH '/' #S_181NEWF TXT) TO_GET(#S_181LTXT);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_URLPORT #S_IFSPATH '/' #S_181NEWF XLS) TO_GET(#S_181LXLS);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_URLPORT #S_IFSPATH '/' #S_181NEWF DTA) TO_GET(#S_181LDTA);
*;
CHANGE FIELD(#SHOW_LINK) TO(X);
ENDROUTINE;
* =======================================================;
* Subroutine ....: FILL_BROWS;
* Description ...: Build list of Departments;
* =======================================================;
*;
SUBROUTINE NAME(FILL_BROWS);
*;
* Build browselist of Departments;
CHANGE FIELD(#SHOW_LINK) TO(*BLANKS);
SELECT FIELDS(*ALL) FROM_FILE(DEPTAB);
ADD_ENTRY TO_LIST(#S_181DEPL);
ENDSELECT;
*;
ENDROUTINE;
*;
* =======================================================;
* Subroutine ....: CHK_SYSVAR;
* Description ...: Check if system variable have changed;
* =======================================================;
*;
SUBROUTINE NAME(CHK_SYSVAR);
*;
DEF_LIST NAME(#PARM_NAME) FIELDS(#S_SVNAME) TYPE(*WORKING);
DEF_LIST NAME(#PARM_VALU) FIELDS(#S_SVCHVAL) TYPE(*WORKING);
CLR_LIST NAMED(#PARM_VALU);
CLR_LIST NAMED(#PARM_NAME);
*;
IF COND('#s_hosturl *ne *s_hosturl');
CHANGE FIELD(#S_SVNAME) TO('''*S_HOSTURL''');
CHANGE FIELD(#S_SVCHVAL) TO(#S_HOSTURL);
ADD_ENTRY TO_LIST(#PARM_VALU);
ADD_ENTRY TO_LIST(#PARM_NAME);
ENDIF;
*;
IF COND('#s_hostprt *ne *s_hostport');
CHANGE FIELD(#S_SVNAME) TO('''*S_HOSTPORT''');
CHANGE FIELD(#S_SVCHVAL) TO(#S_HOSTPRT);
ADD_ENTRY TO_LIST(#PARM_VALU);
ADD_ENTRY TO_LIST(#PARM_NAME);
ENDIF;
*;
IF COND('#s_ifspath *ne *s_ifspath');
CHANGE FIELD(#S_SVNAME) TO('''*S_IFSPATH''');
CHANGE FIELD(#S_SVCHVAL) TO(#S_IFSPATH);
ADD_ENTRY TO_LIST(#PARM_VALU);
ADD_ENTRY TO_LIST(#PARM_NAME);
ENDIF;
*;
IF COND('(#s_hostprt *ne *s_hostport) or (#s_hosturl *ne *s_hosturl) or (#s_ifspath *ne *s_ifspath)');
CALL PROCESS(*DIRECT) FUNCTION(SETCHSV) PASS_LST(#PARM_NAME #PARM_VALU );
ENDIF;
*;
ENDROUTINE
* =======================================================;
* =======================================================;
* Process ........: SET_181;
* Function .......: SET181A;
* Created on .....: 11/07/00 at 14:48:43;
* Description ....: Download a file from the IFS;
* Version.........: 1;
*;
* Full Description: The purpose of this function is to;
* show one way of downloading a text file from the IFS;
* into someone's PC.;
*;
* 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 Release of LANSA: 8.0;
*;
* =======================================================;
* Function control options;
FUNCTION OPTIONS(*DIRECT *WEBEVENT);
*;
* These fields are passed as parameters to the CL program;
* that performs the CPYTOIMPF and CPY commands.;
DEFINE FIELD(#S_TOSTMF) TYPE(*CHAR) LENGTH(255) DESC('To Stream File parameter for CPYTOIMPF');
DEFINE FIELD(#S_TOOBJ) TYPE(*CHAR) LENGTH(255) DESC('TOOBJ parameter in CPY command');
DEFINE FIELD(#S_PCASCII) TYPE(*CHAR) LENGTH(008) DEFAULT('''*PCASCII''');
DEFINE FIELD(#S_ACTION) TYPE(*CHAR) LENGTH(010);
DEFINE FIELD(#S_CODEPAG) TYPE(*DEC) LENGTH(005) DECIMALS(0) DESC('ASCII code page for IFS') DEFAULT(819);
*;
* File names that will end up in the IFS without the;
* extension. The OVERRIDEs are used to overlay the nnn;
* portion of NEWF and FNAM so that the file names are;
* created with sequential suffix number each time a;
* department is selected from the browselist. For example;
* setpsl001.txt, setpsl001.xls and so on.;
DEFINE FIELD(#S_181FNAM) TYPE(*CHAR) LENGTH(010) DESC('Created by CPYTOIMPF in IFS (EBCDIC)') DEFAULT('setpslnnn.');
DEFINE FIELD(#S_181NEWF) TYPE(*CHAR) LENGTH(010) DESC('File with downloaded data') DEFAULT('setpslnnn.');
OVERRIDE FIELD(#S_181FSUF) TO_OVERLAY(#S_181NEWF 007);
OVERRIDE FIELD(#S_181TMPS) TO_OVERLAY(#S_181FNAM 007);
*;
* Fields containing the complete link to the file to;
* open. These links are the HREFs behind the Click Here;
* buttons.;
DEFINE FIELD(#S_181LTXT) REFFLD(#S_181FPTH) DESC('Link path of the TXT file to create');
DEFINE FIELD(#S_181LXLS) REFFLD(#S_181FPTH) DESC('Link path of the XLS file to create');
DEFINE FIELD(#S_181LDTA) REFFLD(#S_181FPTH) DESC('Link path of the DTA file to create');
*;
* Field used in ONCONDITION tab to control the display;
* of the component S_181LINKS.;
DEFINE FIELD(#SHOW_LINK) TYPE(*CHAR) LENGTH(001);
* Browselist of Departments;
DEFINE FIELD(#S_181DEPT) REFFLD(#DEPTMENT);
DEFINE FIELD(#S_181ROWN) TYPE(*CHAR) LENGTH(001) DESC('Browselist selection component');
DEF_LIST NAME(#S_181DEPL) FIELDS((#S_181ROWN)(#DEPTMENT *HIDDEN)(#DEPTDESC));
*;
GROUP_BY NAME(#PANELDATA) FIELDS((#STDRENTRY *HIDDEN)(#S_181DEPT *HIDDEN)(#STDROWNUM *HIDDEN)(#SHOW_LINK *HIDDEN)(#S_IFSPATH)(#S_HOSTPRT)(#S_HOSTURL)(#S_181LTXT *HIDDEN)(#S_CODEPAG)(#DEPTDESC *HIDDEN)(#S_181LXLS *HIDDEN)(#S_181LDTA *HIDDEN));
*;
CASE OF_FIELD(#STDRENTRY);
WHEN VALUE_IS('= Y');
EXECUTE SUBROUTINE(CHK_SYSVAR);
EXECUTE SUBROUTINE(OUTPUT_FIL);
OTHERWISE;
CHANGE FIELD(#STDRENTRY) TO(Y);
EXECUTE SUBROUTINE(FILL_BROWS);
ENDCASE;
*;
USE BUILTIN(CLR_MESSAGES);
REQUEST FIELDS(#PANELDATA) BROWSELIST(#S_181DEPL) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
*;
* =======================================================;
* Subroutine ....: OUTPUT_FIL;
* Description ...: Output file into desired IFS directory;
* =======================================================;
*;
SUBROUTINE NAME(OUTPUT_FIL);
*;
* Place QTEMP at the top of the library list by removing;
* and subsequently adding it.;
EXEC_OS400 COMMAND('RMVLIBLE LIB(QTEMP)') IF_ERROR(*NEXT);
EXEC_OS400 COMMAND('ADDLIBLE LIB(QTEMP)') IF_ERROR(*NEXT);
EXEC_OS400 COMMAND('DLTF FILE(QTEMP/SETPSL)') IF_ERROR(*NEXT);
* Create dummy file in QTEMP called SETPSL. This file;
* is a copy of the SETPSL shipped with the export which;
* is a copy of PSLMST.;
EXEC_OS400 COMMAND('CPYF FROMFILE(SETPSL) TOFILE(QTEMP/SETPSL) CRTFILE(*YES)') IF_ERROR(*NEXT);
* Get selected browselist row;
GET_ENTRY NUMBER(#STDROWNUM) FROM_LIST(#S_181DEPL);
CHANGE FIELD(#S_181DEPT) TO(#DEPTMENT);
* SELECT all Employees from the selected department and;
* INSERT into QTEMP file;
SELECT FIELDS(*ALL) FROM_FILE(PSLMST1) WITH_KEY(#S_181DEPT);
INSERT FIELDS(*ALL) TO_FILE(SETPSL);
ENDSELECT;
* Increment the numeric suffix for the file names;
CHANGE FIELD(#S_181TMPS) TO(*AUTONUM03FSUFFIX181);
CHANGE FIELD(#S_181FSUF) TO(#S_181TMPS);
* Build the partial value of the TOSTMF parameter of the;
* CPYTOIMPF command used in the CLP SET181CPYS. For;
* example, TOSTMF will look something like this after;
* the TCONCAT assuming your IFS path is /LANSAIMG:;
* /lansaimg/setpsl010. The extension is missing and will;
* be added by the CLP.;
USE BUILTIN(TCONCAT) WITH_ARGS(#S_IFSPATH '/' #S_181FNAM) TO_GET(#S_TOSTMF);
* The action tells the CLP whether to do the CPYTOIMPF;
* or CPY commands.;
CHANGE FIELD(#S_ACTION) TO(CPYTOIMPF);
* Refer to the comments in the CLP source;
CALL PGM(SET181CPYS) PARM(#S_CODEPAG #S_ACTION #S_PCASCII #S_TOSTMF #S_TOOBJ) NUM_LEN(*DEFINED);
*;
* Build new file name for parameter TOOBJ in CPY command;
*;
USE BUILTIN(TCONCAT) WITH_ARGS(#S_IFSPATH '/' #S_181NEWF) TO_GET(#S_TOOBJ);
*;
CHANGE FIELD(#S_ACTION) TO(CPY);
* The CPYTOIMPf command has a parameter value of *PCASCII;
* in versions V4R3 and later for the parameter TOCODEPAGE;
* In earlier versions you have to specify the actual;
* code page identifier. This is usually the same as the;
* one you specified for the Client CCSID when you;
* configured your system in LANSA for the WEB if you use;
* IBM's http server. Otherwise it will be specified in;
* the I/NET configuration file.;
IF COND('*cpfrel *lt 43');
CHANGE FIELD(#S_PCASCII) TO(*BLANK);
ELSE;
CHANGE FIELD(#S_PCASCII) TO(*DEFAULT);
ENDIF;
*;
CALL PGM(SET181CPYS) PARM(#S_CODEPAG #S_ACTION #S_PCASCII #S_TOSTMF #S_TOOBJ) NUM_LEN(*DEFINED);
*;
* Build the complete link behind the href of the Click;
* Here buttons in S_181LINKS component;
*;
USE BUILTIN(TCONCAT) WITH_ARGS(#S_URLPORT #S_IFSPATH '/' #S_181NEWF TXT) TO_GET(#S_181LTXT);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_URLPORT #S_IFSPATH '/' #S_181NEWF XLS) TO_GET(#S_181LXLS);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_URLPORT #S_IFSPATH '/' #S_181NEWF DTA) TO_GET(#S_181LDTA);
*;
CHANGE FIELD(#SHOW_LINK) TO(X);
ENDROUTINE;
* =======================================================;
* Subroutine ....: FILL_BROWS;
* Description ...: Build list of Departments;
* =======================================================;
*;
SUBROUTINE NAME(FILL_BROWS);
*;
* Build browselist of Departments;
CHANGE FIELD(#SHOW_LINK) TO(*BLANKS);
SELECT FIELDS(*ALL) FROM_FILE(DEPTAB);
ADD_ENTRY TO_LIST(#S_181DEPL);
ENDSELECT;
*;
ENDROUTINE;
*;
* =======================================================;
* Subroutine ....: CHK_SYSVAR;
* Description ...: Check if system variable have changed;
* =======================================================;
*;
SUBROUTINE NAME(CHK_SYSVAR);
*;
DEF_LIST NAME(#PARM_NAME) FIELDS(#S_SVNAME) TYPE(*WORKING);
DEF_LIST NAME(#PARM_VALU) FIELDS(#S_SVCHVAL) TYPE(*WORKING);
CLR_LIST NAMED(#PARM_VALU);
CLR_LIST NAMED(#PARM_NAME);
*;
IF COND('#s_hosturl *ne *s_hosturl');
CHANGE FIELD(#S_SVNAME) TO('''*S_HOSTURL''');
CHANGE FIELD(#S_SVCHVAL) TO(#S_HOSTURL);
ADD_ENTRY TO_LIST(#PARM_VALU);
ADD_ENTRY TO_LIST(#PARM_NAME);
ENDIF;
*;
IF COND('#s_hostprt *ne *s_hostport');
CHANGE FIELD(#S_SVNAME) TO('''*S_HOSTPORT''');
CHANGE FIELD(#S_SVCHVAL) TO(#S_HOSTPRT);
ADD_ENTRY TO_LIST(#PARM_VALU);
ADD_ENTRY TO_LIST(#PARM_NAME);
ENDIF;
*;
IF COND('#s_ifspath *ne *s_ifspath');
CHANGE FIELD(#S_SVNAME) TO('''*S_IFSPATH''');
CHANGE FIELD(#S_SVCHVAL) TO(#S_IFSPATH);
ADD_ENTRY TO_LIST(#PARM_VALU);
ADD_ENTRY TO_LIST(#PARM_NAME);
ENDIF;
*;
IF COND('(#s_hostprt *ne *s_hostport) or (#s_hosturl *ne *s_hosturl) or (#s_ifspath *ne *s_ifspath)');
CALL PROCESS(*DIRECT) FUNCTION(SETCHSV) PASS_LST(#PARM_NAME #PARM_VALU );
ENDIF;
*;
ENDROUTINE