SCHZIP: RPG ソース

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


      // フィールド定義:
     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)

      // キー・リスト定義
     C     cstkey        klist
     C                   kfld                    zip
     //*******************************************************************
     //   メインライン                                                   *
     //*******************************************************************

      /free

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

       // PF03 押されるまでループする
       dow not exitKey;
          setll cstkey cmlrec2;
          recordFound = %equal(cusmstl2);
          if recordFound;
             exsr 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;

       //****************************************************************
       //  サブルーチン - ProcessSubfile                                *
       //  目的     - サブファイルを処理し、それを表示する              *
       //****************************************************************
       begsr ProcessSubfile;

          // ロールアップ・キーが押されるまでループする
          dou not rollupKey;
             // サブファイルに追加する情報は他にあるか ?
             if not %eof(cusmstl2);
                // サブファイルを消去し、得意先データで充てんする
                exsr ClearSubfile;
                exsr FillSubfile;
             endif;

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

       endsr;  // サブルーチン ProcessSubfile の終わり



       //****************************************************************
       //   サブルーチン - FillSubfile                                  *
       //   目的      - 指定した郵便番号に一致する得意先レコードで      *
       //               サブファイルを充てんする。                      *
       //****************************************************************
       begsr FillSubfile;

          // 指定した郵便番号で得意先レコード全体をループする
          recnum = 0;
          dou %eof(szipmenu);
             // 指定した郵便番号で次のレコードを読み取る
             reade zip cmlrec2;
             if %eof(cusmstl2);
                // レコードがなくなったら、以下を行う
                leavesr;
             endif;

             // このレコードの情報をサブファイルに追加する
             recnum = recnum + 1;
             write subfile;
          enddo;
       endsr;  // サブルーチン  FillSubfile の終わり



       //****************************************************************
       //    サブルーチン - ClearSubfile                                *
       //    目的       - サブファイル・レコードの消去                  *
       //****************************************************************
       begsr ClearSubfile;

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

       endsr;  // サブルーチン ClearSubfile の終わり

      /end-free

ファイル仕様書は、検索するディスク・ファイルおよび使用される 表示装置ファイル (SZIPMENU) を指定します。WORKSTN ファイルの SFILE キーワードは、サブファイルとして使用される レコード様式 (SUBFILE) を指定します。指定された相対レコード番号フィールド (RECNUM) は、サブファイル内のどの レコードをアクセスするかを制御します。

プログラムは、PROMPT レコード様式を表示し、ワークステーション・ユーザー の応答を待機します。F3 は、プログラムの終了を制御する標識 03 をオンに設定します。 郵便番号 (ZIP) は、SETLL 命令によって CUSMSTL2 ファイルを位置付けるために使用されます。 SETLL 命令では、ファイル名 CUSMSTL2 ではなく、レコード様式名 CMLREC2 が 使用されることに注意してください。レコードが見付からない場合には、エラー・メッセージが表 示されます。

SFLPRC サブルーチンは、サブファイルの処理 (消去、充てん、および表 示) を扱います。サブファイルは、サブルーチン SFLCLR の中での追加の要求のために準備され ます。標識 55 がオンの場合には、画面上で処置は行われませんが、サブファイル ・レコードの主記憶域は消去されます。SFLFIL ルーチンはサブファイルをレコードで充てんします。レコードは、CUSMSTL2 ファイルから読み取られます。郵便番号が同じである場合には、レコード・カウント (RECNUM) が増え、レコ ードはそのサブファイルに書き出されます。このサブルーチンは、サブファイルがいっぱいになるか (WRITE 命令の標識 21)、または CUSMSTL2 ファイルでファイルの終わりが起こる (READE 命令の標識 71) まで、反復されます。サブファイルがいっぱいになるか、ファイルの終わりが 検出されると、サブファイルが EXFMT 命令によってサブファイル制御レコード様式で、画面に表示 されます。ユーザーは、画面を検討して次のことを決定します。

図 206 では、ユーザーはプロンプトに応答して郵便番号を入力します。

図 206. 'CUSTOMER SEARCH BY ZIP' (郵便番号による得意先検索) プロンプト画面
   22:34:38                CUSTOMER SEARCH BY ZIP                     9/30/94

   Enter Zip Code 11201


















     ENTER - Continue       F3 - End Job

図 207 に示されているようにサブファイルが画面に書き出され ます。

図 207. 'CUSTOMER SEARCH BY ZIP' (郵便番号による得意先検索) 画面
   22:34:45                CUSTOMER SEARCH BY ZIP                     9/30/94

   Zip Code  11201


   Customer Name          A/R Balance

   Rick Coupland                 300.00
   Mikhail Yuri                  150.00
   Karyn Sanders                   5.00











     ENTER - Continue       F3 - End Job      F4 - RESTART ZIP CODE