Function SET1937: Read from NT file System

LANSA

Function SET1937: Read from NT file System
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET1937);
********** COMMENT(Created on .....: 12th October 2000);
********** COMMENT(Description ....: Demonstration Function 5);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how an AS/400 function can read data from the);
********** COMMENT( Windows NT/2000 file system 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(*LIGHTUSAGE *DIRECT);
********** COMMENT();
********** COMMENT(Loop around displaying files until cancelled);
********** COMMENT();
DEFINE FIELD(#S_193VFIL) TYPE(*CHAR) LENGTH(200) DESC('NT/2000 File Name (eg: C:\AUTOEXEC.BAT) ') INPUT_ATR(LC);
DEFINE FIELD(#S_193LFIL) REFFLD(#S_193VFIL);
DEFINE FIELD(#S_193STS) TYPE(*CHAR) LENGTH(2) DESC('Operation status');
DEFINE FIELD(#S_193SRC) REFFLD(#STD_NUM);
DEFINE FIELD(#S_193TRC) REFFLD(#STD_NUM);
DEFINE FIELD(#S_193DAT) TYPE(*CHAR) LENGTH(78) DESC('File data');
DEFINE FIELD(#S_193LSTC) REFFLD(#STD_NUM) DESC('List Entry Counter');
DEF_LIST NAME(#S_193LIST) FIELDS(#S_193DAT) COUNTER(#S_193LSTC);
********** COMMENT();
MESSAGE MSGTXT('Specify fully qualified file name. Press enter.');
BEGIN_LOOP;
********** COMMENT();
********** COMMENT(Request number of employee that is to be displayed);
********** COMMENT();
REQUEST FIELDS(#S_193VFIL) DESIGN(*DOWN) IDENTIFY(*DESC) BROWSELIST(#S_193LIST) EXIT_KEY(*NO) MENU_KEY(*YES E10) PROMPT_KEY(*NO);
********** COMMENT();
********** COMMENT(If the file name has changed then there is work to do);
********** COMMENT();
IF COND('#S_193VFIL *ne #S_193LFIL');
**********;
********** COMMENT(Ask the NT server to check for existence of the file);
**********;
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ACTION EXISTS);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(FILE_NAME #S_193VFIL);
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL SET1938 *BLANKS);
MESSAGE MSGTXT('Checking file exists on NT/2000 server system') TYPE(*STATUS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(STATUS #S_193STS ER);
**********;
********** COMMENT(If the file exists then load up its details);
**********;
IF COND('#s_193STS = OK');
CHANGE FIELD(#S_193LFIL) TO(#S_193VFIL);
**********;
********** COMMENT(Load the file in small blocks);
**********;
MESSAGE MSGTXT('Loading file data from NT/2000 server system') TYPE(*STATUS);
CHANGE FIELD(#S_193SRC) TO(0);
CLR_LIST NAMED(#S_193LIST);
**********;
********** COMMENT(Load the file in smallish blocks);
**********;
DOUNTIL COND('(#S_193STS *ne OV) *or (#S_193LSTC >= 9999)');
**********;
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ACTION LOAD);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(FILE_NAME #S_193VFIL);
EXECUTE SUBROUTINE(PUT_NUMBER) WITH_PARMS(LAST_ROW #S_193SRC);
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL SET1938 *BLANKS);
**********;
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(STATUS #S_193STS ER);
EXECUTE SUBROUTINE(GET_NUMBER) WITH_PARMS(ROWS_RETURNED #S_193TRC 0);
EXECUTE SUBROUTINE(GET_NUMBER) WITH_PARMS(LAST_ROW #S_193SRC 0);
BEGIN_LOOP TO(#S_193TRC);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(FILE_RECORD #S_193DAT *BLANKS);
ADD_ENTRY TO_LIST(#S_193LIST);
LEAVE IF('#S_193LSTC >= 9999');
EXECUTE SUBROUTINE(NEXT_SET);
END_LOOP;
**********;
ENDUNTIL;
ELSE;
**********;
********** COMMENT(Else show an error against the file name);
**********;
BEGINCHECK;
SET_ERROR FOR_FIELD(#S_193VFIL) MSGTXT('File not found or not accessible on NT/2000 server system');
ENDCHECK IF_ERROR(*NEXT);
ENDIF;
ENDIF;
********** COMMENT(Loop around for next employee);
END_LOOP;
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
E10: EXECUTE SUBROUTINE(ENDSERVICE);
MENU;
********** 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;