Function SET192B: Fetch/Update of NT DBMS Table

LANSA

Function SET192B: Fetch/Update of NT DBMS Table
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_192);
********** COMMENT(Function .......: SET192B);
********** COMMENT(Created on .....: 24th October 2000);
********** COMMENT(Description ....: Demonstration Function);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how an AS/400 function can fetch and update details);
********** COMMENT( residing in a DBMS table on a Windows NT/2000 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 *WEBEVENT);
********** COMMENT();
DEFINE FIELD(#NT_EMP_ST) REFFLD(#IO$STS);
DEFINE FIELD(#S_192EMPN) REFFLD(#EMPNO);
DEFINE FIELD(#SHOW_DET) TYPE(*CHAR) LENGTH(001) DESC('Used as CONDITION, show emp det if found');
********** COMMENT(The following 4 fields are dummy fields because they);
********** COMMENT(are not actually used as they are defined. Each one of);
********** COMMENT(them has a component associated.);
********** COMMENT(#S_192FIND - page component with the FIND button def.);
DEFINE FIELD(#S_192FIND) TYPE(*CHAR) LENGTH(001) DESC('FIND button dummy field');
********** COMMENT(#S_192UPDA - page component with the UPDATE button def.);
DEFINE FIELD(#S_192UPDA) TYPE(*CHAR) LENGTH(001) DESC('UPDATE button dummy field');
********** COMMENT(#S_192FCMP - page component requesting the Employee No.);
********** COMMENT(to be searched);
DEFINE FIELD(#S_192FCMP) TYPE(*CHAR) LENGTH(001) DESC('Request Empno to find, dummy field');
********** COMMENT(#S_192DCMP - page component displaying the Employee);
********** COMMENT(Details if found);
DEFINE FIELD(#S_192DCMP) TYPE(*CHAR) LENGTH(001) DESC('Show Emp details if found, dummy field');
GROUP_BY NAME(#PANELDATA) FIELDS((#EMPNO)(#S_192FIND)(#GIVENAME)(#SURNAME)(#ADDRESS1)(#ADDRESS2)(#SALARY)(#S_192UPDA)(#SHOW_DET *HIDDEN)(#POSTCODE)(#S_192FCMP)(#S_192DCMP)(#S_192EMPN *HIDDEN)(#S_ACTIONX *HIDDEN));
********** COMMENT();
GROUP_BY NAME(#S_EMPFLDS) FIELDS((#EMPNO)(#GIVENAME)(#SURNAME)(#ADDRESS1)(#ADDRESS2)(#SALARY)(#POSTCODE)(#NT_EMP_ST)(#S_ACTIONX *HIDDEN));
********** COMMENT(Mainline);
********** COMMENT();
CASE OF_FIELD(#S_ACTIONX);
WHEN VALUE_IS('= *blanks');
********** COMMENT(First time);
CHANGE FIELD(#S_ACTIONX) TO(FIND);
WHEN VALUE_IS('= FIND');
********** COMMENT(FIND button pressed, FETCH employee details from NT db);
EXECUTE SUBROUTINE(FIND_EMPNO);
WHEN VALUE_IS('= UPDATE');
********** COMMENT(UPDATE button pressed, UPDATE employee details in NT db);
EXECUTE SUBROUTINE(UPDA_EMPNO);
WHEN VALUE_IS('= CALLED192C');
********** COMMENT(Function is called from SET192C. FETCH employee details);
********** COMMENT(and RETURN to caller);
EXECUTE SUBROUTINE(FIND_EMPNO);
EXCHANGE FIELDS(#S_EMPFLDS);
RETURN;
ENDCASE;
********** COMMENT();
EXECUTE SUBROUTINE(ENDSERVICE);
********** COMMENT(=======================================================);
********** COMMENT(Request email details (from, to, subject, text));
********** COMMENT(=======================================================);
REQUEST FIELDS(#PANELDATA) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(--------);
********** COMMENT(Finished);
********** COMMENT(--------);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT( AS_Client: AS/400 "Client" logic);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
********** COMMENT(===============================================);
SUBROUTINE NAME(FIND_EMPNO);
********** COMMENT();
********** COMMENT();
********** COMMENT(Attempt to fetch the employee from the NT/2000 system);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ACTION GET);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(EMPNO #EMPNO);
********** COMMENT();
********** COMMENT(Send/Receive details to/from the NT/2000 server system);
********** COMMENT(and get back the I/O status code);
********** COMMENT();
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL SET1933 *BLANKS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
CHANGE FIELD(#IO$STS) TO(NR);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS('IO_STATUS' #IO$STS);
********** COMMENT();
********** COMMENT(If found get employee details and display them);
********** COMMENT();
CHANGE FIELD(#NT_EMP_ST) TO(#IO$STS);
********** COMMENT();
IF COND('#IO$STS = OK');
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(GIVENAME #GIVENAME);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(SURNAME #SURNAME);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ADDRESS1 #ADDRESS1);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(ADDRESS2 #ADDRESS2);
EXECUTE SUBROUTINE(GET_NUMBER) WITH_PARMS(POSTCODE #POSTCODE);
EXECUTE SUBROUTINE(GET_NUMBER) WITH_PARMS(SALARY #SALARY);
CHANGE FIELD(#SHOW_DET) TO(X);
CHANGE FIELD(#S_192EMPN) TO(#EMPNO);
ELSE;
CHANGE FIELD(#SHOW_DET) TO(*BLANKS);
ENDIF;
********** COMMENT();
ENDROUTINE;
********** COMMENT();
********** COMMENT(Handle a change request by getting the);
********** COMMENT(NT/2000 server system to do the update);
SUBROUTINE NAME(UPDA_EMPNO);
********** COMMENT();
EXECUTE SUBROUTINE(BEGIN);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ACTION UPDATE);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(EMPNO #EMPNO);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(GIVENAME #GIVENAME);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(SURNAME #SURNAME);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ADDRESS1 #ADDRESS1);
EXECUTE SUBROUTINE(PUT_ALPHA) WITH_PARMS(ADDRESS2 #ADDRESS2);
EXECUTE SUBROUTINE(PUT_NUMBER) WITH_PARMS(POSTCODE #POSTCODE);
EXECUTE SUBROUTINE(PUT_NUMBER) WITH_PARMS(SALARY #SALARY);
EXECUTE SUBROUTINE(SEND) WITH_PARMS(GENL SET1933 *BLANKS);
EXECUTE SUBROUTINE(RECEIVE) WITH_PARMS(GENL 30);
CHANGE FIELD(#IO$STS) TO(VE);
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS('IO_STATUS' #IO$STS);
********** COMMENT();
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> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RETURNED));
CHANGE FIELD(#S_193GSR) TO(C);
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> ));
********** COMMENT( where :);
********** COMMENT( <nam> is the variable's symbolic name);
********** COMMENT( <val> is the variable's returned value);
********** COMMENT(================================================);
SUBROUTINE NAME(GET_NUMBER) PARMS((#S_193VNM *RECEIVED) (#S_193VNV *RETURNED));
CHANGE FIELD(#S_193GSR) TO(D);
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;