ストアドプロシージャを使用すると、Adabas ダイレクトコマンド PC を使用してデータベース内に存在するプロシージャを直接呼び出すことができます。
このドキュメントでは、次のトピックについて説明します。
ストアドプロシージャのリンクルーチン STPLNKnn とともに PC コマンドを使用して、ストアドプロシージャを呼び出します。
STPLNKnn は、SYSSPT ライブラリ内にソース形式で用意されています。
ライブラリ SYSSPT にある STPLNK01、STPLNK02、および STPLNK03 は、呼び出し元のストアドプロシージャで PC コマンドを使用するサンプルです。 各サンプルは、異なる方法でパラメータをルーチンに渡します。
これらのサンプルを使用することも、独自のルーチンを作成することもできます。 サンプルを使用する場合、ルーチンのコードまたは名前を変更して、サイトの標準や要件に合わせることができます。 ルーチン名をインラインコードとしてメイン Natural プログラムに組み込むこともできます。
3 つのサンプルでは、Natural ルーチン CMADA をコールすることで、PC コマンドが呼び出されます。 このエントリ名を直接コーディングしたくない場合は、代わりにライブラリ SYSEXT 内の Natural サブプログラム USR1043N に対して、CALLNAT を発行することもできます。 CALLNAT を使用する方法の利点は、名前 "CMADA" に対する変更からコードを隔離できることです。名前の変更は、時間が経過したりプラットフォームが異なると発生する可能性があります。
STPLNKnn を使用してストアドプロシージャ要求を呼び出す前に、PC コマンド（ダイレクトコール）の Adabas コントロールブロック（ACB）を設定する必要があります。
このセクションでは、次のトピックについて説明します。
PC コマンドは、ストアドプロシージャを呼び出すメカニズムを提供します。
パラメータは、レコードバッファを使用して渡されます。その後、パラメータはストアドプロシージャを使用して更新されて、呼び出し元に返されます。
フォーマットバッファは、プロシージャにパラメータを定義するために使用できます。 そのような情報は、レコードバッファ抽出ルーチンを呼び出すときに使用される可能性があります。
| フィールド | 位置 | フォーマット | Adabas コール前 |
Adabas コール後 |
|---|---|---|---|---|
| 1～2 | 未使用 | 未使用 | 未使用 | |
| コマンドコード | 3～4 | 英数字 | F | U |
| コマンド ID | 5～8 | 英数字 | F | U |
| ファイル番号 | 9～10 | 英数字 | F | U |
| レスポンスコード | 11～12 | バイナリ | 未使用 | A |
| 13～24 | 未使用 | 未使用 | 未使用 | |
| フォーマットバッファ長 | 25～26 | バイナリ | F | U |
| レコードバッファ長 | 27～28 | バイナリ | F | U |
| 29～36 | 未使用 | 未使用 | 未使用 | |
| アディション 1 | 37～44 | 英数字 | F | U |
| アディション 2 | 45～48 | バイナリ／バイナリ | A | |
| アディション 3 | 49～56 | 英数字 | F | A |
| アディション 4 | 57～64 | 英数字 | 未使用 | A |
| 65～76 | 未使用 | 未使用 | 未使用 | |
| ユーザーエリア | 77～80 | U |
| バッファ | Adabas コール前 | Adabas コール後 |
|---|---|---|
| フォーマット | F | U |
| レコード | F | A |
上記の意味は次に示すとおりです。
| F | Adabas コール前にユーザーが入力するフィールド |
| A | Adabas により入力されるフィールド |
| U | Adabas コール後も変化なし |
PC
このフィールドに値 "STPx"（x は任意の値）を設定します。
デフォルトでは、トリガファイルのデータベース ID とファイル番号を示します。
1 バイトのデータベース ID の場合は CB-DBID を設定します。2 バイトのデータベース ID の場合は、CB-RSP を設定し、CB-CALL-TYPE を X'30' に設定します。
フォーマットバッファと組み合わせて他のユーザーファイルのファイル番号を指定できます。 ファイル番号はフォーマットバッファと一致する必要があるため、レコードバッファ抽出（STPRBE）ルーチンを使用して、ファイル - フィールド定義に応じてフィールド値を解釈したり取得することができます。
読み込むファイルの番号を 2 進数で指定します。 物理ダイレクトコールの場合は、次のようファイル番号を指定します。
1 バイトファイル番号の場合は、ファイル番号を第 2 バイト（10）に入力します。第 1 バイト（9）は、バイナリの 0（B'0000 0000'）をセットします。
2 バイトファイル番号の場合は、2 バイト（9 と 10）を使います。
注意:
2 バイトファイル番号およびデータベース ID を使用する場合は、コントロールブロックの先頭バイトに X'30'
を入力しなければなりません。
Adabas はこのフィールドに、コマンドのレスポンスコードを返します。 レスポンスコード 0 は、このコマンドが正しく実行されたことを示します。 ゼロ以外のレスポンスコードは、アディション 2 フィールドの下位 2 バイトにサブコードを伴う場合があります。詳細は『Adabas メッセージおよびコードマニュアル』を参照してください。
フォーマットバッファ長（バイト単位）。 ユーザープログラムに定義した実際のフォーマットバッファエリアは、この指定長と同じか、それ以上でなければなりません。
レコードバッファ長（バイト単位）。 ユーザープログラムに定義した実際のレコードバッファエリアは、この指定長と同じか、それ以上でなければなりません。
ストアドプロシージャ名。
PC コマンドは、このフィールドのバイト 1 および 2 で実行されたプロシージャからのレスポンスを返します。
このフィールドは、ストアドプロシージャのリクエストが発行されるときに使用されるオプションを示します。
| バイト 1 は Type です。 | A = 非同期、P = 関与、N = 非関与 |
| バイト 2 は Parm です。 | N = なし、C = コントロール、E = エラー／レスポンス、X = ACBX 付きのコントロール |
| バイト 3 は RecB です。 | N = なし、A = アクセス、U = 更新 |
PC コマンドは、このフィールドのバイト 1 および 2 で実行されたプロシージャからのレスポンスを返します。 バイト 3 およびバイト 4 は、ストアドプロシージャを示すため X'0011'（17）に設定されます。
| フィールド | 位置 | フォーマット | Adabas コール前 | Adabas コール後 |
|---|---|---|---|---|
| 1～2 | バイナリ | --- | --- | |
| バージョンインジケータ | 3～4 | バイナリ | F | |
| 5～6 | バイナリ | --- | --- | |
| コマンドコード | 7～8 | 英数字 | F | U |
| 9～10 | バイナリ | --- | --- | |
| レスポンスコード | 11～12 | バイナリ | --- | A |
| コマンド ID | 13～16 | 英数字／バイナリ | F | U |
| データベース ID | 17～20 | 数値 | F | U |
| ファイル番号 | 21～24 | 数値 | F | U |
| 25-56 | --- | --- | --- | |
| アディション 1 | 57～64 | 英数字 | F | U |
| アディション 2 | 65～68 | バイナリ | --- | A |
| アディション 3 | 69～76 | 英数字 | F | A |
| アディション 4 | 77～84 | 英数字 | --- | A |
| 85～114 | --- | --- | --- | |
| エラーサブコード | 115～116 | バイナリ | --- | A |
| 117～144 | --- | --- | --- | |
| コマンドタイム | 145～152 | バイナリ | --- | A |
| ユーザーエリア | 153～168 | 該当なし | --- | U |
| 169～193 | --- | --- | --- |
| バッファ | Adabas コール前 | Adabas コール後 |
|---|---|---|
| フォーマット | F | U |
| レコード | F | A |
上記の意味は次に示すとおりです。
| F | Adabas コール前にユーザーが入力するフィールド |
| A | Adabas により入力されるフィールド |
| U | Adabas コール後も変化なし |
F2
A1
Adabas はこのフィールドに、コマンドのレスポンスコードを返します。 レスポンスコード 0 は、このコマンドが正しく実行されたことを示します。 ゼロ以外のレスポンスコードは、エラーサブコード（ACBXERRC）フィールドにサブコードを伴う場合があります。詳細は、Adabas メッセージおよびコード のドキュメントを参照してください。
このフィールドに値
"STPx"（x
は任意の値）を設定します。
コールに使用するデータベース ID を指定します。
このフィールドがバイナリの 0 に設定されている場合、Adabas API は、DDCARD 入力データの ADARUN カードのデータベース ID を使用するか、または、リンクルーチンにリンクされている LNKGBLS モジュールかリンクルーチンによりロードされた LNKGBLS モジュールのデフォルトのデータベース ID 値を使用します。
デフォルトでは、トリガファイルのファイル番号を示します。
フォーマットバッファと組み合わせて他のユーザーファイルのファイル番号を指定できます。 ファイル番号はフォーマットバッファと一致する必要があるため、レコードバッファ抽出（STPRBE）ルーチンを使用して、ファイル - フィールド定義に応じてフィールド値を解釈したり取得することができます。
読み込むファイルの番号を 2 進数で指定します。 物理ダイレクトコールの場合は、次のようファイル番号を指定します。
1 バイトファイル番号の場合は、ファイル番号を第 2 バイト（10）に入力します。第 1 バイト（9）は、バイナリの 0（B'0000 0000'）をセットします。
2 バイトファイル番号の場合は、2 バイト（9 と 10）を使います。
ストアドプロシージャ名。
コマンドが正常に処理されると、次の情報がこのフィールドに返されます。
少なくとも 1 つの有効なフィールド値がレコードバッファにある場合、先頭 2 バイトには、アクセスしたレコードの圧縮レコード長がバイナリ形式で格納されます。
後ろ 2 バイトには、フォーマットバッファで選択し、アクセスしたフィールドの非圧縮長がバイナリ形式で格納されます。
注意:
プリフェッチ機能の使用時、この長さ情報は返されません。
このフィールドは、ストアドプロシージャのリクエストが発行されるときに使用されるオプションを示します。
| バイト 1 は Type です。 | A = 非同期、P = 関与、N = 非関与 |
| バイト 2 は Parm です。 | N = なし、C = コントロール、E = エラー／レスポンス、X = ACBX 付きのコントロール |
| バイト 3 は RecB です。 | N = なし、A = アクセス、U = 更新 |
PC コマンドは、このフィールドのバイト 1 および 2 で実行されたプロシージャからのレスポンスを返します。 バイト 3 およびバイト 4 は、ストアドプロシージャを示すため X'0011'（17）に設定されます。
コマンドがゼロ以外のレスポンスコードを返したときは、このフィールドにレスポンスコードの正確な意味を定義したサブコードが含まれます。 レスポンスコードとサブコードについては、『Adabas メッセージおよびコード』を参照してください。
PC コマンドに次のバッファが適用されます。
ユーザーはこのバッファの読み込むフィールドを指定します。 フォーマットバッファの構文形式、および例については、『Adabas コマンドリファレンスマニュアル』を参照してください。
フォーマットバッファは、レコードバッファで渡されるパラメータの定義を格納するときに、任意で使用できます。 構文は通常のコマンドのフォーマットバッファの構文と整合性がある必要があります。または、使用しない場合は "." に設定します。
フォーマットバッファで使用されるフィールド名は、通常はわかりやすい名前にして、ストアドプロシージャが各パラメータの値をレコードバッファ抽出（STPRBE）ルーチンから取得できるようにしてください（「レコードバッファ抽出ルーチン（STPRBE）」を参照）。 ストアドプロシージャルーチンが長さを提供しない場合は、長さを使用する必要があります。 または、フィールド名が ACB で指定される実際のファイル番号と対応する場合、STPRBE ルーチンでフィールドやパラメータの長さを判断できます。
異なるプラットフォーム間でストアドプロシージャを発行するときは、各パラメータのフィールドタイプも指定することが重要です。つまり英数字の場合は "A"、バイナリの場合は "B"、アンパック形式の場合は "U" などです。
詳細については、「フォーマットバッファ」を参照してください。
Adabas は、バッファに要求されたフィールドの値をこのバッファに返します。 すべての値は、ユーザーがフォーマットバッファに長さやフォーマットを変更して指定していなければ、標準フォーマットと標準長で返されます。
レコードバッファは、呼び出し元からストアドプロシージャ、またはストアドプロシージャから呼び出し元にパラメータを渡すために使用できます。 レコードバッファのレイアウトまたは DSECT は、コール元と実際のストアドプロシージャルーチンの間で調整される必要があります。
レコードバッファは、レコードバッファ抽出（STPRBE）ルーチンを使用することで、関与および非関与（同期）タイプの要求のみで利用できます。 「レコードバッファ抽出ルーチン（STPRBE）」を参照してください。
レコードバッファをアクセスや更新で使用するかどうかは、アディション 4 フィールドを使用して呼び出し元が指定します。
詳細については、「フォーマットバッファとレコードバッファの使用」を参照してください。
このセクションでは、次の表で示すサンプルのプログラムとデータエリアについて説明します。 ソースコードはインストール中に提供され、SYSSPT ライブラリに配置されます。
| 名前 | 説明 |
|---|---|
| STPLNK01 | このストアドプロシージャのリンクルーチンは、パラメータを固定長および固定番号として渡します。 |
| STPLNK02 | このストアドプロシージャのリンクルーチンでは、最大で 5 つのパラメータをプロシージャに渡す可能性があります。各パラメータの長さは、パラメータの最初の 2 バイトに格納されます。 |
| STPLNK03 | STPLNK02 と同様に、最大で 5 つのパラメータをプロシージャに渡す可能性があります。ただし、各パラメータの長さは、先行する別のパラメータに格納されます。 |
0010 ************************************************************************
0020 * Application: Adabas Stored Procedures
0030 * Subprogram : STORPROC/STPLNK01
0040 * Author : Adabas Development
0050 *
0060 * Function : Sample Routine 01 to invoke a stored procedure
0070 * This example expects fixed parameter definitions
0080 * Remarks : This routine will set up the buffers and issue the call
0090 * to invoke a stored procedure routine directly.
0100 * Once processing is completed, control is returned to
0110 * the caller.
0120 * Parameter RESP must be set to zero if processing is
0130 * successful.
0140 *
0150 * Parameters : The following fields in the ACB must be set up to invoke
0160 * the stored procedure request.
0170 *
0180 * Command Code: 'PC'
0190 * Command ID : 'STPx' - where x is any value
0200 * Database ID : Database of the respective trigger file
0210 * Set CB-DBID for a one byte DBID
0220 * Set CB-RSP for a two byte DBID with
0230 * CB-CALL-TYPE set to H'30'
0240 * File Number : Set to the trigger file number of the
0250 * target database (normal one-byte versus
0260 * two-byte FNRs is applicable) by default
0270 * or any other file used in conjunction with
0280 * the format buffer.
0290 * FB Length : Length of the format buffer
0300 * RB Length : Length of the record buffer
0310 * Additions 1 : Name of the stored procedure
0320 * Additions 3 :
0330 * Byte 1 : Type ("A"sync, "P"art, "N"on-Partic)
0340 * Byte 2 : Parm ("N"one, "C"ntl, "E"rror/Resp)
0350 * Byte 3 : RecB ("N"one, "A"ccess, "U"pdate)
0360 *
0370 *
0380 * Format Buff: The format buffer is an optional buffer that may be used
0390 * to convey the definition of the parameters being passed
0400 * in the record buffer. The syntax must be consistent with
0410 * that of a format buffer for a normal command, or be set
0420 * to "." if it not to be used.
0430 *
0440 * The field names used in the format buffer should
0450 * normally be meaningful so that the stored procedure can
0460 * get the values of each parameter from the record buffer
0470 * extraction (STPRBE) routine. Length must be used if the
0480 * stored procedure routine does not provide one.
0490 * Alternatively, if the field names correspond to the
0500 * actual file number specified in the ACB, then the STPRBE
0510 * routine will be able to determine the length of the
0520 * field/parameter.
0530 *
0540 * When issuing stored procedures across platforms, it is
0550 * essential to also specify the field type of each
0560 * parameter; i.e., "A" - alphanumeric, "B" - binary, "U"
0570 * - unpacked etc.
0580 *
0590 *
0600 * Record Buff: The record buffer is available for passing any
0610 * parameters from the caller to the stored procedure
0620 * and(or) from the stored procedure to the caller.
0630 * The layout/DSECT of the record buffer must be
0640 * coordinated between the caller and the actual stored
0650 * procedure routine itself.
0660 *
0670 * The record buffer is available for participating
0680 * and non-participating (sync) type requests via the
0690 * the record buffer extraction (STPRBE) routine, only.
0700 *
0710 * Determination of the record buffer being for access or
0720 * update is specified by the caller via the additions 3
0730 * field (see above).
0740 *
0750 ************************************************************************
0760 DEFINE DATA PARAMETER
0770 01 REQ-TYPE (A1) /* Optional request ID type
0780 01 P-PROC (A8) /* Procedure name
0790 01 P-PARM1 (A100) /* Single parameter
0800 01 P-MSG (A72) /* Message corresponding to the RESP
0810 01 RESP (N4) /* Response code of proc. request
0820 LOCAL USING STPLCB
0830 LOCAL
0840 01 FB (A16) INIT<'AA,100,A.'>
0850 01 ET-CNT (P3)
0860 END-DEFINE
0870 FORMAT PS=0
0880 *
0890 RESET CB /* Clear the ACB
0900 MOVE 'STP' TO CB-CID /* Command ID
0910 MOVE 'PC' TO CB-CMD /* Command code
0920 MOVE 222 TO CB-DBID /* Database ID
0930 MOVE 12 TO CB-FNR /* Default to TRG file number
0940 MOVE 9 TO CB-FBL /* FB length
0950 MOVE 100 TO CB-RBL /* RB length
0960 IF P-PROC = ' ' /* Did we get a procedure name?
0970 DO
0980 MOVE 1 TO RESP
0990 MOVE 'Invalid Procedure Name specified' TO P-MSG
1000 ESCAPE ROUTINE
1010 DOEND
1020 MOVE P-PROC TO CB-ADD1 /* Stored procedure name
1030 MOVE 'NCA ' TO CB-ADD3 /* Options: N - Sync (non-partic)
1040 * /* C - Control parms
1050 * /* A - RecBuff for access
1060 *
1070 CALL 'CMADA' USING CB FB P-PARM1 /* Invoke the stored procedure
1080 *
1090 MOVE CB-RSP TO RESP
1100 MOVE 'Check Response code returned for this request' TO P-MSG
1110 * PRINT (CD=YE) 'Resp ..' (YEI) CB-RSP(EM=HH) 'Add2' CB-ADD2(EM=H(8))
1120 * 'Add4' CB-ADD4(EM=H(8))
1130 *
1140 END
0010 ************************************************************************
0020 * Application: Adabas Stored Procedures
0030 * Subprogram : STORPROC/STPLNK02
0040 * Author : Adabas Development
0050 *
0060 * Function : Sample routine 02 to invoke a stored procedure
0070 * This example expects up to 5 different variable-length
0080 * parameters. The length of each parameter is specified
0090 * as the first two bytes of each parameter. Length is
0100 * inclusive of the two-byte length itself.
0110 * Remarks : This routine will set up the buffers and issue the call
0120 * to invoke a stored procedure routine directly.
0130 * Once processing is completed, control is returned to
0140 * the caller.
0150 * Parameter RESP must be set to zero if processing is
0160 * successful.
0170 *
0180 * Parameters : The following fields in the ACB must be set up to invoke
0190 * the stored procedure request.
0200 *
0210 * Command Code: 'PC'
0220 * Command ID : 'STPx' - where x is any value
0230 * Database ID : Database of the respective trigger file
0240 * Set CB-DBID for a one-byte DBID
0250 * Set CB-RSP for a two-byte DBID with
0260 * CB-CALL-TYPE set to H'30'
0270 * File Number : Set to the trigger file number of the
0280 * target database (normal one-byte versus
0290 * two-byte FNRs is applicable) by default
0300 * or any other file used in conjunction with
0310 * the format buffer.
0320 * FB Length : Length of the format buffer
0330 * RB Length : Length of the record buffer
0340 * Additions 1 : Name of the stored procedure
0350 * Additions 3 :
0360 * Byte 1 : Type ("A"sync, "P"art, "N"on-Partic)
0370 * Byte 2 : Parm ("N"one, "C"ntl, "E"rror/Resp)
0380 * Byte 3 : RecB ("N"one, "A"ccess, "U"pdate)
0390 *
0400 *
0410 * Format Buff: The format buffer is an optional buffer that may be used
0420 * to convey the definition of the parameters be ingpassed
0430 * in the record buffer. The syntax must be consistent with
0440 * that of a format buffer for a normal command, or be set
0450 * to "." if it not to be used.
0460 *
0470 * The field names used in the format buffer should
0480 * normally be meaningful so that the stored procedure can
0490 * get the values of each parameter via the record buffer
0500 * extraction (STPRBE) routine. Length must be used if the
0510 * stored procedure routine does not provide one.
0520 * Alternatively, if the field names correspond to the
0530 * actual file number specified in the ACB, then the STPRBE
0540 * routine will be able to determine the length of the
0550 * field/parameter.
0560 *
0570 * When issuing stored procedures across platforms, it is
0580 * essential to also specify the field type of each
0590 * parameter; i.e., "A" - alphanumeric, "B" - binary, "U"
0600 * - unpacked etc.
0610 *
0620 *
0630 * Record Buff: The record buffer is available for passing any
0640 * parameters from the caller to the stored procedure
0650 * and(or) from the stored procedure to the caller.
0660 * The layout/DSECT of the record buffer must be
0670 * coordinated between the caller and the actual stored
0680 * procedure routine itself.
0690 *
0700 * The record buffer is available for participating
0710 * and non-participating (sync) type requests via the
0720 * the record buffer extraction (STPRBE) routine, only.
0730 *
0740 * Determination of the record buffer being for access or
0750 * update is specified by the caller via the additions 3
0760 * field (see above).
0770 *
0780 ************************************************************************
0790 DEFINE DATA PARAMETER
0800 01 REQ-TYPE (A1)
0810 01 P-PROC (A8) /* Procedure name
0820 01 P-OPTIONS (A8)
0830 01 REDEFINE P-OPTIONS
0840 02 P-TYPE (A1) /* Async versus sync procedure
0850 02 P-PARMS (A1) /* Parm type for procedure
0860 02 P-RECB (A1) /* Rec buffer access
0870 01 P-PARM1(A1/1:V) /* Variable-length parameter
0880 * first 2 bytes set to incl. length
0890 01 P-PARM2(A1/1:V) /* Variable-length parameter 2
0900 01 P-PARM3(A1/1:V) /* Variable-length parameter 3
0910 01 P-PARM4(A1/1:V) /* Variable-length parameter 4
0920 01 P-PARM5(A1/1:V) /* Variable-length parameter 5
0930 01 P-MSG (A72) /* Message corresponging to the RESP
0940 01 RESP (N4) /* Response code of proc request
0950 LOCAL USING STPLCB
0960 LOCAL
0970 01 SUB (I2)
0980 01 SUB1 (I2)
0990 01 SUB2 (I2)
1000 01 SUB3 (I2)
1010 01 SUB4 (I2)
1020 01 FB (A48)
1030 01 REDEFINE FB
1040 02 FB-FIELD (8)
1050 03 FB-FLD (A3)
1060 03 FB-LEN (N3)
1070 01 RB (A1/1000) /* Max length for all parms
1080 01 W-ADD3 (A8)
1090 01 REDEFINE W-ADD3
1100 02 W-TYPE (A1)
1110 02 W-PARMS (A1)
1120 02 W-RECB (A1)
1130 01 #LENGTH (B2)
1140 01 REDEFINE #LENGTH
1150 02 #LENG (A1/2)
1160 01 W-LENG (P5/5)
1170 END-DEFINE
1180 FORMAT PS=0
1190 *
1200 * In this example, we will say that each parameter has an individual
1210 * maximum length of 200; however, the limit may be established as a
1220 * total of all parameters. Since our max. record buffer is 1000 then the
1230 * maximum of all parameters cannot exceed 1000. This may be changed as
1240 * required by the user.
1250 *
1260 FOR SUB1 1 5 /* Get all the parameter lengths
1270 DECIDE ON FIRST VALUE OF SUB1
1280 VALUE 1 MOVE P-PARM1(1:2) TO #LENG(1:2) /* Get Parm1 length
1290 IF #LENGTH < 3 /* Min length with inclusive length
1300 DO
1310 MOVE 16 TO RESP
1320 MOVE 'Invalid Length for Parameter 1. Must be 3-200'
1330 TO P-MSG
1340 ESCAPE ROUTINE
1350 DOEND
1360 VALUE 2 MOVE P-PARM2(1:2) TO #LENG(1:2) /* Get Parm2 length
1370 VALUE 3 MOVE P-PARM3(1:2) TO #LENG(1:2) /* Get Parm3 length
1380 VALUE 4 MOVE P-PARM5(1:2) TO #LENG(1:2) /* Get Parm4 length
1390 VALUE 5 MOVE P-PARM1(1:2) TO #LENG(1:2) /* Get Parm5 length
1400 ANY IF #LENGTH = H'4040' /* Is length Blanks?
1410 RESET #LENGTH /* yes, then treat as dummy parm
1420 MOVE #LENGTH TO W-LENG(SUB1)
1430 IF W-LENG(SUB1) > 202 /* For our example, we limit the length
1440 DO
1450 MOVE 4 TO RESP
1460 MOVE SUB1 TO FB-LEN(SUB1)
1470 COMPRESS 'Invalid Length for Parameter' FB-LEN(SUB1)
1480 '. Max is 200.' INTO P-MSG
1490 ESCAPE ROUTINE /* Terminate processing with error
1500 DOEND
1510 SUBTRACT 2 FROM W-LENG(SUB1) /* ACTUAL parm length
1520 NONE IGNORE
1530 END-DECIDE
1540 CLOSE LOOP (1260)
1550 *
1560 IF P-PROC = ' ' /* Did we get a procedure name?
1570 DO
1580 MOVE 1 TO RESP
1590 MOVE 'Invalid Procedure Name specified' TO P-MSG
1600 ESCAPE ROUTINE
1610 DOEND
1620 IF NOT (P-TYPE = 'A' OR= 'N' OR= 'P' OR= ' ')
1630 DO /* Async, participating, non-partic.
1640 MOVE 2 TO RESP
1650 MOVE 'Proc Type must be A, N, P or " "' TO P-MSG
1660 ESCAPE ROUTINE
1670 DOEND
1680 IF NOT (P-PARMS = 'C' OR= 'E' OR= 'N' OR= ' ')
1690 DO /* Cntrl, Error/Resp, None
1700 MOVE 3 TO RESP
1710 MOVE 'Parameter Type must be C, E, N or " "' TO P-MSG
1720 ESCAPE ROUTINE
1730 DOEND
1740 IF NOT (P-RECB = 'A' OR= 'N' OR= 'U' OR= ' ')
1750 DO /* Access, None, Update
1760 MOVE 3 TO RESP
1770 MOVE 'Parameter access must be Access, None or Update' TO P-MSG
1780 ESCAPE ROUTINE
1790 DOEND
1800 *
1810 * Next we merge all the passed parameters into a single contiguous
1820 * buffer which will be used as the record buffer for the call. The
1830 * format buffer will also be set up to indicate the 'structure' of the
1840 * record buffer for use by the invoked procedure.
1850 *
1860 MOVE 1 TO SUB
1870 *
1880 FOR SUB3 1 5 /* Step through all parameters
1890 IF W-LENG(SUB3) < 3 /* Check min. length of a parameter
1900 DO
1910 MOVE '.' TO FB-FLD(SUB3)
1920 ESCAPE BOTTOM /* None, so assume we have all parms
1930 DOEND
1940 MOVE W-LENG(SUB3) TO SUB1
1950 ADD SUB1 TO SUB2
1960 DECIDE ON FIRST VALUE OF SUB1 /* Move parms into the RB
1970 VALUE 1 MOVE 'P1,' TO FB-FLD(1)
1980 MOVE P-PARM1 (3:SUB1) TO RB(SUB:SUB2)
1990 VALUE 2 MOVE 'P2,' TO FB-FLD(2)
2000 MOVE P-PARM2 (3:SUB1) TO RB(SUB:SUB2)
2010 VALUE 3 MOVE 'P3,' TO FB-FLD(3)
2020 MOVE P-PARM3 (3:SUB1) TO RB(SUB:SUB2)
2030 VALUE 4 MOVE 'P4,' TO FB-FLD(4)
2040 MOVE P-PARM4 (3:SUB1) TO RB(SUB:SUB2)
2050 VALUE 5 MOVE 'P5,' TO FB-FLD(5)
2060 MOVE P-PARM5 (3:SUB1) TO RB(SUB:SUB2)
2070 ANY ADD SUB1 TO SUB
2080 MOVE SUB1 TO FB-LEN(SUB3)
2090 NONE IGNORE
2100 END-DECIDE
2110 *
2120 CLOSE LOOP (1880)
2130 *
2140 * Now we start setting up the CB and do some additional validation.
2150 * When moving in the procedure options, we allow for defaults.
2160 *
2170 RESET CB /* Clear the ACB
2180 MOVE 'STP' TO CB-CID /* Command ID
2190 MOVE 'PC' TO CB-CMD /* Command code
2200 MOVE 77 TO CB-DBID /* Database ID
2210 MOVE 22 TO CB-FNR /* File number
2220 MOVE 48 TO CB-FBL /* FB length
2230 MOVE 1000 TO CB-RBL /* RB length
2240 MOVE P-PROC TO CB-ADD1 /* Stored procedure name
2250 *
2260 MOVE 'A' TO W-TYPE /* Set the default options
2270 MOVE 'C' TO W-PARMS
2280 MOVE 'N' TO W-RECB
2290 IF NOT (P-TYPE = ' ') /* Should we default to Async?
2300 MOVE P-TYPE TO W-TYPE
2310 IF NOT (P-PARMS = ' ') /* Should we default to Contrl?
2320 MOVE P-PARMS TO W-PARMS
2330 IF NOT (P-RECB = ' ') /* Should we default to None?
2340 MOVE P-RECB TO W-RECB
2350 MOVE W-ADD3 TO CB-ADD3 /* Options for request
2360 *
2370 CALL 'CMADA' USING CB FB RB(1) /* Invoke the stored procedure
2380 *
2390 IF CB-RSP NE 0
2400 DO
2410 PRINT (CD=YE) 'Resp ..' (YEI) CB-RSP(EM=HH) 'Add2' CB-ADD2(EM=H(4))
2420 'Add3' CB-ADD3(EM=H(8)) 'Add4' CB-ADD4(EM=H(8))
2430 ESCAPE ROUTINE
2440 DOEND
2450 *
2460 * Now we need to restore the parameters back into the user's area,
2470 * in case the data was modified. This can happen only if the record
2480 * buffer was modifiable; i.e., P-RECB was set to 'U'.
2490 *
2500 IF CB-RSP = 0 /* Was everything okay
2510 AND P-RECB = 'U' /* Update: Parms may have been updated
2520 DO
2530 MOVE 1 TO SUB
2540 RESET SUB2
2550 FOR SUB1 1 5
2560 ADD W-LENG(SUB1) TO SUB2
2570 MOVE W-LENG(SUB1) TO SUB3
2580 DECIDE ON FIRST VALUE OF SUB1 /* Restore parm from RB
2590 VALUE 1 ASSIGN P-PARM1 (3:SUB3) = RB(SUB:SUB2)
2600 VALUE 2 ASSIGN P-PARM2 (3:SUB3) = RB(SUB:SUB2)
2610 VALUE 3 ASSIGN P-PARM3 (3:SUB3) = RB(SUB:SUB2)
2620 VALUE 4 ASSIGN P-PARM4 (3:SUB3) = RB(SUB:SUB2)
2630 VALUE 5 ASSIGN P-PARM5 (3:SUB3) = RB(SUB:SUB2)
2640 ANY ADD W-LENG(SUB1) TO SUB /* Get next position
2650 NONE IGNORE
2660 END-DECIDE
2670 CLOSE LOOP(2550)
2680 DOEND
2690 *
2700 END
0010 ************************************************************************
0020 * Application: Adabas Stored Procedures
0030 * Subprogram : STORPROC/STPLNK03
0040 * Author : Adabas Development
0050 *
0060 * Function : Sample routine 03 to invoke a stored procedure
0070 * This example expects up to five different variable-length
0080 * parameters. Parameter lengths are passed as extra
0090 * parameters.
0100 * Remarks : This routine will set up the buffers and issue the call
0110 * to invoke a stored procedure routine directly.
0120 * Once processing is completed, control is returned to
0130 * the caller.
0140 * Parameter RESP must be set to zero if processing is
0150 * successful.
0160 *
0170 * Parameters : The following fields in the ACB must be set up to invoke
0180 * the stored procedure request.
0190 *
0200 * Command Code: 'PC'
0210 * Command ID : 'STPx' - where x is any value
0220 * Database ID : Database of the respective trigger file
0230 * Set CB-DBID for a one-byte DBID
0240 * Set CB-RSP for a two-byte DBID with
0250 * CB-CALL-TYPE set to H'30'
0260 * File Number : Set to the trigger file number of the
0270 * target database (normal one-byte versus
0280 * two-byte FNRs is applicable) by default
0290 * or any other file used in conjunction with
0300 * the format buffer.
0310 * FB Length : Length of the format buffer
0320 * RB Length : Length of the record buffer
0330 * Additions 1 : Name of the stored procedure
0340 * Additions 3 :
0350 * Byte 1 : Type ("A"sync, "P"art, "N"on-Partic)
0360 * Byte 2 : Parm ("N"one, "C"ntl, "E"rror/Resp)
0370 * Byte 3 : RecB ("N"one, "A"ccess, "U"pdate)
0380 *
0390 *
0400 * Format Buff: The format buffer is an optional buffer that may be used
0410 * to convey the definition of the parameters being passed
0420 * in the record buffer. The syntax must be consistent with
0430 * that of a format buffer for a normal command, or be set
0440 * to "." if it not to be used.
0450 *
0460 * The field names used in the format buffer should
0470 * normally be meaningful so that the stored procedure can
0480 * otain the values of each parameter via the record buffer
0490 * extraction (STPRBE) routine. Length must be used if the
0500 * stored procedure routine does not provide one.
0510 * Alternatively, if the field names correspond to the
0520 * actual file number specified in the ACB, then the STPRBE
0530 * routine will be able to determine the length of the
0540 * field/parameter.
0550 *
0560 * When issuing stored procedures across platforms, it is
0570 * essential to also specify the field type of each
0580 * parameter; i.e., "A" - alphanumeric, "B" - binary, "U"
0590 * - unpacked etc.
0600 *
0610 *
0620 * Record Buff: The record buffer is available for passing any
0630 * parameters from the caller to the stored procedure
0640 * and(or) from the stored procedure to the caller.
0650 * The layout/DSECT of the record buffer must be
0660 * coordinated between the caller and the actual stored
0670 * procedure routine itself.
0680 *
0690 * The record buffer will be available for participating
0700 * and non-participating (sync) type requests via the
0710 * the record buffer extraction (STPRBE) routine, only.
0720 *
0730 * Determination of the record buffer being for access or
0740 * update is specified by the caller via the additions 3
0750 * field (see above).
0760 *
0770 ************************************************************************
0780 DEFINE DATA PARAMETER
0790 01 REQ-TYPE (A1)
0800 01 P-PROC (A8) /* Procedure name
0810 01 P-OPTIONS (A8)
0820 01 REDEFINE P-OPTIONS
0830 02 P-TYPE (A1) /* Async versus sync procedure
0840 02 P-PARMS (A1) /* Parm type for procedure
0850 02 P-RECB (A1) /* Rec buffer access
0860 01 P-LEN1 (P3) /* Length of Parm1
0870 01 P-PARM1(A1/1:V) /* Variable-length parameter 1
0880 01 P-LEN2 (P3) /* Length of Parm2
0890 01 P-PARM2(A1/1:V) /* Variable-length parameter 2
0900 01 P-LEN3 (P3) /* Length of Parm3
0910 01 P-PARM3(A1/1:V) /* Variable-length parameter 3
0920 01 P-LEN4 (P3) /* Length of Parm4
0930 01 P-PARM4(A1/1:V) /* Variable-length parameter 4
0940 01 P-LEN5 (P3) /* Length of Parm5
0950 01 P-PARM5(A1/1:V) /* Variable-length parameter 5
0960 01 P-MSG (A72) /* Message corresponging to the RESP
0970 01 RESP (N4) /* Response code of proc request
0980 LOCAL USING STPLCB
0990 LOCAL
1000 01 SUB (I2)
1010 01 SUB1 (I2)
1020 01 SUB2 (I2)
1030 01 SUB3 (I2)
1040 01 FB (A64)
1050 01 REDEFINE FB
1060 02 FB-FIELD (8)
1070 03 FB-FLD (A3)
1080 03 FB-LEN (N3)
1090 03 FB-COMM(A1)
1100 01 RB (A1/1000) /* Max length for all parms
1110 01 W-ADD3 (A8)
1120 01 REDEFINE W-ADD3
1130 02 W-TYPE (A1)
1140 02 W-PARMS (A1)
1150 02 W-RECB (A1)
1160 01 #LENGTH (B2)
1170 01 REDEFINE #LENGTH
1180 02 #LENG (A1/2)
1190 01 W-LENG (P3/5)
1200 END-DEFINE
1210 FORMAT PS=0
1220 *
1230 MOVE P-LEN1 TO W-LENG(1)
1240 MOVE P-LEN2 TO W-LENG(2)
1250 MOVE P-LEN3 TO W-LENG(3)
1260 MOVE P-LEN4 TO W-LENG(4)
1270 MOVE P-LEN5 TO W-LENG(5)
1280 *
1290 * In this example, we will say that each parameter has an individual
1300 * maximum length of 200; however, the limit may be established as a
1310 * total of all parameters. Since our max. record buffer is 1000, the
1320 * maximum of all parameters cannot exceed 1000. This may be changed as
1330 * required by the user.
1340 *
1350 FOR SUB1 1 5 /* Validate all parameter lengths
1360 IF W-LENG(SUB1) > 16448 /* Does length contain X'4040'
1370 RESET W-LENG(SUB1) /* yes, then must be dummy parm
1380 IF W-LENG(SUB1) > 200 /* For our example we limit the length
1390 DO
1400 MOVE 15 TO RESP
1410 MOVE SUB1 TO FB-LEN(SUB1)
1420 COMPRESS 'Invalid Length for Parameter' FB-LEN(SUB1)
1430 '. Max is 200.' INTO P-MSG
1440 ESCAPE ROUTINE /* Terminate processing with error
1450 DOEND
1460 CLOSE LOOP
1470 *
1480 * Now we validate the parameters, as required. Of course, these may
1490 * be changed as per the user's requirement and may vary from one stored
1500 * procedure link routine to another.
1510 *
1520 IF P-PROC = ' ' /* Did we get a procedure name?
1530 DO
1540 MOVE 1 TO RESP
1550 MOVE 'Invalid Procedure Name specified' TO P-MSG
1560 ESCAPE ROUTINE
1570 DOEND
1580 IF NOT (P-TYPE = 'A' OR= 'N' OR= 'P' OR= ' ')
1590 DO /* Async, Participating, Non-Partic
1600 MOVE 2 TO RESP
1610 MOVE 'Proc Type must be A, N, P or " "' TO P-MSG
1620 ESCAPE ROUTINE
1630 DOEND
1640 IF NOT (P-PARMS = 'C' OR= 'E' OR= 'N' OR= ' ')
1650 DO /* Cntrl, Error/Resp, None
1660 MOVE 3 TO RESP
1670 MOVE 'Parameter Type must be C, E, N or " "' TO P-MSG
1680 ESCAPE ROUTINE
1690 DOEND
1700 IF NOT (P-RECB = 'A' OR= 'N' OR= 'U' OR= ' ')
1710 DO /* Access, None, Update
1720 MOVE 3 TO RESP
1730 MOVE 'Parameter access must be Access, None or Update' TO P-MSG
1740 ESCAPE ROUTINE
1750 DOEND
1760 IF P-LEN1 < 3 /* Min. length with inclusive length
1770 DO /* Anything less indicates no parm
1780 MOVE 4 TO RESP
1790 MOVE 'First Parameter MUST be valid. Length must be
3-200' TO P-MSG
1800 ESCAPE ROUTINE
1810 DOEND
1820 *
1830 * Next we merge all the passed parameters into a single contiguous
1840 * buffer which will be used as the record buffer for the call. The
1850 * format buffer will also be set up to indicate the 'structure' of the
1860 * record buffer for use by the invoked procedure.
1870 *
1880 MOVE 1 TO SUB
1890 RESET SUB2
1900 *
1910 FOR SUB1 1 5 /* Step through all parameters
1920 IF W-LENG(SUB1) < 3 /* Check min. length of a parameter
1930 DO
1940 MOVE '.' TO FB-FLD(SUB1)
1950 ESCAPE BOTTOM /* None, so assume we have all parms
1960 DOEND
1970 ADD W-LENG(SUB1) TO SUB2 /* Get end position
1980 MOVE W-LENG(SUB1) TO SUB3 /* Set index for MOVE statement
1990 DECIDE ON FIRST VALUE OF SUB1 /* Move next parm into the RB
2000 VALUE 1 MOVE P-PARM1 (1:SUB3) TO RB(SUB:SUB2)
2010 MOVE 'P1,' TO FB-FLD(1)
2020 VALUE 2 MOVE P-PARM2 (1:SUB3) TO RB(SUB:SUB2)
2030 MOVE ',' TO FB-COMM(SUB1 - 1)
2040 MOVE 'P2,' TO FB-FLD(2)
2050 VALUE 3 MOVE P-PARM3 (1:SUB3) TO RB(SUB:SUB2)
2060 MOVE ',' TO FB-COMM(SUB1 - 1)
2070 MOVE 'P3,' TO FB-FLD(3)
2080 VALUE 4 MOVE P-PARM4 (1:SUB3) TO RB(SUB:SUB2)
2090 MOVE ',' TO FB-COMM(SUB1 - 1)
2100 MOVE 'P4,' TO FB-FLD(4)
2110 VALUE 5 MOVE P-PARM5 (1:SUB3) TO RB(SUB:SUB2)
2120 MOVE ',' TO FB-COMM(SUB1 - 1)
2130 MOVE 'P5,' TO FB-FLD(5)
2140 MOVE '.' TO FB-COMM(5)
2150 ANY ADD W-LENG(SUB1) TO SUB /* Get new position
2160 MOVE W-LENG(SUB1) TO FB-LEN(SUB1)
2170 NONE IGNORE
2180 END-DECIDE
2190 *
2200 CLOSE LOOP
2210 *
2220 * Now we set up the CB for the actual stored procedure call.
2230 *
2240 RESET CB /* Clear the ACB
2250 MOVE 'STP' TO CB-CID /* Command ID
2260 MOVE 'PC' TO CB-CMD /* Command Code
2270 MOVE 77 TO CB-DBID /* Database ID
2280 MOVE 22 TO CB-FNR /* File Number
2290 MOVE 64 TO CB-FBL /* FB Length
2300 MOVE 1000 TO CB-RBL /* RB length
2310 MOVE P-PROC TO CB-ADD1 /* Stored procedure name
2320 *
2330 * If any options were not passed, we use a pre-specified default.
2340 *
2350 MOVE 'A' TO W-TYPE /* Set the default options
2360 MOVE 'C' TO W-PARMS
2370 MOVE 'N' TO W-RECB
2380 IF NOT (P-TYPE = ' ') /* Should we default to Async?
2390 MOVE P-TYPE TO W-TYPE
2400 IF NOT (P-PARMS = ' ') /* Should we default to Contrl?
2410 MOVE P-PARMS TO W-PARMS
2420 IF NOT (P-RECB = ' ') /* Should we default to None?
2430 MOVE P-RECB TO W-RECB
2440 MOVE W-ADD3 TO CB-ADD3 /* Options for request 2450 *
2460 CALL 'CMADA' USING CB FB RB(1) /* Invoke the stored procedure
2470 *
2480 IF CB-RSP NE 0
2490 DO
2500 PRINT (CD=YE) 'Resp ..' (YEI) CB-RSP(EM=HH) 'Add2' CB-ADD2(EM=H(4))
2510 'Add3' CB-ADD3(EM=H(8)) 'Add4' CB-ADD4(EM=H(8))
2520 ESCAPE ROUTINE
2530 DOEND
2540 *
2550 * Now we need to restore the parameters back into the user's area,
2560 * in case the data was modified. This can happen only if the record
2570 * buffer was modifiable; i.e., P-RECB was set to 'U'.
2580 *
2590 IF CB-RSP = 0 /* Was everything okay
2600 AND P-RECB = 'U' /* Update: Parms may have been updated
2610 DO
2620 MOVE 1 TO SUB
2630 RESET SUB2
2640 FOR SUB1 1 5
2650 ADD W-LENG(SUB1) TO SUB2
2660 MOVE W-LENG(SUB1) TO SUB3
2670 DECIDE ON FIRST VALUE OF SUB1 /* Restore parm from RB
2680 VALUE 1 ASSIGN P-PARM1 (1:SUB3) = RB(SUB:SUB2)
2690 VALUE 2 ASSIGN P-PARM2 (1:SUB3) = RB(SUB:SUB2)
2700 VALUE 3 ASSIGN P-PARM3 (1:SUB3) = RB(SUB:SUB2)
2710 VALUE 4 ASSIGN P-PARM4 (1:SUB3) = RB(SUB:SUB2)
2720 VALUE 5 ASSIGN P-PARM5 (1:SUB3) = RB(SUB:SUB2)
2730 ANY ADD W-LENG(SUB1) TO SUB /* Get next position
2740 NONE IGNORE
2750 END-DECIDE
2760 CLOSE LOOP(2640)
2770 DOEND
2780 *
2790 END