フリー・フォーマット RPG で対話型アプリケーション (Zip コードによる顧客情報の検索)

メインメニューから F6 キーを押したことで呼び出される処理は、顧客データを Zip コードをキーに検索する処理です。

画面イメージはこちらにあります。


画面の定義

画面ファイルの定義です。

画面の部分によって表示するタイミングが異なり、条件によって内容も異なるため、今までより細かいパーツに分かれています。

     A*****************************************************************
     A* ファイル名: SZIPMENU                                          *
     A* 関連プログラム: SCHZIP                                        *
     A* 関連ファイル: CUSMSTL2 (論理ファイル)                         *
     A* 説明: これは、表示装置ファイルSZIPMENU です。                 *
     A*       6 つのレコード様式があります                      *
     A*****************************************************************
     A                                      REF(CUSMSTL2)
     A                                      CHGINPDFT(CS)
     A                                      PRINT(QSYSPRT)
     A                                      INDARA
     A                                      CA03(03 'END OF JOB')
     A          R HEAD
     A                                      OVERLAY
     A                                  2  4TIME
     A                                      DSPATR(HI)
     A                                  2 28'CUSTOMER SEARCH BY ZIP'
     A                                      DSPATR(HI RI)
     A                                  2 70DATE
     A                                      EDTCDE(Y)
     A                                      DSPATR(HI)
     A          R FOOT1
     A                                 23  6'ENTER - Continue'
     A                                      DSPATR(HI)
     A                                 23 29'F3 - End Job'
     A                                      DSPATR(HI)
     A          R FOOT2
     A                                 23  6'ENTER - Continue'
     A                                      DSPATR(HI)
     A                                 23 29'F3 - End Job'
     A                                      DSPATR(HI)
     A                                 23 47'F4 - RESTART ZIP CODE'
     A                                      DSPATR(HI)
     A          R PROMPT
     A                                      OVERLAY
     A                                  4  4'Enter Zip Code'
     A                                      DSPATR(HI)
     A            ZIP       R     Y  I  4 19DSPATR(CS)
     A                                      CHECK(RZ)
     A  61                                  ERRMSG('ZIP CODE NOT FOUND' +
     A                                      61)
     A          R SUBFILE                   SFL
     A            NAME      R           9  4
     A            ARBAL     R           9 27EDTCDE(J)
     A          R SUBCTL                    SFLCTL(SUBFILE)
     A  55                                  SFLCLR
     A N55                                  SFLDSPCTL
     A N55                                  SFLDSP
     A                                      SFLSIZ(13)
     A                                      SFLPAG(13)
     A                                      ROLLUP(95 'ROLL UP')
     A                                      OVERLAY
     A                                      CA04(04 'RESTART ZIP CDE')
     A                                  4  4'Zip Code'
     A            ZIP       R        O  4 14DSPATR(HI)
     A                                  7  4'Customer Name'
     A                                      DSPATR(HI UL)
     A                                  7 27'A/R Balance'
     A                                      DSPATR(HI UL)

ビュー定義

zip フィールド(カラム)によるキー順のビュー定義です。
プログラム内でソートする手間が省けますね。キーによる検索アクセスにも使用できます。

     A*****************************************************************
     A* ファイル名: CUSMSTL2                                          *
     A* 関連プログラム: SCHZIP                                        *
     A* 関連ファイル: CUSTOMER (物理ファイル)                         *
     A* 説明: これは論理ファイルCUSMSTL2 です。これには               *
     A*       1 つのレコード様式CMLREC2 があります。                  *
     A*       これは得意先マスター・ファイル(CUSTOMER) の             *
     A*       得意先郵便番号(ZIP) による論理ビューです。              *
     A*****************************************************************
     A          R CMLREC2                   PFILE(CUSTOMER)
     A            ZIP
     A            NAME
     A            ARBAL
     A          K ZIP

プログラム

      //****************************************************************
      // プログラム名: SCHZIP                                          *
      // 関連ファイル: CUSMSTL2 (論理ファイル)                         *
      //               SZIPMENU (WORKSTN ファイル)                    *
      // 説明: このプログラムは、WORKSTN サブファイル処理を            *
      //       使用した得意先マスター検索プログラムです。              *
      //       このプログラムは、ユーザーに郵便番号の                  *
      //       プロンプトを出し、郵便番号による得意先                  *
      //       マスター・レコードを表示します。                        *
      //       次ページ・キーを使用して、別のページを見ること          *
      //       ができ、PF3 でプログラムが終了します。                  *
      //****************************************************************

     Fcusmstl2  if   E           K DISK
     Fszipmenu  cf   e             workstn sfile(subfile:recnum)
     F                                     indds(indicators)

      // プロトタイプ定義:
     D ProcessSubfile  PR
     D ClearSubfile    PR
     D FillSubfile     PR

      // フィールド定義:
     D recnum          S              5P 0
     D recordFound     s               n
     D indicators      ds
     D exitKey                         n   overlay(indicators:3)
     D restartKey                      n   overlay(indicators:4)
     D sflClear                        n   overlay(indicators:55)
     D zipNotFound                     n   overlay(indicators:61)
     D rollupKey                       n   overlay(indicators:95)

      // キー・リスト定義
     D cstkey        E ds                  extname(cusmstl2:*key)
      //*******************************************************************
      // メインライン                                                     *
      //*******************************************************************
      /free

       // 初期メニューの書き出し
       write foot1;
       write head;
       exfmt prompt;

       // PF03 が押されるまでループする
       dow not exitKey;

          setll %kds(cstkey) cmlrec2;
          recordFound = %equal(cusmstl2);

          if recordFound;
             ProcessSubfile();
          endif;

          // サブファイル表示でPF03 が押された場合は、ループを終了
          if exitKey;
             leave;
          endif;

          // PF04 が押された場合は、
          // 同じ郵便番号で検索を再実行する。
          if restartKey;
             iter;
          endif;

          // 新規郵便番号のプロンプトを出す。
          if not recordFound;
             // 郵便番号が検出されている場合は、
             // 再びヘッダーとフッターを書かない。
             write foot1;
             write head;
          endif;

          zipNotFound = not recordFound;
          exfmt prompt;

       enddo;

       *inlr = *on;

      /end-free

       //****************************************************************
       // プロシージャ- ProcessSubfile                                  *
       // 目的- サブファイルを処理し、それを表示する                    *
       //****************************************************************
     P ProcessSubfile  B
     D ProcessSubfile  Pi
      /free

          // ロールアップ・キー以外が押されるまでループする
          dou not rollupKey;

             // サブファイルに追加する情報は他にあるか?
             if not %eof(cusmstl2);
                // サブファイルを消去し、得意先データで充填する
                ClearSubfile();
                FillSubfile();
             endif;

             // サブファイルを書き出し、応答を待つ
             write foot2;
             exfmt subctl;

          enddo;

      /end-free
     P ProcessSubfile  E

       //****************************************************************
       // プロシージャ- FillSubfile                   *
       // 目的- 指定した郵便番号に一致する得意先レコードで       *
       // サブファイルを充填する。                   *
       //****************************************************************
     P FillSubfile     B
     D FillSubfile     Pi
      /free

          // 指定した郵便番号で得意先レコード全体をループする

          recnum = 0;

          dou %eof(szipmenu);
             // 指定した郵便番号で次のレコードを読み取る
             reade zip cmlrec2;

             if %eof(cusmstl2);
                // レコードがなくなったら、以下を行う
                return;
             endif;

             // このレコードの情報をサブファイルに追加する
             recnum = recnum + 1;
             write subfile;

          enddo;

      /end-free
     P FillSubfile     E

       //****************************************************************
       // プロシージャ- ClearSubfile                   *
       // 目的- サブファイル・レコードの消去              *
       //****************************************************************
     P ClearSubfile    B
     D ClearSubfile    Pi
      /free

          sflClear = *on;
          write subctl;
          sflClear = *off;

      /end-free
     P ClearSubfile    E

メイン・ロジック

foot1 という、画面定義の中で下の方に表示される、使用できるキーなどの情報を表示する部分(フッター)の画面への書き出し (write foot1;)、続けて画面上部の表題や時刻の表示部分(ヘッダー)の画面への書き出し (write head;)、そして入力フィールドを含む部分の表示とその入力の待機 (exfmt prompt;)、を行います。

       write foot1;
       write head;
       exfmt prompt;

prompt と head には OVERLAY というキーワードが定義されています。
これは、その前に表示した部分を消去せずに、そのまま上書きで画面に表示させる、という定義になります。

     A          R HEAD
     A                                      OVERLAY
     A          R PROMPT
     A                                      OVERLAY

フッタからヘッダ、入力用のプロンプト、と部分毎に表示させていっているわけですね。必要な部分のみを表示し直すことが可能になっている、ということがわかります。

メインの処理は、「フリー・フォーマット RPG で対話型アプリケーション (顧客マスターメインテナンス)」などと同様に、F3 キーが押されていない (= この Do While の時点で F3 キーが押されるとオンになるフラグがオンになっていない) 限りループする、という構造になっています。

       dow not exitKey;

先ほどの exfmt 命令で prompt レコード様式を表示させ、その結果を読み込みましたが、その中の cstkey フィールドの値を元にテーブルを検索します。
読み込んだ値を元に、ビューにカーソルをセットします。

          setll %kds(cstkey) cmlrec2;

setll 命令の結果、きちんとまったく同じ行に読み込み用のカーソルがセットされたのかどうかのチェックを %equal 機能 (BIF = Build In Function) で行っています。

こういう場合に、おそらくこのシリーズの中で見かけるであろう似た機能 (BIF) に %found というものがありますが、違いは何でしょうか?

%found の場合はまったく同じかそれより大きい値、つまり Greater or Equal という条件が満たされれば TRUE ですが、%equal の場合はご想像どおりまったく同じ場合しか TRUE は返ってきません。

ここで、その前の setll 命令の結果をチェックしているわけですね。今回の場合 zip コードで検索をかけ、その zip コードを持つ顧客情報のみを表示させるという要件なので、まったく同じである必要があるために %equal を採用しているのだと思います。

          recordFound = %equal(cusmstl2);

zip コードで検索対象の顧客が特定できたところで、ProcessSubfile というプロシージャを実行します。

          if recordFound;
             ProcessSubfile();
          endif;

ちなみに setll 命令に使用している cstkey というのは

     D cstkey        E ds                  extname(cusmstl2:*key)

で定義されています。

cusmstl2 ファイル (キー順のビュー) の定義の中の、一番最後の行の K ZIP の部分をキーとして使用する、という定義になっています。

     A          R CMLREC2                   PFILE(CUSTOMER)
     A            ZIP
     A            NAME
     A            ARBAL
     A          K ZIP

画面定義では、以下のように zip フィールドが入力用の画面フィールドとして定義されていますので、この入力が exfmt prompt; の結果返ってきて setll 命令で使用する cstkey の定義である custmstl2 の key である zip カラムの検索用に使用されるようになっている、というわけです。 

     A          R PROMPT
    …
     A            ZIP       R     Y  I  4 19DSPATR(CS)

サブプロシージャの処理

さて ProcessSubfile プロシージャですが、該当するレコードが少なくとも一件以上は見つかったという条件で実行されるプロシージャなので、そのデータを表示するための処理を行います。

サブファイル

サブファイルという、画面表示のためにバッファをファイルとして読み書きできる機能があります。
サブファイルについてはまた別途説明したいと思いますが、今のところ画面表示のパフォーマンスをよくするため、使い勝手をよくするため、コーディングを単純にするための作業用のテーブルと考えてください。SQL でいう TEMPORARY TABLE のようなものですね。

     P ProcessSubfile  B
     D ProcessSubfile  Pi
      /free

          // ロールアップ・キーが押されるまでループする
          dou not rollupKey;

             // サブファイルに追加する情報は他にあるか?
             if not %eof(cusmstl2);
                // サブファイルを消去し、得意先データで充填する
                ClearSubfile();
                FillSubfile();
             endif;

             // サブファイルを書き出し、応答を待つ
             write foot2;
             exfmt subctl;

          enddo;

      /end-free
     P ProcessSubfile  E

rollup キー以外のキー (not rollupKey) が押されるまでループを続けます。

          dou not rollupKey;

rollup キーが押されるたびにループは続きますが、サブファイルがいっぱいになるか、読み込む元のファイルの最後になるかでそれ以上の処理はしないようになっています。

             if not %eof(cusmstl2);

読み込み元のファイルが %eof (End Of File) にならない限り、サブファイルをクリアし、サブファイルにデータを充填する、ということをループの度に行います。

                ClearSubfile();
                FillSubfile();

サブファイルの表示

すでにファイルの最後になっているか、サブファイルが一杯になっているかの状態になりました。
そこで、この画面用の使用できるキーの情報などを書いたフッタと、サブファイルの内容を画面に書き出して、入力を待ちます。

             write foot2;
             exfmt subctl;

サブファイルをクリアする、というのは、サブファイルに入っているデータを消去する、ということです。いったん空にして、書き込みを受け入れられる状態にする、ということですね。

SFLCLR というキーワードが指定されている画面定義がありますので、これを write することで、その動作は行われます。

     A          R SUBCTL                    SFLCTL(SUBFILE)
     A  55                                  SFLCLR

SFLCLR の条件である 55 というフラグをオンにして画面定義を書き出すことで、画面バッファの読み書きのコントロールを行っているわけですね。

     D sflClear                        n   overlay(indicators:55)

          sflClear = *on;
          write subctl;
          sflClear = *off;

サブファイルの制御

サブファイルとは、以下のようにフィールド名を指定しておけばそれを一行としたテーブルとして扱うことのできる画面バッファです。
キーワードに SFL と記述します。

     A          R SUBFILE                   SFL
     A            NAME      R           9  4
     A            ARBAL     R           9 27EDTCDE(J)

↑のサブファイル定義のすぐ後に、その制御を行うための定義があります。
SFL とキーワードを指定したレコード様式 (R で示されている定義名) を指定した SFLCTL キーワードでそれと示されます。

     A          R SUBCTL                    SFLCTL(SUBFILE)
     A                                      SFLSIZ(13)
     A                                      SFLPAG(13)

SFLSIZ というのはトータルで格納できる行数、SFLPAG というのは画面に表示できる行数です。まったく同じですね。ProcessSubfile プロシージャで Rollup キーをキャッチしてそのつどサブファイルのクリアと充填を行うようにしています。

サブファイルの充填処理は FillSubfile プロシージャで行っています。
%eof(szipmenu) というのがつまりサブファイルが一杯になった、ということを示しているわけですね。

サブファイルは相対レコード番号 (Relative Record Number) 順に処理を行うので、recnum というフィールドを使用してカウントし、それをつけてサブファイルに書き込みを行います。

     Fszipmenu  cf   e             workstn sfile(subfile:recnum)


          recnum = 0;

          dou %eof(szipmenu);
             reade zip cmlrec2;

             if %eof(cusmstl2);
                return;
             endif;

             recnum = recnum + 1;
             write subfile;

サブファイルに書き込み終わるか、読み込み元のファイルが読み込み終わるかしたところで ProcessSubfile プロシージャの中のif ブロックの後の処理になりますね。

          dou not rollupKey;

             if not %eof(cusmstl2);
                ClearSubfile();
                FillSubfile();
             endif;

             write foot2;
             exfmt subctl;

          enddo;

ClearSubfile プロシージャの中でフラグ 55 はオフになっていますので、SFLDSPCTL/SFLDSP キーワードが有効な状態になっています。

     A          R SUBCTL                    SFLCTL(SUBFILE)
     A  55                                  SFLCLR
     A N55                                  SFLDSPCTL
     A N55                                  SFLDSP

SFLDSPCTL/SFLDSP キーワードが有効な状態で、サブファイル制御用のレコード様式を write することによって、サブファイルが画面に書き出される、という段取りになっています。

             exfmt subctl;

サブファイルが表示された画面で F3 キーか F4 キーか、それ以外の有効なキー (実行キーですね) が押されると、それぞれの対応して処理が行われます。

F3 キーが押された場合 (exfmt subctl; 命令から exitKey フラグがオンになって返ってきた場合) は、leave 命令を実行します。つまり、この Do ループをその場で抜けます。

          // サブファイル表示でPF03 が押された場合は、ループを終了
          if exitKey;
             leave;
          endif;

F4 キーが押された場合 (exfmt subctl; 命令から restartKey フラグがオンになって返ってきた場合) に実行されるのは iter 命令で、この Do ループの最後に飛ぶことになります。

この Do ループは Do While ループなので一番最初に条件を判断します。 条件は dow not exitKey; ですね。restartKey がオンということは exitKey はオフで、とどのつまり not exitKey ということになりますので、Do ループが再度実行されるということになります。
exfmt 命令は subctl 画面様式を表示しての結果なので、検索キーとなる zip キーは出力専用フィールドなので変更されません。(zip キーを入力として受け取るのは prompt 画面様式の exfmt を経由して、になります)

          // PF04 が押された場合は、
          // 同じ郵便番号で検索を再実行する。
          if restartKey;
             iter;
          endif;
          // 新規郵便番号のプロンプトを出す。
          if not recordFound;
             // 郵便番号が検出されている場合は、
             // 再びヘッダーとフッターを書かない。
             write foot1;
             write head;
          endif;

↑のブロックの前にこの条件と対になる↓のような if ブロックがありますが、この recordFound の条件で実行される ProcessSubfile プロシージャの中の exfmt subctl; からの返り値も範囲に入れて exitKey や restartKey の判別を行いたいためにこうなっているわけですね。

          if recordFound;

zipNotFound フラグは、not recordFound なので recordFound フラグの否定つまり反対がセットされます。
setll 命令が成功し、該当のレコードにきちんとセットされている場合は recordFound は '1' になっています。その場合は '0' がセットされる、ということになります。

          zipNotFound = not recordFound;
          exfmt prompt;

[Top Pageに戻る]

Ads by TOK2