「119. CLPでデータ・ベースをキーで検索する」と
「118. CLPでデータ・ベースを更新する」を組み合わせて
応用するとCLPだけでデータ・ベースを保守(メンテナンス)する
プログラムを作成することができる。
保守するファイルは次のような簡単な品種マスター(HINSHU)である。
0001.00 A**********************************************
0002.00 A* HINSHU : 品種マスターファイル *
0003.00 A**********************************************
0004.00 A UNIQUE
0005.00 A R @HINSHU
0006.00 A*
0007.00 A HNSCOD 4A COLHDG(' 品種コード ')
0008.00 A HNSNAM 14O COLHDG(' 品種名 ')
0009.00 A TEXT(' 漢字 ')
0010.00 A K HNSCOD
品種マスターの保守のためにDSPFを次のように作成した。
初期画面が DSPHEADという名前で明細画面が DSPDTAという名前のレコードである。
0001.00 A DSPSIZ(24 80 *DS3)
0002.00 A MSGLOC(24)
0003.00 A PRINT
0004.00 A R DSPHEAD
0005.00 A TEXT(' 初期画面 ')
0006.00 A* 11:59:33 QSECOFR REL-R06M00 5714-UT1
0007.00 A CF03(03 ' 終了 ')
0008.00 A BLINK
0009.00 A INZRCD
0010.00 A 1 27G' 品種マスターの登録 '
0011.00 A DSPATR(HI)
0012.00 A 2 2' 品種コード '
0013.00 A HNSCOD 4A B +1TEXT(' 品種コード ')
0014.00 A 11 13' 登録または変更するコードを +
0015.00 A 入れて実行キーを押してください '
0016.00 A DSPATR(HI)
0017.00 A 23 2'F3= 終了 '
0018.00 A COLOR(BLU)
0019.00 A R DSPDTA
0020.00 A*%%TS SD 19940302 221529 QTR REL-V2R2M0 5738-PW1
0021.00 A TEXT(' 明細画面 01')
0022.00 A CF03(03 ' 終了 ')
0023.00 A CF10(10 ' 更新 ')
0024.00 A 13 CF23(23 ' 削除 ')
0025.00 A CF12(12 ' 前画面 ')
0026.00 A ROLLUP(07)
0027.00 A ROLLDOWN(08)
0028.00 A SETOF(99)
0029.00 A BLINK
0030.00 A 1 27G' 品種マスターの登録 '
0031.00 A DSPATR(HI)
0032.00 A DSPMSG 6A O 1 72TEXT(' 維持モード ')
0033.00 A DSPATR(HI)
0034.00 A 2 2' 品種コード '
0035.00 A HNSCOD 4A O 2 15TEXT(' 品種コード ')
0036.00 A 5 10' 品種名 '
0037.00 A HNSNAM 14O B 5 24TEXT(' 品種名 ')
0038.00 A 23 2'F3= 終了 '
0039.00 A COLOR(BLU)
0040.00 A 23 35'F10= 更新 '
0041.00 A COLOR(BLU)
0042.00 A 13 23 53'F23= 削除 '
0043.00 A COLOR(BLU)
0044.00 A 23 69'F12= 前画面 '
0045.00 A COLOR(BLU)
実行時の様子は次のとおりである。
品種マスターの登録
品種コード 0003
登録または変更するコードを入れて実行キーを押してください
F3= 終了
品種コード 0003と入力して実行キーを押すと
品種マスターの登録 変更
品種コード 0003
品種名 コンボ
F3= 終了 F10= 更新 F23= 削除 F12= 前画面
と表示される。
品種名を変更してF10キーを押すと更新されるし
F23キーを押すとレコードを削除することができる。
もちろん新しいコードを入力してF10キーを押すとレコードを
追加することもできる。
RPGやCOBOLを書くのがまだ苦手な人でもCLPを学習すれば
簡単にデータ・ベースの保守の適用業務をこのように作成することができる。
RPGやCOBOLの開発に長年携わってきた人もCLPでデータ・ベースを更新できるのは
初めてであると思う。
それではデータ・ベース QTRFIL/HINSHUを更新するCLPを紹介しよう。
[データ・ベースを更新するCLPサンプル: SQL001CL ]
ソースはこちらから
0001.00 PGM
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* SQL001CL : 品種マスターの登録 */
0004.00 /* */
0005.00 /* 2020/02/29 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0008.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0009.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0012.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0013.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0014.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0015.00 VALUE('*ESCAPE ')
0016.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0017.00 VALUE(X'000074') /* 2 進数 */
0018.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0019.00 VALUE(X'00000000')
0020.00 DCLF FILE(QTROBJ/SQL001FM) OPNID(SQL001FM)
0021.00 DCL VAR(&HNSKEY) TYPE(*CHAR) LEN(4)
0022.00 DCLF FILE(QTRFIL/HINSHU) OPNID(HINSHU)
0023.00 DCL VAR(&STR) TYPE(*CHAR) LEN(1024)
0024.00 DCL VAR(") TYPE(*CHAR) LEN(1) VALUE(X'7D')
0025.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0026.00
0027.00 /*( 環境の取得 )*/
0028.00 RTVJOBA TYPE(&TYPE)
0029.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0030.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0031.00 ENDDO /* バッチ */
0032.00 ELSE CMD(DO) /* 対話式 */
0033.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0034.00 ENDDO /* 対話式 */
0035.00
0036.00 /*( 初期画面の表示 )*/
0037.00 START: SNDRCVF RCDFMT(DSPHEAD) OPNID(SQL001FM)
0038.00 /*( CF03 )- 終わり */
0039.00 IF COND(&SQL001FM_IN03 *EQ '1') THEN(DO)
0040.00 RETURN
0041.00 ENDDO
0042.00 /*( 実行キー )*/
0043.00 CHGVAR VAR(&HNSKEY) VALUE(&SQL001FM_HNSCOD)
0044.00 OVRDBF FILE(HINSHU) TOFILE(QTRFIL/HINSHU) +
0045.00 MBR(*FIRST) POSITION(*KEYAE 1 @HINSHU +
0046.00 &HNSKEY)
0047.00 MONMSG MSGID(CPF4137) EXEC(DO)
0048.00 CHGVAR VAR(&SQL001FM_HNSNAM) VALUE(' ')
0049.00 GOTO REDEND
0050.00 ENDDO
0051.00 RCVF OPNID(HINSHU)
0052.00 MONMSG MSGID(CPF0864) EXEC(DO)
0053.00 CHGVAR VAR(&SQL001FM_DSPMSG) VALUE(' 入力 ')
0054.00 CHGVAR VAR(&SQL001FM_HNSNAM) VALUE(' ')
0055.00 CHGVAR VAR(&SQL001FM_IN13) VALUE('0')
0056.00 GOTO REDEND
0057.00 ENDDO
0058.00 IF COND(&HINSHU_HNSCOD *EQ &HNSKEY) THEN(DO)
0059.00 CHGVAR VAR(&SQL001FM_DSPMSG) VALUE(' 変更 ')
0060.00 CHGVAR VAR(&SQL001FM_HNSNAM) VALUE(&HINSHU_HNSNAM)
0061.00 CHGVAR VAR(&SQL001FM_IN13) VALUE('1')
0062.00 ENDDO
0063.00 ELSE CMD(DO)
0064.00 CHGVAR VAR(&SQL001FM_DSPMSG) VALUE(' 入力 ')
0065.00 CHGVAR VAR(&SQL001FM_HNSNAM) VALUE(' ')
0066.00 CHGVAR VAR(&SQL001FM_IN13) VALUE('0')
0067.00 ENDDO
0068.00 REDEND:
0069.00 /*( 明細画面の表示 )*/
0070.00 DSPLY: SNDRCVF RCDFMT(DSPDTA) OPNID(SQL001FM)
0071.00 /*( CF03 )- 終わり */
0072.00 IF COND(&SQL001FM_IN03 *EQ '1') THEN(DO)
0073.00 RETURN
0074.00 ENDDO
0075.00 /*( CF12 )- 取消し */
0076.00 IF COND(&SQL001FM_IN12 *EQ '1') THEN(DO)
0077.00 TFRCTL PGM(QTROBJ/SQL001CL)
0078.00 ENDDO
0079.00 /*( CF10 )- 更新 */
0080.00 IF COND(&SQL001FM_IN10 *EQ '1') THEN(DO)
0081.00 IF COND(&SQL001FM_IN13 *EQ '1') THEN(DO) /* +
0082.00 変更 */
0083.00 CHGVAR VAR(&STR) VALUE('UPDATE QTRFIL/HINSHU SET +
0084.00 HNSNAM = ' *CAT " *CAT +
0085.00 &SQL001FM_HNSNAM *TCAT " *CAT ' +
0086.00 WHERE HNSCOD = ' *CAT " *CAT +
0087.00 &SQL001FM_HNSCOD *CAT ")
0088.00 RUNSQL SQL(&STR) COMMIT(*NONE)
0089.00 CHGVAR VAR(&MSG) VALUE('1 レコードを更新しました。 ')
0090.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0091.00 ENDDO /* 変更 */
0092.00 ELSE CMD(DO) /* 入力 */
0093.00 CHGVAR VAR(&STR) VALUE('INSERT INTO QTRFIL/HINSHU +
0094.00 (HNSCOD, HNSNAM) VALUES(' *CAT " +
0095.00 *CAT &SQL001FM_HNSCOD *CAT " *CAT +
0096.00 ', ' *CAT " *CAT &SQL001FM_HNSNAM +
0097.00 *CAT " *CAT ')')
0098.00 RUNSQL SQL(&STR) COMMIT(*NONE)
0099.00 CHGVAR VAR(&MSG) VALUE('1 レコードを追加しました。 ')
0100.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0101.00 ENDDO /* 入力 */
0102.00 GOTO START
0103.00 ENDDO
0104.00 /*( CF23 )- 削除 */
0105.00 IF COND(&SQL001FM_IN23 *EQ '1') THEN(DO)
0106.00 CHGVAR VAR(&STR) VALUE('DELETE FROM QTRFIL/HINSHU +
0107.00 WHERE HNSCOD = ' *CAT " *CAT +
0108.00 &SQL001FM_HNSCOD *CAT ")
0109.00 RUNSQL SQL(&STR) COMMIT(*NONE)
0110.00 CHGVAR VAR(&MSG) VALUE('1 レコードを削除しました。 ')
0111.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0112.00 ENDDO
0113.00 /*( 実行キー )*/
0114.00 GOTO DSPLY
0115.00 RETURN
0116.00
0117.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0118.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0119.00 MSGFLIB(&MSGFLIB)
0120.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0121.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0122.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0123.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0124.00 ENDDO
0125.00 ELSE CMD(DO)
0126.00 IF COND(&MSGID *EQ 'CPF4137') THEN(DO)
0127.00 CHGVAR VAR(&SQL001FM_DSPMSG) VALUE(' 入力 ')
0128.00 CHGVAR VAR(&SQL001FM_HNSNAM) VALUE(' ')
0129.00 CHGVAR VAR(&SQL001FM_IN13) VALUE('0')
0130.00 GOTO REDEND
0131.00 ENDDO
0132.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0133.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0134.00 MSGTYPE(&MSGTYPE)
0135.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0136.00 ENDDO
0137.00 ENDPGM
[解説]
最初にこのCLP: SQL001CLは２つのファイルを参照している。
0020.00 DCLF FILE(QTROBJ/SQL001FM) OPNID(SQL001FM) : 0022.00 DCLF FILE(QTRFIL/HINSHU) OPNID(HINSHU)
の２つである。
CLPでもひとつのCLPの中で２つ以上の DCLF を宣言できるようになったが
複数のDCLFを宣言するときは識別コード OPNID を指定しなければならない。
そしてそのとき各ファイルのフィールド名はファイル名_フィールド名の形式で
命名される。
例えば画面ファイル : SQL001FM のフィールド: HNSCOD の名前は
SQL001FM_HNSCOD
として扱われる。
さて OVRDBFを使って SETLLを
0043.00 CHGVAR VAR(&HNSKEY) VALUE(&SQL001FM_HNSCOD) 0044.00 OVRDBF FILE(HINSHU) TOFILE(QTRFIL/HINSHU) + 0045.00 MBR(*FIRST) POSITION(*KEYAE 1 @HINSHU + 0046.00 &HNSKEY)
として行って指定した初期画面のキー: 品種コードのレコードがあるかどうかを
調べている。
現存するファイルより大きな位置のキーが指定されたときは CPF4137のエラーになるので
それも予想して対応している。
キーが存在していれば表示モードを「変更」にセットし、存在していなければ
表示モードを「入力」にセットしている。
F10キーやF23キーが押されたときにはSQL文を次のように作成している。
[入力]
INSERT INTO QTRFIL/HISHU (HNSCOD, HNSNAM) VALUES(&HNSCOD, &HNSNAM)
[変更]
UPDATE QTRFIL/HINSHU SET HNSNAM = ‘&HNSNAM’ WHERE HNSCOD = ‘&HNSCOD’
[削除]
DELETE FROM QTRFIL/HINSHU WHERE HNSCOD = ‘&HNSCOD’
これらのSQL文を
RUNSQL SQL(&STR) COMMIT(*NONE)
として RUNSQLを使ってデータ・ベースを更新している。
このようにCLPだけでデータ・ベースを保守できることがわかった。
最後にまだ OS Ver6.1 以下を使っているユーザーでは RUNSQLが導入されていないので
使えないが心配はご無用。
既に Ver6.1以下でも動作する RUNSQLコマンドを開発しているので
それを後日、このサイトのToolsで紹介する。
Toolsはメンバー登録が必要なのでメンバー登録はお早めにどうぞ。