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に帰属します。詳細はこちらをご参照ください。