自己学習メモインデックス
前提
使用する技術としてはRPG Ⅳを利用しますが、ここに掲載するプログラムソースは、フリーフォーマットではなく定位置記入方式を利用しています。
個人的にはネットで調べているとフリーフォーマットのサンプルの方が多く見かけますし、主流としてはフリーフォーマットのRPGが時代に合っているのだと思っています。（Javaなどのプログラミング言語と比較してもコーディングが近い表記なのでわかりやすいですし。）
ただ、業務で利用しているAS400のプログラムソースの資産は、全て定位置記入方式となっており、新機能の開発や既存機能の改修が入ったとしても、突然フリーフォーマットでコーディングされることが無さそうなので、業務に活かすための自己学習をしたいので、定位置記入方式を採用しています。
概要
24 x 80 サイズの画面を定義して、その画面の動作部分をRPGプログラミングによって制御していく画面開発を行っていきたいと思います。
RPG単体で自己学習を進めていこうかと思ったんですが、やっぱり画面で入力したものが少しでも動いてくれると嬉しいので、先に画面開発に着手しました。
ここでは得意先マスタ（MTOKISKP）をの照会画面を作っていきます。
機能としてはシンプルで、５桁の得意先コードを入力してEnterを押下すると、得意先名などの情報が照会できます。
画面イメージ
- 得意先コードを指定して一致した得意先情報を画面下部の詳細表示エリアに表示する。
- 得意先コードが見つからない場合はエラーメッセージを表示する。
- わざわざ表現する必要は無いかもですが、詳細表示エリアを表示している状態でF12キーを押下すると、詳細表示エリアが消えて、得意先コードを指定する条件指定のエリアのみが表示される。（もちろん罫線も消える）
DSPFの定義
DSPFのソース
A*%%TS SD 20200502 053221 YAMAGUCHI REL-V7R4M0 5770-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A PRINT(*LIBL/QPRINT)
A CF03(03 '終了')
A CF12(12 '戻る')
A R PANEL01
A*%%TS SD 20200419 095919 YAMAGUCHI REL-V7R4M0 5770-WDS
A OVERLAY
A 1 3'DSP01'
A 1 35'得意先照会'
A DSPATR(RI)
A COLOR(BLU)
A 1 70DATE(*JOB *YY)
A EDTCDE(Y)
A 3 2'照会する得意先コードを入力してく+
A ださい。'
A 5 2'得意先コード・・・・・'
A TOKCD R B 5 27REFFLD(MTOKISKR/TOKCD YAMAGUCHI1/MT-
A OKISKP)
A COLOR(WHT)
A R PANEL02
A*%%TS SD 20200502 053221 YAMAGUCHI REL-V7R4M0 5770-WDS
A OVERLAY
A PROTECT
A BLINK
A 8 3'得意先情報'
A 10 6'得意先名・・・・・・'
A 12 6'得意先名カナ・・・・'
A 14 6'電話番号・・・・・・'
A 16 6'信用限度額・・・・・'
A P2@TOKNM 40A O 10 29
A P2@TOKKANA 40A O 12 29
A P2@TOKTEL 15A O 14 29
A P2@TOKRMT 9Y 0O 16 29EDTCDE(J)
A R PANEL03
A*%%TS SD 20200418 025650 YAMAGUCHI REL-V7R4M0 5770-WDS
A 23 3'F3=終了'
A COLOR(BLU)
A R M1
A M1MSGID 7A O 24 2
A DSPATR(BL HI)
A M1MSG 67A O 24 10
A DSPATR(BL HI)
A* 罫線クリア用レコード
A R CLRGRD GRDRCD
A GRDCLR
A
A
A
A*%%TS SD 20200419 095919 YAMAGUCHI REL-V7R4M0 5770-WDS
A R KSEN GRDRCD
A*%%TS SD 20200416 100413 YAMAGUCHI REL-V7R4M0 5770-WDS
A** 仮で入力した値はコメントアウト 2'KEISEN'
A GRDATR((*COLOR HWHT))
A GRDLIN((*POS (10 05 08)) +
A (*TYPE LEFT))
A GRDLIN((*POS (10 05 75)) +
A (*TYPE UPPER))
A GRDLIN((*POS (10 79 08)) +
A (*TYPE RIGHT))
A GRDLIN((*POS (17 05 75)) +
A (*TYPE LOWER))
A GRDLIN((*POS (10 28 08)) +
A (*TYPE LEFT))
A GRDLIN((*POS (11 05 75)) +
A (*TYPE LOWER))
A GRDLIN((*POS (13 05 75)) +
A (*TYPE LOWER))
A GRDLIN((*POS (15 05 75)) +
A (*TYPE LOWER))
レコード PANEL01 得意先コード入力エリア
Rで指定されたPANEL01が、DSPFにおけるレコード様式の指定です。
画面定義はこのレコード様式で１画面内に表示する領域を分割して定義することが一般的なようです。
各定義の意味や、定義方法についてはIBM i (旧AS400）の自己学習メモ１０ DSPF SDA（Screen Design Aid）チートシートにSDAでDSPFを定義する方法についてまとめていますのでそちらをご確認ください。
実際に自分でDSPFを定義していて思ったのは、全ての定義がSDAで行えるわけではないということが、いまいちよくわかりませんでした。
以下ソースコードの定義でいうと、DATEに指定している(*JOB *YY)の部分はSDAで設定する方法がわかりませんでした。
この指定は、YYYY-MM-DD形式でシステム日付を画面表示したい場合に指定する方法なのですが、SDAではDD-DD-DD形式にしかならずに、その変更方法がわかりませんでした。
そのため、SEUを使って直接DSPFを修正して対応しました。
SDAは画面の見た目を確認しながら、ラベルや入出力項目を設置することだけを実現し、その他細かい属性情報の追加／修正はSEUでやるのが効率的なんだろうか。。。そこは開発経験を積んでいく中で見極めたいなと思います。
A R PANEL01
A*%%TS SD 20200419 095919 YAMAGUCHI REL-V7R4M0 5770-WDS
A OVERLAY
A 1 3'DSP01'
A 1 35'得意先照会'
A DSPATR(RI)
A COLOR(BLU)
A 1 70DATE(*JOB *YY)
A EDTCDE(Y)
A 3 2'照会する得意先コードを入力してく+
A ださい。'
A 5 2'得意先コード・・・・・'
A TOKCD R B 5 27REFFLD(MTOKISKR/TOKCD YAMAGUCHI1/MT-
A OKISKP)
A COLOR(WHT)
以下の部分はデータベースフィールドから入出力項目を設置するSDAの機能で得意先マスタ．得意先コードを設置したため、REFFLDの定義がされています。
このコードを見ると、YAMAGUCHI1/MTOKISKPというライブラリやファイルにものすごく依存してしまっているように見えるため、あまり良いコードのようには思えません。
今回はサンプルのため、この得意先コードだけデータベースフィールドからの設定をやってみましたが、あまり使うことは無いのかなぁと思っています。
A TOKCD R B 5 27REFFLD(MTOKISKR/TOKCD YAMAGUCHI1/MT-
A OKISKP)
A COLOR(WHT)
レコード PANEL02 得意先情報の表示エリア
A R PANEL02
A*%%TS SD 20200502 053221 YAMAGUCHI REL-V7R4M0 5770-WDS
A OVERLAY
A PROTECT
A BLINK
A 8 3'得意先情報'
A 10 6'得意先名・・・・・・'
A 12 6'得意先名カナ・・・・'
A 14 6'電話番号・・・・・・'
A 16 6'信用限度額・・・・・'
A P2@TOKNM 40A O 10 29
A P2@TOKKANA 40A O 12 29
A P2@TOKTEL 15A O 14 29
A P2@TOKRMT 9Y 0O 16 29EDTCDE(J)
P2から始まる各項目が得意先マスタから取得した情報を表示する得意先名や電話番号の表示用エリアです。
得意先マスタで定義されているカラム名と全く同じ名前にしておくと、CHAINなどでファイルからデータを取得した時点で勝手に画面表示が行われます。
ただ、何らかの処理をしたあとに、画面へ表示情報を設定する。という制御を行いたい場合もあるかと思いますので、意図的に項目名をPF/LFの定義とは変えています。
以下の項目にはEDTCDE(J)を指定しています。
数値項目に何もEDTCDEを指定しない場合、９桁の表示領域に対して 1000 を取得して表示すると000001000と画面表示されてしまいます。
そのため、EDTCDEを指定しています。
A P2@TOKRMT 9Y 0O 16 29EDTCDE(J)
レコード 罫線クリア用
GRDLINで罫線を画面に引いている場合、画面の様々な処理（詳細表示エリアを出した後、F12キーを押下して戻るなど）で、罫線が画面上でクリアされずに残ってしまうことがありました。
なんかGRDCLRとかされないと、残骸が残ってしまうようなことになるらしいので、罫線クリアのためだけのレコードを個別に定義しています。
A* 罫線クリア用レコード
A R CLRGRD GRDRCD
A GRDCLR
レコード 罫線
ここではSEUでGRDLINをゴリゴリ定義して罫線を引いています。
他にも罫線を引く方法があり、ToolBoxを使うとドラッグ＆ドロップで罫線を引いたりすることもできるみたいな記事があったのですが、PUB400.comにはToolBoxが使えるような環境ではなかったので、SEUでゴリゴリコーディングしています。
A R KSEN GRDRCD
A*%%TS SD 20200416 100413 YAMAGUCHI REL-V7R4M0 5770-WDS
A** 仮で入力した値はコメントアウト 2'KEISEN'
A GRDATR((*COLOR HWHT))
A GRDLIN((*POS (10 05 08)) +
A (*TYPE LEFT))
A GRDLIN((*POS (10 05 75)) +
A (*TYPE UPPER))
A GRDLIN((*POS (10 79 08)) +
A (*TYPE RIGHT))
A GRDLIN((*POS (17 05 75)) +
A (*TYPE LOWER))
A GRDLIN((*POS (10 28 08)) +
A (*TYPE LEFT))
A GRDLIN((*POS (11 05 75)) +
A (*TYPE LOWER))
A GRDLIN((*POS (13 05 75)) +
A (*TYPE LOWER))
A GRDLIN((*POS (15 05 75)) +
A (*TYPE LOWER))
RPGの定義
RPGコード
H DATEDIT(*YMD)
**********************************************************************
*ファイル定義
**********************************************************************
*画面ファイル
FDSP01 CF E WORKSTN
*得意先マスタ
FMTOKISKL00IF E K DISK
**********************************************************************
*ワークフィールド
**********************************************************************
*メインルーチン切替制御用
D @@CTL S 3
**********************************************************************
*パラメータリスト
**********************************************************************
*メッセージ用パラメータリスト
C PL@MSG PLIST
C PARM PL@MID 5
C PARM PL@MMSG 57
**********************************************************************
*メイン処理
**********************************************************************
C @@CTL CASEQ 'HED' @HED
C @@CTL CASEQ 'DTL' @DTL
C @@CTL CASEQ 'END' @END
C ENDCS
**********************************************************************
*サブルーチン処理
**********************************************************************
**********************************************************************
*得意先コード指定画面の処理
**********************************************************************
C @HED BEGSR
C WRITE CLRGRD
C WRITE PANEL03
C WRITE M1
C EXFMT PANEL01
*キー入力に応じた処理
C SELECT
* F3キー終了
C WHEN *IN03 = *ON
C EVAL @@CTL = 'END'
* F12キー何もしない
C WHEN *IN12 = *ON
* Enterキー
C OTHER
*チェック処理
C EXSR @CHK
*エラーがなければ明細を表示
C IF *IN91 = *OFF
C EVAL @@CTL = 'DTL'
C ENDIF
C ENDSL
C ENDSR
**********************************************************************
*得意先照会エリア表示の処理
**********************************************************************
C @DTL BEGSR
* @CHKでCHAINした結果を画面の表示項目にセット
C EVAL P2@TOKNM = TOKNM
C EVAL P2@TOKKANA = TOKKANA
C EVAL P2@TOKTEL = TOKTEL
C EVAL P2@TOKRMT = TOKRMT
C
C WRITE CLRGRD
C WRITE PANEL03
C WRITE PANEL01
C WRITE KSEN
C EXFMT PANEL02
*キーに応じた処理
C SELECT
* F3キー終了
C WHEN *IN03 = *ON
C EVAL @@CTL = 'END'
* F12キー PANEL02を閉じてPANEL01だけの表示に切り替える
C WHEN *IN12 = *ON
C EXSR @RESET
C EVAL @@CTL = 'HED'
C OTHER
C ENDSL
C ENDSR
**********************************************************************
*チェック処理
**********************************************************************
C @CHK BEGSR
* 指定された得意先コードが得意先マスタに存在しない場合エラー
C TOKCD CHAIN MTOKISKL00 91
C IF *IN91 = *ON
C EVAL PL@MID = 'ERR01'
C EVAL PL@MMSG = '得意先マスタに存在しません'
C EXSR @MSG
C LEAVESR
C ELSE
C EXSR @RESET
C ENDIF
C ENDSR
**********************************************************************
*終了処理
**********************************************************************
C @END BEGSR
C EVAL *INLR = *ON
C RETURN
C ENDSR
*リセット処理
**********************************************************************
*リセット処理
**********************************************************************
C @RESET BEGSR
*エラー情報をクリア
C CLEAR M1
C SETOFF 91
C ENDSR
C
**********************************************************************
*メッセージ表示処理
**********************************************************************
C @MSG BEGSR
C EVAL M1MSGID = PL@MID
C EVAL M1MSG = PL@MMSG
C ENDSR
**********************************************************************
*初期設定*INZSR初期化サブルーチン
**********************************************************************
C *INZSR BEGSR
C EVAL @@CTL = 'HED'
C ENDSR
H仕様書／制御仕様書
H DATEDIT(*YMD)
プログラムの作成および実行についての制御情報を指定するエリア。
ここで指定しているキーワードDATEDITはジョブ日付の形式を指定する。
*YMDと指定すると、YY/MM/DD形式となる。
F仕様書／ファイル仕様書
使用するファイルすべてを指定するエリア。
使用するファイルとは、データベースのテーブルに該当するファイル（PF/LF）や、画面定義ファイル（DSPF）、帳票ファイルなどが該当します。
*画面ファイル
FDSP01 CF E WORKSTN
*得意先マスタ
FMTOKISKL00IF E K DISK
- 12桁目:ファイル・タイプ
- C : 入出力ファイル（Combined file）で、読み取りと書き込みの両方を行うファイル。
画面ファイルは必ずこのタイプを指定する。 - I : 入力ファイルで、読み取り専用のファイル。
- C : 入出力ファイル（Combined file）で、読み取りと書き込みの両方を行うファイル。
- １３桁目:ファイルの指定
- F : 前手順ファイル。プログラム内で演算命令を使用してデータを読み取る。
- １７桁目:形式
- E : 外部記述ファイル。レコードの形式がDDSによって別のプログラム内に定義されていることを表す。
- F : プログラム記述ファイル。レコードの形式をRPGプログラム内で指定することを表す。
- ２９桁目:レコード・アクセスの種類
- K : キー順アクセス・パスを使用する。
- 31桁目以降
- 装置
- DISK : データベースファイル
- WORKSTN : 表示装置ファイル
- 装置
メイン処理
メインの処理から、３つのサブルーチンを分岐によって呼び出すようにしています。
- 'HED' : 得意先コードを指定する画面処理
- 'DTL' : 指定された得意先コードで得意先マスタの情報を取得し、詳細を表示する画面処理
- 'END' : F3キーを押下された場合に得意先照会画面の機能を終了するための処理
@@CTLという変数は、事前に以下のように定義済みです。
この変数で、メイン処理の３つのサブルーチンの呼び出しを分岐しています。
*メインルーチン切替制御用
D @@CTL S 3
C @@CTL CASEQ 'HED' @HED
C @@CTL CASEQ 'DTL' @DTL
C @@CTL CASEQ 'END' @END
C ENDCS
CASEQ / ENDCS CASグループ
CASEQが３つ並び、最後にENDCSという定義があります。
こういった一連の定義をCASグループと呼ぶそうです。
C @@CTL CASEQ 'HED' @HED
この１行の定義は、IFとEXSRを組み合わせた以下のコードと同じ意味となるようです。
EXSR命令は、後述もしますが、定義したサブルーチンを実行することを意味します。
C IF @@CTL = 'HED'
C EXSR @DTL
C ENDIF
なので、CASEQ〜ENDCSまでのCASグループでは、このIF文＋EXSR命令を組み合わせた条件分岐を複数定義するためのグループという意味となります。
CASEQは、@@CTL = 'HED'のように等しい内容かを比較する比較演算の役割を担っていますが、
他の比較演算子となるようなCAS命令が存在します。
CASEQ / CASNE / CASGE / CASGT / CASLE / CASLT / CAS
サブルーチン
サブルーチンは、BEGSR〜ENDSRの範囲で定義されるもの。
C @HED BEGSR
...........
C ENDSR
@HED:得意先コード指定画面の処理
得意先照会画面の画面上部で得意先コードを入力する画面の処理をサブルーチンにまとめています。
処理の主な内容としては
- 入力された得意先コードのチェック処理
- 得意先マスタに存在しない場合、エラーメッセージを表示
- 指定された得意先コードを元に得意先マスタからデータを取得し詳細表示する。
- F3キーを押下すると得意先照会画面の処理を終了し画面を閉じる。
**********************************************************************
*得意先コード指定画面の処理
**********************************************************************
C @HED BEGSR
C WRITE CLRGRD
C WRITE PANEL03
C WRITE M1
C EXFMT PANEL01
*キー入力に応じた処理
C SELECT
* F3キー終了
C WHEN *IN03 = *ON
C EVAL @@CTL = 'END'
* F12キー何もしない
C WHEN *IN12 = *ON
* Enterキー
C OTHER
*チェック処理
C EXSR @CHK
*エラーがなければ明細を表示
C IF *IN91 = *OFF
C EVAL @@CTL = 'DTL'
C ENDIF
C ENDSL
C ENDSR
WRITE / EXFMT
WRITEやEXFMT命令を列挙している箇所があります。
ここで指定しているCLRGRDやPANEL03は、DSPFで定義しているレコード定義の名前を指定しています。
C WRITE CLRGRD
C WRITE PANEL03
C WRITE M1
C EXFMT PANEL01
- WRITE
- DSPFで定義されたレコード様式の入出力項目の表示を行う。
- ユーザーの入力を待たずに次の命令を実行する。
上記のコードでは、CLRGRDのレコード様式の表示をおこなった後、ユーザーの入力を一切待たずに、次の命令のPANEL03のWRITEを実行する。ということを意味します。
- EXFMT
- DSPFで定義されたレコード様式の入出力項目の表示を行う。
- ユーザーの入力を待って、そのレコード様式の入出力項目の値を読み取る。
上記コードでは、CLRGRD/PANEL03/M1までのレコード様式を全て画面表示したあと、PANEL01の画面表示を行い、ユーザーからのキー入力を待つ状態となる。
Enterやファンクションキーが入力されると、ユーザーからの入力だと判断し、プログラムが次の行へと移っていく。
ユーザーからの入力に応じた処理分岐
EXFMTでユーザーからの入力を待ったあと、キー入力が行われた際に、その入力に応じて処理を分岐します。
やっていることは、
- F3キー押下
- 画面の処理終了（画面を閉じる）
- F12キー押下
- 得意先コード入力を受け付ける状態の画面では、特に何もしない。
※後続の照会画面では、得意先コード入力画面に戻るためにF12キーの入力が受け付けられるようになっている。
- 得意先コード入力を受け付ける状態の画面では、特に何もしない。
- Enterキー押下
- 入力された得意先コードのチェック処理を行う
- エラーがあったらエラーメッセージを表示
- エラーがなかったら得意先照会画面を表示
- 入力された得意先コードのチェック処理を行う
SELECT〜ENDSLは、よくあるCase文，Switch文などのいわゆる多方向分岐を実現するための構文です。
特にユーザーからのキー入力をSELECTでやらなければいけないわけではなく、IFでも問題はありませんが、ここでは多方向分岐のSELECTを利用しています。
*キー入力に応じた処理
C SELECT
* F3キー終了
C WHEN *IN03 = *ON
C EVAL @@CTL = 'END'
* F12キー何もしない
C WHEN *IN12 = *ON
* Enterキー
C OTHER
*チェック処理
C EXSR @CHK
*エラーがなければ明細を表示
C IF *IN91 = *OFF
C EVAL @@CTL = 'DTL'
C ENDIF
C ENDSL
*IN03 / *IN12
*IN03や*IN12は、定義済みの RPG IV 標識というものらしく、キー入力によってセットされる特定の標識を参照するための変数です。
DSPFで以下のように、F3やF12キーに応じた標識を定義しています。
基本的に、F3やF12などのファンクションキーと、標識の定義は同じ番号になるように定義することが一般的なようですが、CF03(22 '終了') のように、全然関係ない標識番号を指定することも可能なようです。
A CF03(03 '終了')
A CF12(12 '戻る')
メイン処理の不思議
メイン処理に定義されたCASEQ３つで、それぞれのサブルーチンを呼び出しているのですが、得意先コードを指定する画面のサブルーチン@HEDのサブルーチンが終わって、得意先コードに不正な値があった場合、DTLの表示を行うのではなく、次の処理に行かずに、HEDの処理のキー入力を待つ状態に戻ります。
C DO *HIVAL
C @@CTL CASEQ 'HED' @HED
C @@CTL CASEQ 'DTL' @DTL
C @@CTL CASEQ 'END' @END
C ENDCS
C ENDDO
ここで、ネットで検索していると、上記のメイン処理に加えて、DO *HIVAL〜ENDDOで囲っているメイン処理を作っている人がいます。
私が作ったサンプルでは、DO〜ENDDOを記載していないので、@HEDで得意先コードが不正な場合、エラーメッセージを表示した後、普通なら@DTLのCASEQの行にコードが移動し、一致しないので次の行へ、次の行へ、、、とコードが下に移動して行って、ENDCSに到達してしまうと思っています。
ENDCSに到達したら、どのサブルーチンも実行されていない状態なので、@HEDのところにはどうやっても到達しないと思うのですが、実際の挙動をみていると、ちゃんと@HEDのところでユーザーからのキー入力を待ち受けているし、、、
むしろDO〜ENDDOで囲っているコードの方が、今自分が作っている画面の動きと一致しているように思えるので、不思議なんですよねぇ。。。
どうしてなんだろう？
@DTL:得意先照会エリア表示の処理
指定された得意先コードを元に、得意先マスタから情報を取得し、画面に表示する処理を行うサブルーチンです。
と言っても、得意先マスタから情報を取得する処理が一切サブルーチンに含まれていません。
これは、得意先コードを入力した後、チェック処理@CHKを実行している中で、得意先マスタから情報を取得しています。
その取得した情報のカラム名とDSPFの項目名が一致しているので、自動的に画面への表示処理が行われているということになります。
取得したカラム情報を、画面の表示項目 P2@*** にセットして画面表示処理を実現しています。
F12キー押下時に、詳細表示をやめて、得意先コード指定画面を再表示するような処理を行う@RESETサブルーチンを呼び出して戻る処理を実現しています。
**********************************************************************
*得意先照会エリア表示の処理
**********************************************************************
C @DTL BEGSR
* @CHKでCHAINした結果を画面の表示項目にセット
C EVAL P2@TOKNM = TOKNM
C EVAL P2@TOKKANA = TOKKANA
C EVAL P2@TOKTEL = TOKTEL
C EVAL P2@TOKRMT = TOKRMT
C
C WRITE CLRGRD
C WRITE PANEL03
C WRITE PANEL01
C WRITE KSEN
C EXFMT PANEL02
*キーに応じた処理
C SELECT
* F3キー終了
C WHEN *IN03 = *ON
C EVAL @@CTL = 'END'
* F12キー PANEL02を閉じてPANEL01だけの表示に切り替える
C WHEN *IN12 = *ON
C EXSR @RESET
C EVAL @@CTL = 'HED'
C OTHER
C ENDSL
C ENDSR
@END:終了サブルーチン
画面の処理を閉じる終了サブルーチンです。
ここでのポイントはLRという標識に*ONをセットしているところです。
LRは、最終レコード標識と呼ぶ特殊な標識らしいのですが、以下のページを読んでも何言ってんのかよくわかりません。
https://www.ibm.com/support/knowledgecenter/ja/ssw_ibm_i_72/rzasd/lrind.htm
とりあえず、LR標識をONにしておけば、処理が終了するということなのだろうと思います。
（ONにした瞬間に処理が終了するわけではないと思うのですが、ONにしたあとどこに到達すると終了するのか、、、）
**********************************************************************
*終了処理
**********************************************************************
C @END BEGSR
C EVAL *INLR = *ON
C RETURN
C ENDSR
@CHK:チェックサブルーチン
MTOKISKP（得意先マスタ）の論理ファイルであるMTOKISKL00を利用しています。
MTOKISKPにはキー項目が設定されておらず、MTOKISKL00にキー項目として得意先コードを定義しているので、
論理ファイルを利用しています。
**********************************************************************
*チェック処理
**********************************************************************
C @CHK BEGSR
* 指定された得意先コードが得意先マスタに存在しない場合エラー
C TOKCD CHAIN MTOKISKL00 91
C IF *IN91 = *ON
C EVAL PL@MID = 'ERR01'
C EVAL PL@MMSG = '得意先マスタに存在しません'
C EXSR @MSG
C LEAVESR
C ELSE
C EXSR @RESET
C ENDIF
C ENDSR
- CHAIN
- 指定された検索引数から指定されたファイルを検索して読み取る命令
- 一気に全件読み込むわけではなく、１行ずつデータを取得する
- HIに指定されている標識
91は、TOKCDを引数にMTOKISKL00から検索した結果、該当データが存在する場合はOFFに、存在しない場合はONになる。
Level N01 Factor 1 Operation Factor 2 Result
____ ___ TOKCD CHAIN MTOKISKL00 _______
Decimal
Length Positions HI LO EQ Comment
______ _________ 91 __ __ _______
@RESET:リセット処理サブルーチン
M1（メッセージ表示エリア）と標識91（得意先マスタにデータが存在しなかった場合にONになる標識）をクリアしています。
これをクリアしておかないと、エラーメッセージが表示されっぱなしになってしまいます。
**********************************************************************
*リセット処理
**********************************************************************
C @RESET BEGSR
*エラー情報をクリア
C CLEAR M1
C SETOFF 91
C ENDSR
@MSG:メッセージ表示処理サブルーチン
エラーメッセージIDとエラーメッセージ本文を画面項目のM1MSGIDとM1MSGにセットしています。
今回のチェック処理は、得意先マスタに存在するか否かの１つしかチェックしていませんが、
１つしかチェック処理が無い機能なんてほとんど存在しないと思いますので、汎用的なメッセージ表示処理になるようなイメージで、
メッセージIDとメッセージ本文を変数で設定できるようにしてあります。
**********************************************************************
*メッセージ表示処理
**********************************************************************
C @MSG BEGSR
C EVAL M1MSGID = PL@MID
C EVAL M1MSG = PL@MMSG
C ENDSR
*INZSR:初期処理サブルーチン
*INZSRサブルーチンは、
初期化サブルーチンによって、1P 出力の前に演算仕様書を処理することができます。 プログラムの初期化時に実行される特定のサブルーチンは、そのサブルーチン の BEGSR 命令の演算項目 1 に *INZSR を指定することによって定義することがで きます。 初期化サブルーチンとして定義できるのは、1 つのサブルーチンだけ です。 それが呼び出されるのは、プログラム・サイクルのプログラム初期化ステップの終了時になります (すなわち、データ構造およびサブフィールドの初期化、外部標識およびユーザー・データ・フィールドの検索、グローバル・ファイルのオープン、データ域のデータ構造、配列、およびテーブルのロード、*ENTRY PLIST の演算項目 1 への PARM の結果フィールドの転送が、すべて実行された後)。 *INZSR をファイル/プログラム・エラー/例外サブルーチンとして指定すること はできません。
引用：https://www.ibm.com/support/knowledgecenter/ja/ssw_ibm_i_72/rzasd/inz_subr.htm
だそうです。
なんでこんなにわかりづらく説明するんだろうか。。。
とりあえずメイン処理を行う前に暗黙定義された*INZSRサブルーチンが最初に実行されるようです。
メイン処理で@@CTLがHED/DTL/ENDのいずれかであれば、該当するサブルーチンを実行するように処理分岐していますが、初期値として何もセットされていないと、全ての分岐をスルーしてしまいます。
ここでHEDを設定しています。
**********************************************************************
*初期設定*INZSR初期化サブルーチン
**********************************************************************
C *INZSR BEGSR
C EVAL @@CTL = 'HED'
C ENDSR