Function SET193E: Write to NT File System
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET193E);
********** COMMENT(Created on .....: 12th October 2000);
********** COMMENT(Description ....: Demonstration Function 6);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how an AS/400 function write data into files);
********** COMMENT( residing in the Windows NT/2000 file system);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT( example material only. No warranty concerning this);
********** COMMENT( material or its use in any way whatsoever is);
********** COMMENT( expressed or implied.);
********** COMMENT();
********** COMMENT(Minimum Release of LANSA Required : 8.0);
********** COMMENT();
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*DIRECT *HEAVYUSAGE);
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
********** COMMENT(--------------------------------------);
********** COMMENT(If on an AS/400 execute "client" logic);
********** COMMENT(--------------------------------------);
IF COND(*AS400);
EXECUTE SUBROUTINE(AS_CLIENT);
ELSE;
********** COMMENT(-----------------------------------);
********** COMMENT(else execute NT/2000 "server" logic);
********** COMMENT(-----------------------------------);
EXECUTE SUBROUTINE(NT_SERVER);
ENDIF;
********** COMMENT(--------);
********** COMMENT(Finished);
********** COMMENT(--------);
MENU;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( AS_Client: AS/400 "Client" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(AS_CLIENT);
********** COMMENT();
********** COMMENT(Local Definitions);
********** COMMENT();
DEFINE FIELD(#S_193SSN) REFFLD(#STD_OBJ) DESC('SSN of server (always exchanged in)');
DEFINE FIELD(#S_193TBN) REFFLD(#STD_OBJ) COLHDG('AS/400 Table Name');
DEFINE FIELD(#S_193TBD) REFFLD(#STD_DESC) COLHDG('Description');
DEFINE FIELD(#S_193SEL) TYPE(*CHAR) LENGTH(001) COLHDG('Select');
DEF_LIST NAME(#S_193LIST) FIELDS((#S_193SEL *SELECT)(#S_193TBN)(#S_193TBD));
DEFINE FIELD(#S_193DIR) TYPE(*CHAR) LENGTH(060) LABEL('Target Dir') INPUT_ATR(LC) DEFAULT('C:\TEMP');
DEFINE FIELD(#S_193RSP) TYPE(*CHAR) LENGTH(002) DESC('Response fro Windows NT/2000 system');
********** COMMENT();
********** COMMENT(Now loop around writing files until cancelled);
********** COMMENT();
MESSAGE MSGTXT('Specify directory name and choose files to be written. Press Enter.');
BEGIN_LOOP;
********** COMMENT();
********** COMMENT(Prepare the browselist with a list of files);
********** COMMENT();
CLR_LIST NAMED(#S_193LIST);
EXECUTE SUBROUTINE(ADD_FILE) WITH_PARMS(PSLMST 'Employee Master');
EXECUTE SUBROUTINE(ADD_FILE) WITH_PARMS(DEPTAB 'Departments');
EXECUTE SUBROUTINE(ADD_FILE) WITH_PARMS(SECTAB 'Sections');
********** COMMENT();
********** COMMENT(Request the directory name and tables to write out);
********** COMMENT();
REQUEST FIELDS(#S_193DIR) DESIGN(*DOWN) IDENTIFY(*LABEL) BROWSELIST(#S_193LIST) EXIT_KEY(*NO) MENU_KEY(*YES E10) PROMPT_KEY(*NO);
********** COMMENT();
********** COMMENT(For each table selected .....);
********** COMMENT();
SELECTLIST NAMED(#S_193LIST) GET_ENTRYS(*SELECT);
********** COMMENT();
********** COMMENT(Send the directory and table names);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(DIRECTORY #S_193DIR);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(TABLENAME #S_193TBN);
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL *FUNCTION *BLANKS);
********** COMMENT();
********** COMMENT(Wait for result to come back from NT server);
********** COMMENT();
MESSAGE MSGTXT('Waiting for Windows NT/2000 system to write out file') TYPE(*STATUS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(RESPONSE #S_193RSP ER);
********** COMMENT();
ENDSELECT;
********** COMMENT(Loop around for next employee);
END_LOOP;
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
E10: EXECUTE SUBROUTINE(ENDSERVICE);
RETURN;
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( Add_File: Add a file to the browselist);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(ADD_FILE) PARMS((#S_193TBN *RECEIVED) (#S_193TBD *RECEIVED));
CHANGE FIELD(#S_193SEL) TO(*NULL);
ADD_ENTRY TO_LIST(#S_193LIST);
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( NT_Server: Windows NT/2000 "Server" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(NT_SERVER);
********** COMMENT();
********** COMMENT(Local defines);
********** COMMENT();
DEFINE FIELD(#S_193LMT) REFFLD(#STD_NUM) DESC('Number of entries used in working lists') DEFAULT(50);
DEFINE FIELD(#S_193OFN) REFFLD(#SYSVAR$AV) DESC('Output file Name');
DEF_COND NAME(*OKAY) COND('#S_193RSP = OK');
DEF_COND NAME(*NOTOKAY) COND('#S_193RSP *NE OK');
********** COMMENT();
********** COMMENT(Connect all file I/Os to the AS/400 server);
********** COMMENT();
USE BUILTIN(CONNECT_FILE) WITH_ARGS('*' #S_193SSN);
********** COMMENT();
********** COMMENT(Get the directory and table name);
********** COMMENT();
EXECUTE SUBROUTINE(FIRST_SET);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(DIRECTORY #S_193DIR *BLANKS);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(TABLENAME #S_193TBN *BLANKS);
********** COMMENT();
********** COMMENT(Handle the various different tables);
********** COMMENT();
CASE OF_FIELD(#S_193TBN);
********** COMMENT();
********** COMMENT(-----------------------);
********** COMMENT(Handle the PSLMST table);
********** COMMENT(-----------------------);
********** COMMENT();
WHEN VALUE_IS('= PSLMST');
********** COMMENT();
DEFINE FIELD(#T_PSLMST) REFFLD(#STD_NUM);
DEF_LIST NAME(#L_PSLMST) FIELDS((#EMPNO)(#SURNAME)(#GIVENAME)(#ADDRESS1)(#ADDRESS2)(#ADDRESS3)(#POSTCODE)(#PHONEHME)(#PHONEBUS)(#STARTDTER)(#TERMDATER)(#DEPTMENT)(#SECTION)(#SALARY)(#STARTDTE)(#TERMDATE)(#MNTHSAL)) COUNTER(#T_PSLMST) TYPE(*WORKING);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DIR '\PSLMST.DAT') TO_GET(#S_193OFN);
********** COMMENT();
SELECT FIELDS(*ALL) FROM_FILE(PSLMST);
ADD_ENTRY TO_LIST(#L_PSLMST);
IF COND('#T_PSLMST >= #S_193LMT');
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_PSLMST #S_193OFN T I Y '.' N) TO_GET(#S_193RSP);
CLR_LIST NAMED(#L_PSLMST);
LEAVE IF(*NOTOKAY);
ENDIF;
ENDSELECT;
********** COMMENT();
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_PSLMST #S_193OFN T I Y '.' Y) TO_GET(#S_193RSP);
IF COND(*OKAY);
MESSAGE MSGTXT('File PSLMST.DAT created in specified directory');
ELSE;
MESSAGE MSGTXT('Attempt to create file PSLMST.DAT in specified directory failed');
ENDIF;
********** COMMENT();
********** COMMENT(-----------------------);
********** COMMENT(Handle the DEPTAB table);
********** COMMENT(-----------------------);
********** COMMENT();
WHEN VALUE_IS('= DEPTAB');
********** COMMENT();
DEFINE FIELD(#T_DEPTAB) REFFLD(#STD_NUM);
DEF_LIST NAME(#L_DEPTAB) FIELDS((#DEPTMENT)(#DEPTDESC)) COUNTER(#T_DEPTAB) TYPE(*WORKING);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DIR '\DEPTAB.DAT') TO_GET(#S_193OFN);
********** COMMENT();
SELECT FIELDS(*ALL) FROM_FILE(DEPTAB);
ADD_ENTRY TO_LIST(#L_DEPTAB);
IF COND('#T_DEPTAB >= #S_193LMT');
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_DEPTAB #S_193OFN T I Y '.' N) TO_GET(#S_193RSP);
CLR_LIST NAMED(#L_DEPTAB);
LEAVE IF(*NOTOKAY);
ENDIF;
ENDSELECT;
********** COMMENT();
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_DEPTAB #S_193OFN T I Y '.' Y) TO_GET(#S_193RSP);
IF COND(*OKAY);
MESSAGE MSGTXT('File DEPTAB.DAT created in specified directory');
ELSE;
MESSAGE MSGTXT('Attempt to create file DEPTAB.DAT in specified directory failed');
ENDIF;
********** COMMENT();
********** COMMENT(-----------------------);
********** COMMENT(Handle the SECTAB table);
********** COMMENT(-----------------------);
********** COMMENT();
WHEN VALUE_IS('= SECTAB');
********** COMMENT();
DEFINE FIELD(#T_SECTAB) REFFLD(#STD_NUM);
DEF_LIST NAME(#L_SECTAB) FIELDS((#DEPTMENT)(#SECTION)(#SECDESC)(#SECADDR1)(#SECADDR2)(#SECADDR3)(#SECPCODE)(#SECPHBUS)) COUNTER(#T_SECTAB) TYPE(*WORKING);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DIR '\SECTAB.DAT') TO_GET(#S_193OFN);
********** COMMENT();
SELECT FIELDS(*ALL) FROM_FILE(SECTAB);
ADD_ENTRY TO_LIST(#L_SECTAB);
IF COND('#T_SECTAB >= #S_193LMT');
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_SECTAB #S_193OFN T I Y '.' N) TO_GET(#S_193RSP);
CLR_LIST NAMED(#L_SECTAB);
LEAVE IF(*NOTOKAY);
ENDIF;
ENDSELECT;
********** COMMENT();
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_SECTAB #S_193OFN T I Y '.' Y) TO_GET(#S_193RSP);
IF COND(*OKAY);
MESSAGE MSGTXT('File SECTAB.DAT created in specified directory');
ELSE;
MESSAGE MSGTXT('Attempt to create file SECTAB.DAT in specified directory failed');
ENDIF;
********** COMMENT();
********** COMMENT(-------------------------);
********** COMMENT(Handle an unknown request);
********** COMMENT(-------------------------);
********** COMMENT();
OTHERWISE;
CHANGE FIELD(#S_193RSP) TO(ER);
MESSAGE MSGTXT('Request to write out unknown table name received by SET193E');
ENDCASE;
********** COMMENT();
********** COMMENT(Set up the response to be sent back);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(RESPONSE #S_193RSP);
********** COMMENT();
********** COMMENT(Disconnect all file I/Os from the AS/400 server);
********** COMMENT();
USE BUILTIN(DISCONNECT_FILE) WITH_ARGS('*' #S_193SSN);
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
RETURN;
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(==== Windows NT/2000 Interface Routines ====);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(These subroutines are used to simplify and);
********** COMMENT( standardize interfacing with a NT/2000);
********** COMMENT( service via function SET193T);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(Begin: Sets or Resets an interaction between);
********** COMMENT( this program and an NT/2000 server. Use);
********** COMMENT( this subroutine at the start of each);
********** COMMENT( logical transaction.);
********** COMMENT(============================================);
SUBROUTINE NAME(BEGIN);
CHANGE FIELD(#S_193GSR) TO(I);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(EndService: Ends any existing connection with);
********** COMMENT( an NT/200 server and frees resources. Use);
********** COMMENT( when all interactions have been completed.);
********** COMMENT(============================================);
SUBROUTINE NAME(ENDSERVICE);
CHANGE FIELD(#S_193GSR) TO(T);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(First_Set : Sets up for the processing the);
********** COMMENT( first set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(FIRST_SET);
CHANGE FIELD(#S_193VIN) TO(1);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(Next_Set : Sets up for the processing the);
********** COMMENT( next set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(NEXT_SET);
CHANGE FIELD(#S_193VIN) TO('#S_193VIN + 1');
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Alpha: Set the value of an alpha variable);
********** COMMENT( instance. Used as Put_Alpha ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(A);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Number: Set the value of a numeric variable);
********** COMMENT( instance. Used as Put_Number ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_NUMBER) PARMS((#S_193VNM *RECEIVED) (#S_193VNV *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(B);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Alpha: Get the value of an alpha variable);
********** COMMENT( instance. Used as Get_Alpha (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RETURNED) (#D_193VAV *RECEIVED));
DEFINE FIELD(#D_193VAV) REFFLD(#S_193VAV) DESC('Alphanumeric Default Value');
CHANGE FIELD(#S_193GSR) TO(C);
CHANGE FIELD(#S_193VAV) TO(#D_193VAV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Number: Get the value of a numeric variable);
********** COMMENT( instance. Used as Get_Number (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_NUMBER) PARMS((#S_193VNM *RECEIVED) (#S_193VNV *RETURNED) (#D_193VNV *RECEIVED));
DEFINE FIELD(#D_193VNV) REFFLD(#S_193VNV) DESC('Numeric Default Value');
CHANGE FIELD(#S_193GSR) TO(D);
CHANGE FIELD(#S_193VNV) TO(#D_193VNV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Send: Send all variables to a service);
********** COMMENT( Used as Send ( <nam> <fun> <com> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <fun> is the RDML function to invoke);
********** COMMENT( <com> is the RDML component to invoke);
********** COMMENT(================================================);
SUBROUTINE NAME(SEND) PARMS((#S_193SERV *RECEIVED) (#S_193FUN *RECEIVED) (#S_193COM *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(S);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193FUN #S_193COM);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Receive: Receive all variables from a service);
********** COMMENT( Used as Receive ( <nam> <max> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <max> is the maximum time to wait);
********** COMMENT(================================================);
SUBROUTINE NAME(RECEIVE) PARMS((#S_193SERV *RECEIVED) (#S_193MAXW *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(R);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193MAXW);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Call_193T: Used to call function SET193T);
********** COMMENT(================================================);
SUBROUTINE NAME(CALL_193T);
CALL PROCESS(*DIRECT) FUNCTION(SET193T);
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET193E);
********** COMMENT(Created on .....: 12th October 2000);
********** COMMENT(Description ....: Demonstration Function 6);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how an AS/400 function write data into files);
********** COMMENT( residing in the Windows NT/2000 file system);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT( example material only. No warranty concerning this);
********** COMMENT( material or its use in any way whatsoever is);
********** COMMENT( expressed or implied.);
********** COMMENT();
********** COMMENT(Minimum Release of LANSA Required : 8.0);
********** COMMENT();
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*DIRECT *HEAVYUSAGE);
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
********** COMMENT(--------------------------------------);
********** COMMENT(If on an AS/400 execute "client" logic);
********** COMMENT(--------------------------------------);
IF COND(*AS400);
EXECUTE SUBROUTINE(AS_CLIENT);
ELSE;
********** COMMENT(-----------------------------------);
********** COMMENT(else execute NT/2000 "server" logic);
********** COMMENT(-----------------------------------);
EXECUTE SUBROUTINE(NT_SERVER);
ENDIF;
********** COMMENT(--------);
********** COMMENT(Finished);
********** COMMENT(--------);
MENU;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( AS_Client: AS/400 "Client" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(AS_CLIENT);
********** COMMENT();
********** COMMENT(Local Definitions);
********** COMMENT();
DEFINE FIELD(#S_193SSN) REFFLD(#STD_OBJ) DESC('SSN of server (always exchanged in)');
DEFINE FIELD(#S_193TBN) REFFLD(#STD_OBJ) COLHDG('AS/400 Table Name');
DEFINE FIELD(#S_193TBD) REFFLD(#STD_DESC) COLHDG('Description');
DEFINE FIELD(#S_193SEL) TYPE(*CHAR) LENGTH(001) COLHDG('Select');
DEF_LIST NAME(#S_193LIST) FIELDS((#S_193SEL *SELECT)(#S_193TBN)(#S_193TBD));
DEFINE FIELD(#S_193DIR) TYPE(*CHAR) LENGTH(060) LABEL('Target Dir') INPUT_ATR(LC) DEFAULT('C:\TEMP');
DEFINE FIELD(#S_193RSP) TYPE(*CHAR) LENGTH(002) DESC('Response fro Windows NT/2000 system');
********** COMMENT();
********** COMMENT(Now loop around writing files until cancelled);
********** COMMENT();
MESSAGE MSGTXT('Specify directory name and choose files to be written. Press Enter.');
BEGIN_LOOP;
********** COMMENT();
********** COMMENT(Prepare the browselist with a list of files);
********** COMMENT();
CLR_LIST NAMED(#S_193LIST);
EXECUTE SUBROUTINE(ADD_FILE) WITH_PARMS(PSLMST 'Employee Master');
EXECUTE SUBROUTINE(ADD_FILE) WITH_PARMS(DEPTAB 'Departments');
EXECUTE SUBROUTINE(ADD_FILE) WITH_PARMS(SECTAB 'Sections');
********** COMMENT();
********** COMMENT(Request the directory name and tables to write out);
********** COMMENT();
REQUEST FIELDS(#S_193DIR) DESIGN(*DOWN) IDENTIFY(*LABEL) BROWSELIST(#S_193LIST) EXIT_KEY(*NO) MENU_KEY(*YES E10) PROMPT_KEY(*NO);
********** COMMENT();
********** COMMENT(For each table selected .....);
********** COMMENT();
SELECTLIST NAMED(#S_193LIST) GET_ENTRYS(*SELECT);
********** COMMENT();
********** COMMENT(Send the directory and table names);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(DIRECTORY #S_193DIR);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(TABLENAME #S_193TBN);
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL *FUNCTION *BLANKS);
********** COMMENT();
********** COMMENT(Wait for result to come back from NT server);
********** COMMENT();
MESSAGE MSGTXT('Waiting for Windows NT/2000 system to write out file') TYPE(*STATUS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(RESPONSE #S_193RSP ER);
********** COMMENT();
ENDSELECT;
********** COMMENT(Loop around for next employee);
END_LOOP;
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
E10: EXECUTE SUBROUTINE(ENDSERVICE);
RETURN;
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( Add_File: Add a file to the browselist);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(ADD_FILE) PARMS((#S_193TBN *RECEIVED) (#S_193TBD *RECEIVED));
CHANGE FIELD(#S_193SEL) TO(*NULL);
ADD_ENTRY TO_LIST(#S_193LIST);
ENDROUTINE;
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( NT_Server: Windows NT/2000 "Server" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(NT_SERVER);
********** COMMENT();
********** COMMENT(Local defines);
********** COMMENT();
DEFINE FIELD(#S_193LMT) REFFLD(#STD_NUM) DESC('Number of entries used in working lists') DEFAULT(50);
DEFINE FIELD(#S_193OFN) REFFLD(#SYSVAR$AV) DESC('Output file Name');
DEF_COND NAME(*OKAY) COND('#S_193RSP = OK');
DEF_COND NAME(*NOTOKAY) COND('#S_193RSP *NE OK');
********** COMMENT();
********** COMMENT(Connect all file I/Os to the AS/400 server);
********** COMMENT();
USE BUILTIN(CONNECT_FILE) WITH_ARGS('*' #S_193SSN);
********** COMMENT();
********** COMMENT(Get the directory and table name);
********** COMMENT();
EXECUTE SUBROUTINE(FIRST_SET);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(DIRECTORY #S_193DIR *BLANKS);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(TABLENAME #S_193TBN *BLANKS);
********** COMMENT();
********** COMMENT(Handle the various different tables);
********** COMMENT();
CASE OF_FIELD(#S_193TBN);
********** COMMENT();
********** COMMENT(-----------------------);
********** COMMENT(Handle the PSLMST table);
********** COMMENT(-----------------------);
********** COMMENT();
WHEN VALUE_IS('= PSLMST');
********** COMMENT();
DEFINE FIELD(#T_PSLMST) REFFLD(#STD_NUM);
DEF_LIST NAME(#L_PSLMST) FIELDS((#EMPNO)(#SURNAME)(#GIVENAME)(#ADDRESS1)(#ADDRESS2)(#ADDRESS3)(#POSTCODE)(#PHONEHME)(#PHONEBUS)(#STARTDTER)(#TERMDATER)(#DEPTMENT)(#SECTION)(#SALARY)(#STARTDTE)(#TERMDATE)(#MNTHSAL)) COUNTER(#T_PSLMST) TYPE(*WORKING);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DIR '\PSLMST.DAT') TO_GET(#S_193OFN);
********** COMMENT();
SELECT FIELDS(*ALL) FROM_FILE(PSLMST);
ADD_ENTRY TO_LIST(#L_PSLMST);
IF COND('#T_PSLMST >= #S_193LMT');
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_PSLMST #S_193OFN T I Y '.' N) TO_GET(#S_193RSP);
CLR_LIST NAMED(#L_PSLMST);
LEAVE IF(*NOTOKAY);
ENDIF;
ENDSELECT;
********** COMMENT();
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_PSLMST #S_193OFN T I Y '.' Y) TO_GET(#S_193RSP);
IF COND(*OKAY);
MESSAGE MSGTXT('File PSLMST.DAT created in specified directory');
ELSE;
MESSAGE MSGTXT('Attempt to create file PSLMST.DAT in specified directory failed');
ENDIF;
********** COMMENT();
********** COMMENT(-----------------------);
********** COMMENT(Handle the DEPTAB table);
********** COMMENT(-----------------------);
********** COMMENT();
WHEN VALUE_IS('= DEPTAB');
********** COMMENT();
DEFINE FIELD(#T_DEPTAB) REFFLD(#STD_NUM);
DEF_LIST NAME(#L_DEPTAB) FIELDS((#DEPTMENT)(#DEPTDESC)) COUNTER(#T_DEPTAB) TYPE(*WORKING);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DIR '\DEPTAB.DAT') TO_GET(#S_193OFN);
********** COMMENT();
SELECT FIELDS(*ALL) FROM_FILE(DEPTAB);
ADD_ENTRY TO_LIST(#L_DEPTAB);
IF COND('#T_DEPTAB >= #S_193LMT');
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_DEPTAB #S_193OFN T I Y '.' N) TO_GET(#S_193RSP);
CLR_LIST NAMED(#L_DEPTAB);
LEAVE IF(*NOTOKAY);
ENDIF;
ENDSELECT;
********** COMMENT();
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_DEPTAB #S_193OFN T I Y '.' Y) TO_GET(#S_193RSP);
IF COND(*OKAY);
MESSAGE MSGTXT('File DEPTAB.DAT created in specified directory');
ELSE;
MESSAGE MSGTXT('Attempt to create file DEPTAB.DAT in specified directory failed');
ENDIF;
********** COMMENT();
********** COMMENT(-----------------------);
********** COMMENT(Handle the SECTAB table);
********** COMMENT(-----------------------);
********** COMMENT();
WHEN VALUE_IS('= SECTAB');
********** COMMENT();
DEFINE FIELD(#T_SECTAB) REFFLD(#STD_NUM);
DEF_LIST NAME(#L_SECTAB) FIELDS((#DEPTMENT)(#SECTION)(#SECDESC)(#SECADDR1)(#SECADDR2)(#SECADDR3)(#SECPCODE)(#SECPHBUS)) COUNTER(#T_SECTAB) TYPE(*WORKING);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DIR '\SECTAB.DAT') TO_GET(#S_193OFN);
********** COMMENT();
SELECT FIELDS(*ALL) FROM_FILE(SECTAB);
ADD_ENTRY TO_LIST(#L_SECTAB);
IF COND('#T_SECTAB >= #S_193LMT');
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_SECTAB #S_193OFN T I Y '.' N) TO_GET(#S_193RSP);
CLR_LIST NAMED(#L_SECTAB);
LEAVE IF(*NOTOKAY);
ENDIF;
ENDSELECT;
********** COMMENT();
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#L_SECTAB #S_193OFN T I Y '.' Y) TO_GET(#S_193RSP);
IF COND(*OKAY);
MESSAGE MSGTXT('File SECTAB.DAT created in specified directory');
ELSE;
MESSAGE MSGTXT('Attempt to create file SECTAB.DAT in specified directory failed');
ENDIF;
********** COMMENT();
********** COMMENT(-------------------------);
********** COMMENT(Handle an unknown request);
********** COMMENT(-------------------------);
********** COMMENT();
OTHERWISE;
CHANGE FIELD(#S_193RSP) TO(ER);
MESSAGE MSGTXT('Request to write out unknown table name received by SET193E');
ENDCASE;
********** COMMENT();
********** COMMENT(Set up the response to be sent back);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(RESPONSE #S_193RSP);
********** COMMENT();
********** COMMENT(Disconnect all file I/Os from the AS/400 server);
********** COMMENT();
USE BUILTIN(DISCONNECT_FILE) WITH_ARGS('*' #S_193SSN);
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
RETURN;
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(==== Windows NT/2000 Interface Routines ====);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(These subroutines are used to simplify and);
********** COMMENT( standardize interfacing with a NT/2000);
********** COMMENT( service via function SET193T);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(============================================);
********** COMMENT(Begin: Sets or Resets an interaction between);
********** COMMENT( this program and an NT/2000 server. Use);
********** COMMENT( this subroutine at the start of each);
********** COMMENT( logical transaction.);
********** COMMENT(============================================);
SUBROUTINE NAME(BEGIN);
CHANGE FIELD(#S_193GSR) TO(I);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(EndService: Ends any existing connection with);
********** COMMENT( an NT/200 server and frees resources. Use);
********** COMMENT( when all interactions have been completed.);
********** COMMENT(============================================);
SUBROUTINE NAME(ENDSERVICE);
CHANGE FIELD(#S_193GSR) TO(T);
EXCHANGE FIELDS(#S_193GSR);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(First_Set : Sets up for the processing the);
********** COMMENT( first set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(FIRST_SET);
CHANGE FIELD(#S_193VIN) TO(1);
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(Next_Set : Sets up for the processing the);
********** COMMENT( next set of variable instances);
********** COMMENT(============================================);
SUBROUTINE NAME(NEXT_SET);
CHANGE FIELD(#S_193VIN) TO('#S_193VIN + 1');
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Alpha: Set the value of an alpha variable);
********** COMMENT( instance. Used as Put_Alpha ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(A);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Put_Number: Set the value of a numeric variable);
********** COMMENT( instance. Used as Put_Number ( <nam> <val> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(PUT_NUMBER) PARMS((#S_193VNM *RECEIVED) (#S_193VNV *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(B);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Alpha: Get the value of an alpha variable);
********** COMMENT( instance. Used as Get_Alpha (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RETURNED) (#D_193VAV *RECEIVED));
DEFINE FIELD(#D_193VAV) REFFLD(#S_193VAV) DESC('Alphanumeric Default Value');
CHANGE FIELD(#S_193GSR) TO(C);
CHANGE FIELD(#S_193VAV) TO(#D_193VAV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Get_Number: Get the value of a numeric variable);
********** COMMENT( instance. Used as Get_Number (<nam> <val> <dft>));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT( <dft> is the variable's default value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_NUMBER) PARMS((#S_193VNM *RECEIVED) (#S_193VNV *RETURNED) (#D_193VNV *RECEIVED));
DEFINE FIELD(#D_193VNV) REFFLD(#S_193VNV) DESC('Numeric Default Value');
CHANGE FIELD(#S_193GSR) TO(D);
CHANGE FIELD(#S_193VNV) TO(#D_193VNV);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VNV);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Send: Send all variables to a service);
********** COMMENT( Used as Send ( <nam> <fun> <com> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <fun> is the RDML function to invoke);
********** COMMENT( <com> is the RDML component to invoke);
********** COMMENT(================================================);
SUBROUTINE NAME(SEND) PARMS((#S_193SERV *RECEIVED) (#S_193FUN *RECEIVED) (#S_193COM *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(S);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193FUN #S_193COM);
EXECUTE SUBROUTINE(CALL_193T);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Receive: Receive all variables from a service);
********** COMMENT( Used as Receive ( <nam> <max> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the service symbolic name);
********** COMMENT( <max> is the maximum time to wait);
********** COMMENT(================================================);
SUBROUTINE NAME(RECEIVE) PARMS((#S_193SERV *RECEIVED) (#S_193MAXW *RECEIVED));
CHANGE FIELD(#S_193GSR) TO(R);
EXCHANGE FIELDS(#S_193GSR #S_193SERV #S_193MAXW);
EXECUTE SUBROUTINE(CALL_193T);
EXECUTE SUBROUTINE(FIRST_SET);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Call_193T: Used to call function SET193T);
********** COMMENT(================================================);
SUBROUTINE NAME(CALL_193T);
CALL PROCESS(*DIRECT) FUNCTION(SET193T);
ENDROUTINE;