7.119.3 SUBROUTINE の使用例 - 1

SUBROUTINEを実行する

パラメータを指定してSUBROUTINEを実行する

パラメータとして数値リテラルを指定してSUBROUTINEを実行する

パラメータとして英数字リテラルを指定してSUBROUTINEを実行する

パラメータとしてシステム変数を指定してSUBROUTINEを実行する

SUBROUTINEを使用してコーディング量を減らす

SUBROUTINEを使用して従業員の詳細を印刷する

BBUSEテンプレートを使用したSUBROUTINEのドキュメント化技法

再帰

サブルーチン変数はローカルでスコープ指定されない

命名標準を使用してローカル・スコープ指定をエミュレートする

グローバルにスコープ指定された変数の保管/復元技法

7.119.4 SUBROUTINE の使用例 - 2

SUBROUTINEを実行する

以下の例は、パラメータを渡さずにサブルーチンを実行する方法を示しています。

EXECUTE    SUBROUTINE(SUB1)
SUBROUTINE NAME(SUB1)
* <<Logic>>
ENDROUTINE 
 

パラメータを指定してSUBROUTINEを実行する

サブルーチンにパラメータを渡すには、EXECUTEコマンドのWITH_PARMS()パラメータを使用します。EXECUTEコマンドで渡すフィールドまたは値(WITH_PARMS)の数は、SUBROUTINEコマンドが想定している数と同じでなければなりません。

EXECUTE    SUBROUTINE(SUB1) WITH_PARMS(#EMPNO)
EXECUTE    SUBROUTINE(SUB2) WITH_PARMS(#GIVENAME #SURNAME)
EXECUTE    SUBROUTINE(SUB3) WITH_PARMS(#SALARY #TOTAL)
SUBROUTINE NAME(SUB1) PARMS((#EMP1 *RETURNED))
CHANGE     FIELD(#EMP1) TO(A0088)
ENDROUTINE 
SUBROUTINE NAME(SUB2) PARMS((#NAME1 *RETURNED) (#NAME2 *RETURNED))
CHANGE     FIELD(#NAME1) TO(JOHN)
CHANGE     FIELD(#NAME2) TO(COOK)
ENDROUTINE 
SUBROUTINE NAME(SUB3) PARMS((#WAGES *RECEIVED) (#SUM *RETURNED))
CHANGE     FIELD(#WAGES) TO(230000)
CHANGE     FIELD(#SUM) TO('#WAGES * 1.1')
ENDROUTINE
 

この例では、*RETURNEDが指定された#EMP1などのフィールドは、サブルーチンの完了時に#EMPNOにマッピングされます。

ファンクションをこのロジックでコーティングした場合、各サブルーチンのフィールド#EMPNO、#GIVENAME、#SURNAME、および#TOTALの結果は以下のようになります。

    #EMPNO = A0080
    #GIVENAME = John
    #SURNAME = COOK
    #TOTAL = 253,000.00
 

パラメータとして数値リテラルを指定してSUBROUTINEを実行する

以下の例では、サブルーチンAは2つの数値を受け取ります。1つの数値はフィールド#STD_NUMで渡され、もう1つは数値リテラル(0.75)として渡されます。このサブルーチンは計算を実行し、値をフィールド#DISCOUNTに返します。

DEFINE     FIELD(#DISCOUNT) TYPE(*DEC) LENGTH(10) DECIMALS(2) LABEL(DISCOUNT) EDIT_CODE(3)
DEFINE     FIELD(#Q) REFFLD(#STD_NUM)
DEFINE     FIELD(#N) TYPE(*DEC) LENGTH(3) DECIMALS(2)
DEFINE     FIELD(#D) TYPE(*DEC) LENGTH(10) DECIMALS(2) EDIT_CODE(3)
BEGIN_LOOP 
REQUEST    FIELDS(#STD_NUM)
EXECUTE    SUBROUTINE(A) WITH_PARMS(#STD_NUM 0.75 #DISCOUNT)
DISPLAY    FIELDS(#DISCOUNT)
CHANGE     FIELD(#DISCOUNT) TO(#ZEROS)
END_LOOP   
SUBROUTINE NAME(A) PARMS((#Q *RECEIVED) (#N *RECEIVED) (#D *RETURNED))
CHANGE     FIELD(#D) TO('#Q * #N')
ENDROUTINE
 

以下の例のように、サブルーチン内の*RECEIVEDまたは*RETURNEDパラメータのフィールドが、EXECUTEコマンドで使用されるフィールドまたはリテラルと同じフィールド形式(長さ、タイプなど)で定義されていない場合、問題が発生することがあります。

DEFINE     FIELD(#DISCOUNT) TYPE(*DEC) LENGTH(10) DECIMALS(2) LABEL(DISCOUNT) EDIT_CODE(3)
DEFINE     FIELD(#Q) REFFLD(#STD_NUM)
DEFINE     FIELD(#N) REFFLD(#STD_NUM)
DEFINE     FIELD(#D) TYPE(*DEC) LENGTH(10) DECIMALS(2) EDIT_CODE(3)
BEGIN_LOOP 
EXECUTE    SUBROUTINE(A) WITH_PARMS(1234 0.75 #DISCOUNT)
DISPLAY    FIELDS(#DISCOUNT)
CHANGE     FIELD(#DISCOUNT) TO(#ZEROS)
END_LOOP   
SUBROUTINE NAME(A) PARMS((#Q *RECEIVED) (#N *RECEIVED) (#D *RETURNED))
CHANGE     FIELD(#D) TO('#Q * #N')
ENDROUTINE
 

フィールド#Nはパック10進数(7,0)として定義されています。

リテラル0.75がサブルーチンに渡されますが、この値の小数点以下桁数は、サブルーチンがフィールド#Nに対して想定しているものと一致しません。

その結果、サブルーチンが受け取るフィールド#Nには、不適切に値0が保管されます。

正しく動作させるには、フィールド#Nを以下のように定義しなければなりません。

DEFINE     FIELD(#N) TYPE(*DEC) LENGTH(3) DECIMALS(2)
 

パラメータとして英数字リテラルを指定してSUBROUTINEを実行する

以下の例では、サブルーチンSTDNAMEは、フィールド#STRING1および#STRING2の2つの文字列を連結してフィールド#TEXTに保管します。このフィールドは、#CTEXTにマッピング(*RETURNED)されます。

DEFINE     FIELD(#OPTION) TYPE(*CHAR) LENGTH(1)
DEFINE     FIELD(#CTEXT) TYPE(*CHAR) LENGTH(30) LABEL('Text')
BEGIN_LOOP 
REQUEST    FIELDS(#OPTION)
CASE       OF_FIELD(#OPTION)
WHEN       VALUE_IS('= C')
EXECUTE    SUBROUTINE(STDNAME) WITH_PARMS(WILSON COOKSON #CTEXT)
DISPLAY    FIELDS(#CTEXT)
OTHERWISE  
MESSAGE    MSGTXT('Not a valid option')
ENDCASE    
END_LOOP   
SUBROUTINE NAME(STDNAME) PARMS((#STRING1 *RECEIVED) (#STRING2 *RECEIVED) (#TEXT *RETURNED))
DEFINE     FIELD(#STRING1) TYPE(*CHAR) LENGTH(10)
DEFINE     FIELD(#STRING2) TYPE(*CHAR) LENGTH(10)
DEFINE     FIELD(#TEXT) TYPE(*CHAR) LENGTH(30)
USE        BUILTIN(CONCAT) WITH_ARGS(#STRING1 #STRING2) TO_GET(#TEXT)
ENDROUTINE 
 

パラメータとしてシステム変数を指定してSUBROUTINEを実行する

パラメータとしてシステム変数を渡すこともできます。以下の例では、システム変数*FUNCTIONを渡します。

DEFINE     FIELD(#TEMP) REFFLD(#FUNCTION)
DEFINE     FIELD(#TEMP2) REFFLD(#STD_TEXT)
DEFINE     FIELD(#TEXT) TYPE(*CHAR) LENGTH(20)
BEGIN_LOOP 
EXECUTE    SUBROUTINE(VARIABLE) WITH_PARMS(*FUNCTION #STD_TEXT)
DISPLAY    FIELDS(#STD_TEXT)
MESSAGE    MSGTXT('Not a valid option')
END_LOOP   
SUBROUTINE NAME(VARIABLE) PARMS((#TEMP *RECEIVED) (#TEMP2 *RETURNED))
CHANGE     FIELD(#TEXT) TO('Function name:')
USE        BUILTIN(CONCAT) WITH_ARGS(#TEXT #TEMP) TO_GET(#TEMP2)
ENDROUTINE 
 

SUBROUTINEを使用してコーディング量を減らす

SUBROUTINEを使用すると、RDMLコードの量を減らすとともに、コードをより簡潔に、わかりやすくすることができます。CHANGEコマンドを使用して値を作業リストに追加する、以下の例について考えます。

CHANGE     FIELD(#EMPNO) TO(A0090)
CHANGE     FIELD(#NAME) TO('Fred')
CHANGE     FIELD(#SALARY) TO(23456.78)
ADD_ENTRY  TO_LIST(#LIST)
CHANGE     FIELD(#EMPNO) TO(A0070)
CHANGE     FIELD(#NAME) TO('Mary')
CHANGE     FIELD(#SALARY) TO(43456.78)
ADD_ENTRY  TO_LIST(#LIST)
CHANGE     FIELD(#EMPNO) TO(A0072)
CHANGE     FIELD(#NAME) TO('William')
CHANGE     FIELD(#SALARY) TO(33456.78)
ADD_ENTRY  TO_LIST(#LIST)
 

このコードを変更して、作業リストに追加する値を受け取るサブルーチンを使用することにより、ファンクションが整然となり、コードの構造が明確になります。

EXECUTE    SUBROUTINE(ADDTOLIST) WITH_PARMS(A0090 'Fred' 23456.78)
EXECUTE    SUBROUTINE(ADDTOLIST) WITH_PARMS(A0070 'Mary' 43456.78)
EXECUTE    SUBROUTINE(ADDTOLIST) WITH_PARMS(A0072 'William' 33456.78)
SUBROUTINE NAME(ADDTOLIST) PARMS((#EMPNO *RECEIVED) (#NAME *RECEIVED) (#SALARY *RECEIVED))
ADD_ENTRY  TO_LIST(#LIST)
ENDROUTINE 
 

SUBROUTINEを使用して従業員の詳細を印刷する

他の例と同様に、この例では、サブルーチンを使用して、PSLMSTから選択された従業員の詳細を印刷(PRINT)します。

行を印刷するサブルーチンは、同じLANSAファンクションの複数の部分で同じ行を印刷する必要がある場合に便利な方法です。

DEFINE     FIELD(#D1) REFFLD(#EMPNO)
DEFINE     FIELD(#D2) REFFLD(#SURNAME)
DEFINE     FIELD(#D3) REFFLD(#GIVENAME)
DEFINE     FIELD(#OPTION) TYPE(*CHAR) LENGTH(2)
DEF_LIST   NAME(#LIST1) FIELDS(#EMPNO #SURNAME #GIVENAME)
BEGIN_LOOP 
REQUEST    FIELDS(#OPTION)
CASE       OF_FIELD(#OPTION)
WHEN       VALUE_IS('= A')
SELECT     FIELDS(#EMPNO #SURNAME #GIVENAME) FROM_FILE(PSLMST)
ADD_ENTRY  TO_LIST(#LIST1)
EXECUTE    SUBROUTINE(PRINT) WITH_PARMS(#EMPNO #SURNAME #GIVENAME)
ENDSELECT  
OTHERWISE  
CALL       PROCESS(MYPROC)
ENDCASE    
DISPLAY    FIELDS(#EMPNO #SURNAME #GIVENAME) BROWSELIST(#LIST1)
END_LOOP   
SUBROUTINE NAME(PRINT) PARMS((#D1 *RECEIVED) (#D2 *RECEIVED) (#D3 *RECEIVED))
DEF_LINE   NAME(#NAME) FIELDS(#D1 #D2 #D3)
PRINT      LINE(#NAME)
ENDROUTINE