Function SET192C: Glue Together iSeries and NT DBMS Data

LANSA

previous page next page
Function SET192C: Glue Together iSeries and NT DBMS Data
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_192);
********** COMMENT(Function .......: SET192C);
********** COMMENT(Created on .....: 26th October 2000);
********** COMMENT(Description ....: Demonstration Function);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function demonstrates);
********** COMMENT( how a WEB function can fetch details from an AS/400);
********** COMMENT(and NT/2000 database);
********** 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();
********** COMMENT(AS/400 Employee detail fields. They are used in the);
********** COMMENT(component S_192ASEM);
DEFINE FIELD(#S_ASADDR1) REFFLD(#ADDRESS1);
DEFINE FIELD(#S_ASADDR2) REFFLD(#ADDRESS2);
DEFINE FIELD(#S_ASGIVNA) REFFLD(#GIVENAME);
DEFINE FIELD(#S_ASSURNA) REFFLD(#SURNAME);
DEFINE FIELD(#S_ASPOSTC) REFFLD(#POSTCODE);
DEFINE FIELD(#S_ASSALAR) REFFLD(#SALARY);
********** COMMENT(NT/2000 Employee detail fields. They are used in the);
********** COMMENT(component S_192NTEM);
DEFINE FIELD(#S_NTADDR1) REFFLD(#ADDRESS1);
DEFINE FIELD(#S_NTADDR2) REFFLD(#ADDRESS2);
DEFINE FIELD(#S_NTGIVNA) REFFLD(#GIVENAME);
DEFINE FIELD(#S_NTSURNA) REFFLD(#SURNAME);
DEFINE FIELD(#S_NTPOSTC) REFFLD(#POSTCODE);
DEFINE FIELD(#S_NTSALAR) REFFLD(#SALARY);
********** COMMENT();
********** COMMENT(Page components:);
********** COMMENT(#S_192ASEM has the fields with the information coming);
********** COMMENT(from the AS/400 database (#XG_ASEMPD));
********** COMMENT(#S_192NTEM has the fields with the information coming);
********** COMMENT(from the NT/2000 database (#XG_NTEMPD));
DEFINE FIELD(#S_192ASEM) TYPE(*CHAR) LENGTH(001);
DEFINE FIELD(#S_192NTEM) TYPE(*CHAR) LENGTH(001);
********** COMMENT();
********** COMMENT(Employee fields to FETCH the AS/400 and EXCHANGE to);
********** COMMENT(function SET192B);
GROUP_BY NAME(#S_EMPFLDS) FIELDS((#EMPNO)(#GIVENAME)(#SURNAME)(#ADDRESS1)(#ADDRESS2)(#SALARY)(#POSTCODE)(#NT_EMP_ST)(#S_ACTIONX));
********** COMMENT();
********** COMMENT(Fields from NT database);
********** COMMENT();
GROUP_BY NAME(#S_NTEMPFL) FIELDS((#S_NTGIVNA)(#S_NTSURNA)(#S_NTADDR1)(#S_NTADDR2)(#S_NTSALAR)(#S_NTPOSTC));
********** COMMENT();
********** COMMENT(Fields from AS/400 database);
********** COMMENT();
GROUP_BY NAME(#S_ASEMPFL) FIELDS((#S_ASGIVNA)(#S_ASSURNA)(#S_ASADDR1)(#S_ASADDR2)(#S_ASSALAR)(#S_ASPOSTC));
********** COMMENT();
GROUP_BY NAME(#PANELDATA) FIELDS((#EMPNO)(#S_NTGIVNA *HIDDEN)(#S_NTSURNA *HIDDEN)(#S_NTADDR1 *HIDDEN)(#S_NTADDR2 *HIDDEN)(#S_NTPOSTC *HIDDEN)(#S_NTSALAR *HIDDEN)(#S_ASGIVNA *HIDDEN)(#S_ASSURNA *HIDDEN)(#S_ASADDR1 *HIDDEN)(#S_ASADDR2 *HIDDEN)(#S_ASPOSTC *HIDDEN)(#S_ASSALAR *HIDDEN)(#S_192ASEM)(#S_192NTEM)(#S_ACTIONX *HIDDEN));
********** COMMENT();
********** COMMENT(Mainline);
********** COMMENT();
CASE OF_FIELD(#S_ACTIONX);
WHEN VALUE_IS('= *blanks');
********** COMMENT(First time);
CHANGE FIELD(#S_ACTIONX) TO(CALLED192C);
OTHERWISE;
EXECUTE SUBROUTINE(GET_NT_EMP);
EXECUTE SUBROUTINE(GET_AS_EMP);
ENDCASE;
********** COMMENT();
EXECUTE SUBROUTINE(ENDSERVICE);
********** COMMENT(=======================================================);
REQUEST FIELDS(#PANELDATA) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT();
********** COMMENT(Calls SET192B to get the Employee details from the);
********** COMMENT(Nt/2000 database.);
SUBROUTINE NAME(GET_NT_EMP);
********** COMMENT();
DEFINE FIELD(#NT_EMP_ST) REFFLD(#IO$STS);
CHANGE FIELD(#S_ACTIONX) TO(CALLED192C);
EXCHANGE FIELDS(#S_EMPFLDS);
CALL PROCESS(*DIRECT) FUNCTION(SET192B) EXIT_USED(*NEXT) MENU_USED(*NEXT) NUM_LEN(*DEFINED);
IF COND('#nt_emp_st *eq OK');
CHANGE FIELD(#S_NTGIVNA) TO(#GIVENAME);
CHANGE FIELD(#S_NTSURNA) TO(#SURNAME);
CHANGE FIELD(#S_NTPOSTC) TO(#POSTCODE);
CHANGE FIELD(#S_NTSALAR) TO(#SALARY);
CHANGE FIELD(#S_NTADDR1) TO(#ADDRESS1);
CHANGE FIELD(#S_NTADDR2) TO(#ADDRESS2);
ELSE;
CHANGE FIELD(#S_NTEMPFL) TO(*NAVAIL);
ENDIF;
ENDROUTINE;
********** COMMENT(============================================);
********** COMMENT(Fetch Employee details from AS/400 database);
SUBROUTINE NAME(GET_AS_EMP);
********** COMMENT();
FETCH FIELDS(#S_EMPFLDS) FROM_FILE(PSLMST) WITH_KEY(#EMPNO);
IF COND('#io$sts *eq OK');
CHANGE FIELD(#S_ASGIVNA) TO(#GIVENAME);
CHANGE FIELD(#S_ASSURNA) TO(#SURNAME);
CHANGE FIELD(#S_ASPOSTC) TO(#POSTCODE);
CHANGE FIELD(#S_ASSALAR) TO(#SALARY);
CHANGE FIELD(#S_ASADDR1) TO(#ADDRESS1);
CHANGE FIELD(#S_ASADDR2) TO(#ADDRESS2);
ELSE;
CHANGE FIELD(#S_ASEMPFL) TO(*NAVAIL);
ENDIF;
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(Call_193T: Used to call function SET193T);
********** COMMENT(================================================);
SUBROUTINE NAME(CALL_193T);
CALL PROCESS(*DIRECT) FUNCTION(SET193T);
ENDROUTINE;
previous page start next page