Claude（担当者1）～ 最初のアウトプット／完成ソース ～
最初のアウトプット
DDS（TKMASW）
*-----------------------------------------------------------------*
* ファイル名 : TKMASW *
* 種別 : 物理ファイル（新規／提案） *
* 用途 : 得意先マスタABC分析 結果格納用ワークファイル *
* TKMASP（得意先マスタ）の全15項目 ＋ 分析結果4項目 *
* キー : TKBANG（得意先番号／UNIQUE） *
* 作成方法 : CRTPF FILE(TKMASW) SRCFILE(QDDSSRC) SRCMBR(TKMASW) *
*-----------------------------------------------------------------*
A R TKMASWR
A*--------------- TKMASPからの引継項目（全15項目） -----------*
A TKBANG 5A COLHDG('得意先' '番号')
A TKNAKN 20A COLHDG('得意先名' 'カナ')
A TKNAKJ 20O COLHDG('得意先名' '漢字')
A TKADR1 20O COLHDG('住所' '(1)')
A TKADR2 20O COLHDG('住所' '(2)')
A TKTIKU 2A COLHDG('地区' 'コード')
A TKPOST 6A COLHDG('郵便' '番号')
A TKTELE 13A COLHDG('電話' '番号')
A TKGURI 9P 0 COLHDG('当月' '売上高')
A TKNURI 9P 0 COLHDG('当年' '売上高')
A TKZURI 9P 0 COLHDG('前年' '売上高')
A TKUZAN 9P 0 COLHDG('売掛金' '残高')
A TKGEND 9P 0 COLHDG('信用' '限度額')
A TKNYUK 6P 0 COLHDG('最終' '入金日')
A TKSIME 1A COLHDG('締め日' 'コード')
A*--------------- ABC分析結果 追加項目（4項目） --------------*
A JUNI 5P 0 COLHDG('信用限度額' '順位')
A TEXT('信用限度額順位(提案)')
A KOSEI 7P 4 COLHDG('構成比' '(%)')
A TEXT('構成比%(提案)')
A RUIKEI 7P 4 COLHDG('累積構成比' '(%)')
A TEXT('累積構成比%(提案)')
A KEKKA 1A COLHDG('ABC' 'ランク')
A TEXT('結果(ABCランク)必須')
A K TKBANG
CLLE（TKABCCL）
/*--------------------------------------------------*/
/* プログラム名 : TKABCCL */
/* 種別 : CLLEプログラム（ドライバ） */
/* 機能 : ①TKMASW存在チェック／作成・クリア */
/* ②TKMASP全件をTKMASWへコピー */
/* ③TKMASPをTKGEND降順/TKBANG昇順で */
/* OPNQRYFしてソート順アクセス経路化 */
/* ④ABC分析本体プログラム(TKABCR)呼出 */
/*--------------------------------------------------*/
PGM
DCL VAR(&LIB) TYPE(*CHAR) LEN(10) VALUE('*LIBL')
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(256)
/* ① ワークファイル TKMASW の存在チェック */
CHKOBJ OBJ(&LIB/TKMASW) OBJTYPE(*FILE) MBR(*FIRST)
MONMSG MSGID(CPF9801 CPF9810) EXEC(GOTO CMDLBL(CRTWORK))
/* 存在する場合 → 前回実行分の残存回避のためクリア */
CLRPFM FILE(&LIB/TKMASW)
MONMSG MSGID(CPF0000)
GOTO CMDLBL(COPYSTEP)
/* 存在しない場合 → TKMASWをDDS(QDDSSRC/TKMASW)から新規作成 */
CRTWORK: CRTPF FILE(&LIB/TKMASW) +
SRCFILE(&LIB/QDDSSRC) SRCMBR(TKMASW) +
SIZE(*NOMAX) +
TEXT('ABC分析結果ワークファイル(TKMASP+分析結果)')
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&MSGDTA) VALUE('TKMASWの作成に失敗しました。')
CALLSUBR SUBR(SNDESC)
GOTO CMDLBL(ENDPGM)
ENDDO
/* ② TKMASP全件をTKMASWへコピー（付加項目は初期値のまま） */
/* JUNI=0,KOSEI=0,RUIKEI=0,KEKKA=' ' はDDS上のデフォルト値 */
COPYSTEP: CPYF FROMFILE(&LIB/TKMASP) TOFILE(&LIB/TKMASW) +
MBROPT(*REPLACE) FMTOPT(*MAP *DROP)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&MSGDTA) VALUE('TKMASP→TKMASWのコピーに失敗しました。')
CALLSUBR SUBR(SNDESC)
GOTO CMDLBL(ENDPGM)
ENDDO
/* ③ TKMASPを信用限度額(TKGEND)降順、同額時 得意先番号昇順で */
/* OPNQRYFし、以降このジョブ内でTKMASPを開くプログラムは */
/* このソート順でシーケンシャルREADする（RPG側は無変更） */
OPNQRYF FILE((&LIB/TKMASP)) +
KEYFLD((TKGEND *DESCEND) (TKBANG *ASCEND))
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&MSGDTA) VALUE('TKMASPのOPNQRYFに失敗しました。')
CALLSUBR SUBR(SNDESC)
GOTO CMDLBL(ENDPGM)
ENDDO
/* ④ ABC分析本体プログラム呼出 */
CALL PGM(TKABCR)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&MSGDTA) VALUE('TKABCRの実行中にエラーが発生しました。')
CALLSUBR SUBR(SNDESC)
ENDDO
/* ソート用アクセス経路のクローズ（OPNQRYFの後始末） */
CLOF OPNID(TKMASP)
MONMSG MSGID(CPF0000)
ENDPGM: RETURN
/*----------------------------------------------------------- */
/* サブルーチン：異常終了メッセージ送信（*ESCAPE） */
/*----------------------------------------------------------- */
SNDESC: SUBR
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDSUBR
ENDPGM
RPGLE（TKABCR）
H* ------------------------------------------------------------
H* プログラム名 : TKABCR
H* 機能 : 得意先マスタ(TKMASP)の信用限度額(TKGEND)を
H* 基準にABC分析を行い、結果をTKMASWへ書込む
H* 前提 : 呼出元CL(TKABCCL)にてTKMASPをTKGEND降順/
H* TKBANG昇順でOPNQRYF済であること
H* ------------------------------------------------------------
H DFTACTGRP(*NO) ACTGRP(*CALLER) OPTION(*SRCSTMT:*NODEBUGIO)
H DATFMT(*ISO)
*
FTKMASP IF E K DISK USROPN
FTKMASW UF E K DISK USROPN
*
D**--------------------------------------------------------**
D* QCMDEXC : SNDPGMMSGコマンド実行用（E001～E005メッセージ送信）
D**--------------------------------------------------------**
D QCmdExc PR EXTPGM('QCMDEXC')
D CmdStg 3000A CONST
D CmdLen 15P 5 CONST
*
D**--------------------------------------------------------**
D* ワーク変数
D**--------------------------------------------------------**
D ZGokei S 11P 4 INZ(0) 信用限度額合計
D Kosei S 7P 4 INZ(0) 構成比(当件)
D Ruikei S 7P 4 INZ(0) 累積構成比(累計)
D Juni S 5P 0 INZ(0) 順位
D RecCnt S 7P 0 INZ(0) 処理対象件数
D ErrCnt S 7P 0 INZ(0) エラー件数(継続分)
D CmdBuf S 256A INZ
D MsgTxt S 132A INZ
*
C**--------------------------------------------------------**
C* ①②③ ファイルオープン（E002：オープン失敗）
C**--------------------------------------------------------**
C OPEN(E) TKMASP
C IF %ERROR
C EVAL MsgTxt = 'E002：ファイルのオープンに' +
C '失敗しました。ファイル名：TKMASP'
C EXSR $SNDESC
C ENDIF
*
C OPEN(E) TKMASW
C IF %ERROR
C EVAL MsgTxt = 'E002：ファイルのオープンに' +
C '失敗しました。ファイル名：TKMASW'
C EXSR $SNDESC
C ENDIF
*
C**--------------------------------------------------------**
C* ④ 第1パス：全件READし信用限度額合計(ZGOKEI)と件数を集計
C* （TKMASPはOPNQRYFによりTKGEND降順/TKBANG昇順の並び）
C**--------------------------------------------------------**
C READ(E) TKMASP
C DOW NOT %EOF(TKMASP)
C IF %ERROR
C EVAL MsgTxt = 'E003：レコード読込中にエラーが' +
C '発生しました。(第1パス)'
C EXSR $SNDDIAG
C ELSE
C EVAL ZGokei = ZGokei + TKGEND
C EVAL RecCnt = RecCnt + 1
C ENDIF
C READ(E) TKMASP
C ENDDO
*
C**--------------------------------------------------------**
C* ⑤ 0件チェック（E001：データなし → 正常終了扱い）
C**--------------------------------------------------------**
C IF RecCnt = 0
C EVAL MsgTxt = 'E001：得意先マスタ(TKMASP)に' +
C '対象データが存在しません。' +
C '処理を終了します。'
C EXSR $SNDDIAG
C EXSR $CLOSE
C EVAL *INLR = *ON
C RETURN
C ENDIF
*
C**--------------------------------------------------------**
C* ⑥ 合計ゼロチェック（E004：ゼロ除算防止 → 異常終了）
C**--------------------------------------------------------**
C IF ZGokei = 0
C EVAL MsgTxt = 'E004：信用限度額合計がゼロの' +
C 'ため、構成比を算出できません。' +
C '処理を中断します。'
C EXSR $SNDESC
C ENDIF
*
C**--------------------------------------------------------**
C* ⑦ 第2パス：TKMASPを先頭に戻し、ソート順に1件ずつ処理
C* JUNI／KOSEI／RUIKEI／KEKKAを算出しTKMASWをCHAIN→UPDATE
C**--------------------------------------------------------**
C FEOD TKMASP
C EVAL Juni = 0
C EVAL Ruikei = 0
*
C READ(E) TKMASP
C DOW NOT %EOF(TKMASP)
C IF %ERROR
C EVAL MsgTxt = 'E003：レコード読込中にエラーが' +
C '発生しました。(第2パス)'
C EXSR $SNDDIAG
C EVAL ErrCnt = ErrCnt + 1
C READ(E) TKMASP
C ITER
C ENDIF
*
C* ⑦-1 順位（1から連番）
C EVAL Juni = Juni + 1
*
C* ⑦-2 構成比 KOSEI = TKGEND ÷ ZGOKEI × 100（小数第4位保持）
C EVAL(H) Kosei = (TKGEND / ZGokei) * 100
*
C* ⑦-3 累積構成比 RUIKEI（内部保持桁=小数第4位のまま加算）
C EVAL(H) Ruikei = Ruikei + Kosei
*
C* ⑦-4 ABCランク判定（必ずRUIKEI＝小数第4位の値で比較）
C IF Ruikei <= 70.0000
C EVAL KEKKA = 'A'
C ELSEIF Ruikei <= 90.0000
C EVAL KEKKA = 'B'
C ELSE
C EVAL KEKKA = 'C'
C ENDIF
*
C* ⑦-5 TKMASWをTKBANGでCHAINし更新
C CHAIN(E) TKBANG TKMASW
C IF %FOUND(TKMASW)
C EVAL JUNI = Juni
C EVAL KOSEI = Kosei
C EVAL RUIKEI = Ruikei
C UPDATE(E) TKMASWR
C IF %ERROR
C* UPDATE失敗は真のシステム異常（12章E005：*ESCAPE）
C EVAL MsgTxt = 'E005：システム異常が発生' +
C 'しました。ファイル：TKMASW' +
C ' 得意先番号：' + TKBANG
C EXSR $SNDESC
C ENDIF
C ELSE
C* CHAIN失敗（該当なし）は4章詳細フローに従いログ記録し継続
C EVAL MsgTxt = 'E005：更新対象のTKMASW' +
C 'レコードが見つかりません。' +
C '得意先番号：' + TKBANG
C EXSR $SNDDIAG
C EVAL ErrCnt = ErrCnt + 1
C ENDIF
*
C READ(E) TKMASP
C ENDDO
*
C**--------------------------------------------------------**
C* ⑧ 処理件数・エラー件数をジョブログへ出力
C**--------------------------------------------------------**
C EVAL MsgTxt = '処理対象件数：' +
C %CHAR(RecCnt) +
C ' エラー件数：' + %CHAR(ErrCnt)
C EXSR $SNDDIAG
*
C**--------------------------------------------------------**
C* ⑨⑩ ファイルクローズ、正常終了メッセージ送信
C**--------------------------------------------------------**
C EXSR $CLOSE
C EVAL MsgTxt = 'ABC分析処理が正常に終了' +
C 'しました。件数：' + %CHAR(RecCnt)
C EXSR $SNDDIAG
*
C EVAL *INLR = *ON
C RETURN
*
C**--------------------------------------------------------**
C* サブルーチン：ファイルクローズ（多重呼出対策でMONITOR）
C**--------------------------------------------------------**
C $CLOSE BEGSR
C MONITOR
C CLOSE TKMASP
C ON-ERROR
C ENDMON
C MONITOR
C CLOSE TKMASW
C ON-ERROR
C ENDMON
C ENDSR
*
C**--------------------------------------------------------**
C* サブルーチン：情報メッセージ送信（*DIAG／ジョブログ記録のみ、処理継続）
C**--------------------------------------------------------**
C $SNDDIAG BEGSR
C EVAL CmdBuf = 'SNDPGMMSG MSGID(CPF9897) ' +
C 'MSGF(QCPFMSG) MSGDTA(''' +
C %TRIM(MsgTxt) + ''') ' +
C 'MSGTYPE(*DIAG)'
C CALLP QCmdExc(CmdBuf : %LEN(%TRIMR(CmdBuf)))
C ENDSR
*
C**--------------------------------------------------------**
C* サブルーチン：異常終了メッセージ送信（*ESCAPE／プログラム中断）
C**--------------------------------------------------------**
C $SNDESC BEGSR
C EVAL CmdBuf = 'SNDPGMMSG MSGID(CPF9897) ' +
C 'MSGF(QCPFMSG) MSGDTA(''' +
C %TRIM(MsgTxt) + ''') ' +
C 'MSGTYPE(*ESCAPE)'
C CALLP QCmdExc(CmdBuf : %LEN(%TRIMR(CmdBuf)))
C ENDSR
完成ソース
RPGLE（TKABCR：完成版）
H* ------------------------------------------------------
H* プログラム : TKABCR
H* 機能：TKMASWをクリアし、TKMASP全件をTKMASWへコピー後、
H* 信用限度額(TKGEND)降順・得意先番号(TKBANG)昇順で
H* ソートするため配列とSORTAを使用する
H* (OPNQRYFは再オープン時に不安定なため不採用)。
H* その後ABC分析を行い、TKMASWL(TKJUNI/TKKSEI/TKRIKI/
H* TKKEKA)をCHAIN→UPDATEで更新する。
H* 前提：TKMASW(物理・キーなし)は作成済みであること。
H* TKMASWLはTKMASWを親とするTKBANGキーの論理ファイル
H* (レコード様式TKMASRW)。TKMASPはキー不要（信用限度額
H* はソート配列から復元するため、再CHAINは行わない）。
H* ------------------------------------------------------
H DFTACTGRP(*NO) ACTGRP(*NEW) OPTION(*SRCSTMT:*NODEBUGIO)
H DATFMT(*ISO)
F* TKMASP：順次読込専用（キー不要。信用限度額は第2パスで
F* ソート配列から復元するため、CHAINは行わない）
FTKMASP IF E DISK USROPN
F* TKMASWL：TKBANGキーの論理ファイル。CHAIN／UPDATE用
FTKMASWL UF E K DISK USROPN
D* QCMDEXC：CLコマンド実行用（CLRPFM／CPYF）
DQCMDEXC PR EXTPGM('QCMDEXC')
D CMDSTG 3000A CONST
D CMDLEN 15P 5 CONST
D* ワーク項目
DZGOKEI S 15P 4 INZ(0)
DKOSEI S 7P 4 INZ(0)
DRUIKEI S 7P 4 INZ(0)
DJUNI S 5P 0 INZ(0)
DRECCNT S 7P 0 INZ(0)
DERRCNT S 7P 0 INZ(0)
DUPDCNT S 7P 0 INZ(0)
DCMDBUF S 256A INZ
DMSGTXT S 132A INZ
D* ソート用キー配列：10桁ゼロ埋めの反転信用限度額（昇順
D* ソートすると信用限度額の降順になる）＋得意先番号5桁
D* ＝計15桁。未使用の要素は全て'9'で初期化し、ソート後に
D* 末尾へ寄るようにすることで、実データは1～RECCNTの
D* 位置に収まるようにしている。
DMAXREC C CONST(9999)
DSRTKEY S 15A DIM(9999)
D INZ('999999999999999')
D* ゼロ埋め変換用の作業項目（OVERLAYは使わず、%CHAR／
D* %DECによる文字列変換のみで行う。内部の数値格納形式に
D* 依存しないようにするため）
DREVNUM S 10P 0 INZ(0)
DPADKEY S 10A INZ
DPADTMP S 20A INZ
DOFFSET C CONST(1999999999)
C* (1) TKMASWをクリア（作成済み前提。CLRPFM失敗はE002扱いで
C* 異常終了）
/FREE
CMDBUF = 'CLRPFM FILE(TKMASW)';
/END-FREE
C MONITOR
/FREE
QCMDEXC(CMDBUF:%LEN(%TRIMR(CMDBUF)));
/END-FREE
C ON-ERROR
/FREE
MSGTXT = 'E002:TKMASWのCLRPFMに失敗しました。';
/END-FREE
C EXSR SNDESC
C ENDMON
C* (2) TKMASP全件をTKMASWへコピー（追加項目は初期値のまま）
/FREE
CMDBUF = 'CPYF FROMFILE(TKMASP) TOFILE(TKMASW) ' +
'MBROPT(*ADD) FMTOPT(*MAP *DROP)';
/END-FREE
C MONITOR
/FREE
QCMDEXC(CMDBUF:%LEN(%TRIMR(CMDBUF)));
/END-FREE
C ON-ERROR
/FREE
MSGTXT = 'E002:TKMASWへのコピーに失敗しました。';
/END-FREE
C EXSR SNDESC
C ENDMON
C* ファイルオープン（E002）
C OPEN(E) TKMASP
/FREE
IF %ERROR;
MSGTXT = 'E002:TKMASPオープン失敗。';
/END-FREE
C EXSR SNDESC
/FREE
ENDIF;
/END-FREE
C OPEN(E) TKMASWL
/FREE
IF %ERROR;
MSGTXT = 'E002:TKMASWLオープン失敗。';
/END-FREE
C EXSR SNDESC
/FREE
ENDIF;
/END-FREE
C* (3) 第1パス：順次読込（この時点では順序は問わない）。
C* 信用限度額合計(ZGOKEI)・件数を集計し、ソート用
C* キー配列を作成する
C READ(E) TKMASP
/FREE
DOW NOT %EOF(TKMASP);
IF %ERROR;
MSGTXT = 'E003:読込エラー(第1パス)。';
/END-FREE
C EXSR SNDDIAG
/FREE
ELSE;
RECCNT = RECCNT + 1;
IF RECCNT > MAXREC;
MSGTXT = 'E005:件数が上限(9999)超過。';
/END-FREE
C EXSR SNDESC
/FREE
ENDIF;
ZGOKEI = ZGOKEI + TKGEND;
REVNUM = OFFSET - TKGEND;
PADTMP = '0000000000' + %CHAR(REVNUM);
PADKEY = %SUBST(PADTMP:%LEN(%CHAR(REVNUM)) + 1:10);
SRTKEY(RECCNT) = PADKEY;
%SUBST(SRTKEY(RECCNT):11:5) = TKBANG;
ENDIF;
/END-FREE
C READ(E) TKMASP
/FREE
ENDDO;
/END-FREE
C* (4) 0件チェック（E001：データなし → 正常終了扱い）
/FREE
IF RECCNT = 0;
MSGTXT = 'E001:対象データがありません。';
/END-FREE
C EXSR SNDDIAG
C EXSR CLSFILES
/FREE
*INLR = *ON;
RETURN;
ENDIF;
/END-FREE
C* (5) 合計ゼロチェック（E004：ゼロ除算防止 → 異常終了）
/FREE
IF ZGOKEI = 0;
MSGTXT = 'E004:合計ゼロのため中断します。';
/END-FREE
C EXSR SNDESC
/FREE
ENDIF;
/END-FREE
C* (6) ソート：昇順SORTAにより、結合キーの効果で
C* 信用限度額降順・得意先番号昇順の並びになる
C SORTA SRTKEY
C* (7) 第2パス：ソート済み配列を1～RECCNTの順に処理する。
C* 信用限度額はキーから復元する（TKMASPにはキーが
C* ないためCHAINしない）。順位・構成比を計算した後、
C* TKMASWLをCHAINして更新する。
/FREE
JUNI = 0;
RUIKEI = 0;
DOW JUNI < RECCNT;
JUNI = JUNI + 1;
TKBANG = %SUBST(SRTKEY(JUNI):11:5);
PADKEY = %SUBST(SRTKEY(JUNI):1:10);
REVNUM = %DEC(PADKEY:10:0);
TKGEND = OFFSET - REVNUM;
// 構成比＝信用限度額÷合計×100（小数第4位まで）
EVAL(H) KOSEI = (TKGEND / ZGOKEI) * 100;
// 累積構成比
EVAL(H) RUIKEI = RUIKEI + KOSEI;
/END-FREE
C* TKMASWLをTKBANGでCHAINし更新
C TKBANG CHAIN(E) TKMASWL
/FREE
IF %FOUND(TKMASWL);
TKJUNI = JUNI;
TKKSEI = KOSEI;
TKRIKI = RUIKEI;
// ABCランク判定（CHAIN後に設定。CHAINでTKKEKAが
// ファイルの現在値で上書きされるため、この位置で行う）
IF RUIKEI <= 70.0000;
TKKEKA = 'A';
ELSEIF RUIKEI <= 90.0000;
TKKEKA = 'B';
ELSE;
TKKEKA = 'C';
ENDIF;
/END-FREE
C UPDATE(E) TKMASRW
/FREE
IF %ERROR;
MSGTXT = 'E005:更新失敗 得意先:' + TKBANG;
/END-FREE
C EXSR SNDESC
/FREE
ENDIF;
UPDCNT = UPDCNT + 1;
ELSE;
MSGTXT = 'E005:該当レコードなし 得意先:' + TKBANG;
/END-FREE
C EXSR SNDDIAG
/FREE
ERRCNT = ERRCNT + 1;
ENDIF;
ENDDO;
/END-FREE
C* (8) 処理件数・エラー件数を表示
/FREE
MSGTXT = '件数:' + %CHAR(RECCNT) + ' ERR:' + %CHAR(ERRCNT);
/END-FREE
C EXSR SNDDIAG
C* (9)(10) ファイルクローズ、正常終了メッセージ表示
C EXSR CLSFILES
/FREE
MSGTXT = '正常終了 件数:' + %CHAR(RECCNT) +
' 更新:' + %CHAR(UPDCNT);
/END-FREE
C EXSR SNDDIAG
/FREE
*INLR = *ON;
RETURN;
/END-FREE
C* サブルーチン：ファイルクローズ（MONITORで多重防止）
C CLSFILES BEGSR
C MONITOR
C CLOSE TKMASP
C ON-ERROR
C ENDMON
C MONITOR
C CLOSE TKMASWL
C ON-ERROR
C ENDMON
C ENDSR
C* サブルーチン：メッセージ表示（継続処理用）
C SNDDIAG BEGSR
/FREE
DSPLY %SUBST(MSGTXT:1:52);
/END-FREE
C ENDSR
C* サブルーチン：メッセージ表示後にプログラムを終了（異常終了用）
C SNDESC BEGSR
/FREE
DSPLY %SUBST(MSGTXT:1:52);
*INLR = *ON;
RETURN;
/END-FREE
C ENDSR
当記事の著作権はIBMに帰属します。詳細はこちらをご参照ください。