Function VSAM133 : Example Tier Aware Subroutine
Name: VSAM133
Description: The following RDML function demonstrates programming techniques that can be used to make a classic "subroutine" style functions tier aware. Refer to comments in the function for more information.
Special Notes: You should check this function into your iSeries server system and compile it there as well as in your Visual LANSA environment.
FUNCTION OPTIONS(*HEAVYUSAGE *DBOPTIMISE *DIRECT *MLOPTIMIZE);
********** COMMENT(-------------------------------------------------------);
********** COMMENT( This RDML function is an example of a classic);
********** COMMENT( calleable "subroutine" (ie: you put some values);
********** COMMENT( in and you get a result back out again).);
********** COMMENT( The actual logic performed by this routine is);
********** COMMENT( slightly nonsensical.);
********** COMMENT(You must put in:);
********** COMMENT(#DEPCHAR1 - The first character of a);
********** COMMENT( Department Description);
********** COMMENT (blank means all);
********** COMMENT(#SECCHAR1 - The first character of a);
********** COMMENT( Section Description);
********** COMMENT (blank means all);
********** COMMENT(#SKLCHAR1 - The first character of a);
********** COMMENT( Skill Description);
********** COMMENT (blank means all);
********** COMMENT(and you get out :);
********** COMMENT(#SKILCOUNT - The total number of);
********** COMMENT( matching skills found for employeees);
********** COMMENT( working in matching departments );
********** COMMENT( and sections. );
********** COMMENT(The slightly nonsensical nature of this logic);
********** COMMENT(is not the issue here. The issue is that this);
********** COMMENT(logic does a lot of DBMS access to produce);
********** COMMENT(it's results, so it can be used to accentuate);
********** COMMENT(the performance differences you can expect);
********** COMMENT( when you use logic like this in thick or thin);
********** COMMENT(tiered modes. );
********** COMMENT(-------------------------------------------------------);
********** COMMENT(This is routine is "smart" in that it can figure out);
********** COMMENT(upon which tier to execute itself (the application tier);
********** COMMENT(and from which tier it needs to get it's data (the data);
********** COMMENT(tier).);
********** COMMENT(To the caller of this routine this is invisible.);
********** COMMENT(The caller simply codes a normal CALL command like this);
********** COMMENT( Change (#DepChar1 #SecChar1 #SklChar1) 'A');
********** COMMENT( Exchange (#DeptChar1 #SecChar1 #SklChar1));
********** COMMENT( Call Process(*Direct) Function(VSAM133));
********** COMMENT( << #SkilCount now contains the skills count >>);
********** COMMENT(-------------------------------------------------------);
********** COMMENT(This routine works equally as well in any 5250 green);
********** COMMENT(screen application, L4Web application or L4Win);
********** COMMENT(application. This routine will run, unchanged,);
********** COMMENT(in tiered or non-tiered execution environments. );
********** COMMENT(-------------------------------------------------------);
********** COMMENT(Define the standard input/ouput exchange);
********** COMMENT(-------------------------------------------------------);
DEFINE FIELD(#DEPCHAR1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#SECCHAR1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#SKLCHAR1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#SKILCOUNT) TYPE(*DEC) LENGTH(7) DECIMALS(0) EDIT_CODE(4);
EXCHANGE FIELDS(#DEPCHAR1 #SECCHAR1 #SKLCHAR1 #SKILCOUNT) OPTION(*ALWAYS);
********** COMMENT(-------------------------------------------------------);
********** COMMENT(If we are executing on the application tier then we);
********** COMMENT(are ready to start performing the real logic that);
********** COMMENT(this routine involves.);
********** COMMENT(-------------------------------------------------------);
IF COND('*Appl_Tier = YES');
EXECUTE SUBROUTINE(REALLOGIC);
ELSE;
********** COMMENT(-------------------------------------------------------);
********** COMMENT(Else we are NOT on the application tier, so pass);
********** COMMENT(control to this function on the application tier);
********** COMMENT(so that it can perform the logic for us. );
********** COMMENT(-------------------------------------------------------);
DEFINE FIELD(#BIFRETCDE) TYPE(*CHAR) LENGTH(2);
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*APPL_TIER *FUNCTION Y Y) TO_GET(#BIFRETCDE);
ENDIF;
********** COMMENT(Finished);
RETURN;
********** COMMENT(-------------------------------------------------------);
********** COMMENT(This is the real logic in this "subroutine");
********** COMMENT(-------------------------------------------------------);
SUBROUTINE NAME(REALLOGIC);
********** COMMENT(We are now running on the application tier, so we are);
********** COMMENT(ready to do the real logic. The final thing to do);
********** COMMENT((since this logic needs to read database rows) is to);
********** COMMENT(make sure that we are connected to the database tier);
********** COMMENT(as well. To do this we simply make a reference to the);
********** COMMENT(system variable named *Data_Tier which will handle all);
********** COMMENT(the details (this should be done before and data);
********** COMMENT(access is attempted).);
CHANGE FIELD(#STD_OBJ) TO(*DATA_TIER);
********** COMMENT(Now do the real logic .........);
DEFINE FIELD(#DEPCOMP1) TYPE(*CHAR) LENGTH(1) TO_OVERLAY(#DEPTDESC);
DEFINE FIELD(#SECCOMP1) TYPE(*CHAR) LENGTH(1) TO_OVERLAY(#SECDESC);
DEFINE FIELD(#SKLCOMP1) TYPE(*CHAR) LENGTH(1) TO_OVERLAY(#SKILDESC);
**********;
DEF_COND NAME(*NOTDEP) COND(' (#DepChar1 *ne #DepComp1) *and (#DepChar1 *ne *blanks) ');
DEF_COND NAME(*NOTSEC) COND(' (#SecChar1 *ne #SecComp1) *and (#SecChar1 *ne *blanks) ');
DEF_COND NAME(*NOTSKL) COND(' (#SklChar1 *ne #SklComp1) *and (#SklChar1 *ne *blanks)');
********** COMMENT(Set null count);
CHANGE FIELD(#SKILCOUNT) TO(0);
********** COMMENT(Select matching details and keep count of matches);
SELECT FIELDS(*ALL) FROM_FILE(PSLMST);
FETCH FIELDS(#DEPTDESC) FROM_FILE(DEPTAB) WITH_KEY(#DEPTMENT);
CONTINUE IF(*NOTDEP);
FETCH FIELDS(#SECDESC) FROM_FILE(SECTAB) WITH_KEY(#DEPTMENT #SECTION);
CONTINUE IF(*NOTSEC);
SELECT FIELDS(*ALL) FROM_FILE(PSLSKL) WITH_KEY(#EMPNO);
FETCH FIELDS(#SKILDESC) FROM_FILE(SKLTAB) WITH_KEY(#SKILCODE);
CONTINUE IF(*NOTSKL);
CHANGE FIELD(#SKILCOUNT) TO('#SkilCount + 1');
ENDSELECT;
ENDSELECT;
********** COMMENT(Finished (SkilCount now contains the result));
RETURN;
ENDROUTINE;
Name: VSAM133
Description: The following RDML function demonstrates programming techniques that can be used to make a classic "subroutine" style functions tier aware. Refer to comments in the function for more information.
Special Notes: You should check this function into your iSeries server system and compile it there as well as in your Visual LANSA environment.
FUNCTION OPTIONS(*HEAVYUSAGE *DBOPTIMISE *DIRECT *MLOPTIMIZE);
********** COMMENT(-------------------------------------------------------);
********** COMMENT( This RDML function is an example of a classic);
********** COMMENT( calleable "subroutine" (ie: you put some values);
********** COMMENT( in and you get a result back out again).);
********** COMMENT( The actual logic performed by this routine is);
********** COMMENT( slightly nonsensical.);
********** COMMENT(You must put in:);
********** COMMENT(#DEPCHAR1 - The first character of a);
********** COMMENT( Department Description);
********** COMMENT (blank means all);
********** COMMENT(#SECCHAR1 - The first character of a);
********** COMMENT( Section Description);
********** COMMENT (blank means all);
********** COMMENT(#SKLCHAR1 - The first character of a);
********** COMMENT( Skill Description);
********** COMMENT (blank means all);
********** COMMENT(and you get out :);
********** COMMENT(#SKILCOUNT - The total number of);
********** COMMENT( matching skills found for employeees);
********** COMMENT( working in matching departments );
********** COMMENT( and sections. );
********** COMMENT(The slightly nonsensical nature of this logic);
********** COMMENT(is not the issue here. The issue is that this);
********** COMMENT(logic does a lot of DBMS access to produce);
********** COMMENT(it's results, so it can be used to accentuate);
********** COMMENT(the performance differences you can expect);
********** COMMENT( when you use logic like this in thick or thin);
********** COMMENT(tiered modes. );
********** COMMENT(-------------------------------------------------------);
********** COMMENT(This is routine is "smart" in that it can figure out);
********** COMMENT(upon which tier to execute itself (the application tier);
********** COMMENT(and from which tier it needs to get it's data (the data);
********** COMMENT(tier).);
********** COMMENT(To the caller of this routine this is invisible.);
********** COMMENT(The caller simply codes a normal CALL command like this);
********** COMMENT( Change (#DepChar1 #SecChar1 #SklChar1) 'A');
********** COMMENT( Exchange (#DeptChar1 #SecChar1 #SklChar1));
********** COMMENT( Call Process(*Direct) Function(VSAM133));
********** COMMENT( << #SkilCount now contains the skills count >>);
********** COMMENT(-------------------------------------------------------);
********** COMMENT(This routine works equally as well in any 5250 green);
********** COMMENT(screen application, L4Web application or L4Win);
********** COMMENT(application. This routine will run, unchanged,);
********** COMMENT(in tiered or non-tiered execution environments. );
********** COMMENT(-------------------------------------------------------);
********** COMMENT(Define the standard input/ouput exchange);
********** COMMENT(-------------------------------------------------------);
DEFINE FIELD(#DEPCHAR1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#SECCHAR1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#SKLCHAR1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#SKILCOUNT) TYPE(*DEC) LENGTH(7) DECIMALS(0) EDIT_CODE(4);
EXCHANGE FIELDS(#DEPCHAR1 #SECCHAR1 #SKLCHAR1 #SKILCOUNT) OPTION(*ALWAYS);
********** COMMENT(-------------------------------------------------------);
********** COMMENT(If we are executing on the application tier then we);
********** COMMENT(are ready to start performing the real logic that);
********** COMMENT(this routine involves.);
********** COMMENT(-------------------------------------------------------);
IF COND('*Appl_Tier = YES');
EXECUTE SUBROUTINE(REALLOGIC);
ELSE;
********** COMMENT(-------------------------------------------------------);
********** COMMENT(Else we are NOT on the application tier, so pass);
********** COMMENT(control to this function on the application tier);
********** COMMENT(so that it can perform the logic for us. );
********** COMMENT(-------------------------------------------------------);
DEFINE FIELD(#BIFRETCDE) TYPE(*CHAR) LENGTH(2);
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*APPL_TIER *FUNCTION Y Y) TO_GET(#BIFRETCDE);
ENDIF;
********** COMMENT(Finished);
RETURN;
********** COMMENT(-------------------------------------------------------);
********** COMMENT(This is the real logic in this "subroutine");
********** COMMENT(-------------------------------------------------------);
SUBROUTINE NAME(REALLOGIC);
********** COMMENT(We are now running on the application tier, so we are);
********** COMMENT(ready to do the real logic. The final thing to do);
********** COMMENT((since this logic needs to read database rows) is to);
********** COMMENT(make sure that we are connected to the database tier);
********** COMMENT(as well. To do this we simply make a reference to the);
********** COMMENT(system variable named *Data_Tier which will handle all);
********** COMMENT(the details (this should be done before and data);
********** COMMENT(access is attempted).);
CHANGE FIELD(#STD_OBJ) TO(*DATA_TIER);
********** COMMENT(Now do the real logic .........);
DEFINE FIELD(#DEPCOMP1) TYPE(*CHAR) LENGTH(1) TO_OVERLAY(#DEPTDESC);
DEFINE FIELD(#SECCOMP1) TYPE(*CHAR) LENGTH(1) TO_OVERLAY(#SECDESC);
DEFINE FIELD(#SKLCOMP1) TYPE(*CHAR) LENGTH(1) TO_OVERLAY(#SKILDESC);
**********;
DEF_COND NAME(*NOTDEP) COND(' (#DepChar1 *ne #DepComp1) *and (#DepChar1 *ne *blanks) ');
DEF_COND NAME(*NOTSEC) COND(' (#SecChar1 *ne #SecComp1) *and (#SecChar1 *ne *blanks) ');
DEF_COND NAME(*NOTSKL) COND(' (#SklChar1 *ne #SklComp1) *and (#SklChar1 *ne *blanks)');
********** COMMENT(Set null count);
CHANGE FIELD(#SKILCOUNT) TO(0);
********** COMMENT(Select matching details and keep count of matches);
SELECT FIELDS(*ALL) FROM_FILE(PSLMST);
FETCH FIELDS(#DEPTDESC) FROM_FILE(DEPTAB) WITH_KEY(#DEPTMENT);
CONTINUE IF(*NOTDEP);
FETCH FIELDS(#SECDESC) FROM_FILE(SECTAB) WITH_KEY(#DEPTMENT #SECTION);
CONTINUE IF(*NOTSEC);
SELECT FIELDS(*ALL) FROM_FILE(PSLSKL) WITH_KEY(#EMPNO);
FETCH FIELDS(#SKILDESC) FROM_FILE(SKLTAB) WITH_KEY(#SKILCODE);
CONTINUE IF(*NOTSKL);
CHANGE FIELD(#SKILCOUNT) TO('#SkilCount + 1');
ENDSELECT;
ENDSELECT;
********** COMMENT(Finished (SkilCount now contains the result));
RETURN;
ENDROUTINE;