処理対象ファイル

次のフィールドから成る物理ファイル「TARGET」(売り上げ目標)

フィールド

タイプ

全桁数

説明

YEAR

S

2,0

MONTH

S

2,0

BRAND

A

5

ブランド番号/ID

QUANTITY

P

9,0

売り上げ目標数量

DOLLARS

P

11,2

売り上げ目標金額

RDMLプログラム

     << Define work fields for this function >>
 
DEFINE     FIELD(#ERRCOUNT) TYPE(*DEC) LENGTH(7)
           DECIMALS(0)
 
<< Define group to appear on top of screen >>
 
GROUP_BY   NAME(#TIME)   FIELDS(#YEAR #MONTH)
 
<< Define group that contains all fields to be inserted >>
 
GROUP_BY   NAME(#TARGET) FIELDS(#YEAR #MONTH #BRAND
           #QUANTITY #DOLLARS)
 
<< Define list to be used for data entry >>
 
DEF_LIST   NAME(#VALUES) FIELDS(#BRAND #QUANTITY #DOLLARS)
 
<< Loop until EXIT or MENU function key used >>
 
BEGIN_LOOP
 
<< Clear screen and initialize list with 20 entries >>
 
    CHANGE     FIELD(#TARGET) TO(*NULL)
    SET_MODE   TO(*ADD)
    INZ_LIST   NAMED(#VALUES) NUM_ENTRYS(20)
 
    << Accept input until no errors exist in data >>
 
    DOUNTIL    COND('#ERRCOUNT = 0')
 
    SET_MODE   TO(*ADD)
    DISPLAY    FIELDS(#TIME) BROWSELIST(#VALUES)
 
    << Process all not "null" and not "accepted" records >>
 
    CHANGE     FIELD(#ERRCOUNT) TO(0)
    SELECTLIST NAMED(#VALUES) GET_ENTRYS(*NOTNULL *ADD)
                   INSERT FIELDS(#TARGET) TO_FILE(TARGET)
                         VAL_ERROR(L10)
              L10  IF_STATUS  IS_NOT(*OKAY)
                   CHANGE     FIELD(#ERRCOUNT)
                              TO('#ERRCOUNT + 1')
                   SET_MODE   TO(*ADD)
                   ELSE
                   SET_MODE   TO(*DISPLAY)
                   ENDIF
                   UPD_ENTRY  IN_LIST(#VALUES)
                   ENDIF
              ENDSELECT
 
              ENDUNTIL
 
END_LOOP

着目点:

  • BEGIN_LOOP~END_LOOPのブロック内で、ファンクション・キーEXITまたはMENUが押されるまでの間、レコードの追加処理を繰り返します。

  • DISPLAY画面ではファンクション・キーEXITとMENUが有効になっており、いずれかのキーを押すとファンクションは終了します。

  • #YEARフィールド、#MONTHフィールドの値はファイル中のどのレコードにも必要ですが、ユーザーは画面上部に1回入力するだけで済みます。すなわち、この画面では同じ年月のレコードをいくつかまとめて入力できるわけです。売り上げ目標数量/金額の「値」は、画面下部に現れるリストに、20レコードまでまとめて入力できます。

  • リストを20個のNULLレコードで初期化する前に、画面「モード」を設定している点に注意してください。モードが*ADDとなっているので、リストは入力が可能な形で生成されます。

  • SELECTLIST~ENDSELECTのループでは、(*NOTNULLのパラメータ指定があるので)「空」でなく、かつ、(*ADDパラメータがあるので)「追加」モードの行についてのみ、レコードの追加処理を施しています。すなわち、新たにユーザーが入力し、しかも未登録のデータだけをファイルに追加していることになります。

  • INSERTコマンドのVAL_ERRORパラメータは、検証の結果エラーが見つかった場合、すぐ下のコマンドに制御を渡すことを表します。すなわち、I/Oの「状態」を確認し、エラーが起こっていればエラー回数(#ERRCOUNT)を1増やし、「追加」モードに切り替えます。一方、エラーがなければ「表示」モードにします。

  • エラーの状況に応じてモードを「追加」(*ADD)または「表示」(*DISPLAY)に切り替えた後、リストの各行を更新します。「表示」モードであれば、リストの各欄は入力を受け付けず表示のみの状態になります。データはファイルに登録済みであり、ユーザーは変更できません。一方「追加」モードであれば、エラーの原因となったフィールドは、ユーザーが修正できるよう反転表示になります。

INSERTコマンドでレコードが受理されたか否かを明示するようにしたい場合は、RDMLコマンドを次のように修正してください。

     << Define work fields for this function >>
 
DEFINE     FIELD(#ERRCOUNT) TYPE(*DEC) LENGTH(7) DECIMALS(0)
DEFINE     FIELD(#ACCEPTED) TYPE(*CHAR) LENGTH(3)
           COLHDG('Target' 'has been' 'Accepted')
 
<< Define group to appear on top of screen >>
 
GROUP_BY   NAME(#TIME)   FIELDS(#YEAR #MONTH)
 
<< Define group that contains all fields to be inserted >>
 
GROUP_BY   NAME(#TARGET) FIELDS(#YEAR #MONTH #BRAND
           #QUANTITY #DOLLARS)
 
<< Define list to be used for data entry >>
 
DEF_LIST   NAME(#VALUES) FIELDS(#BRAND #QUANTITY 
           #DOLLARS (#ACCEPTED *OUTPUT))
 
<< Loop until EXIT or MENU function key used >>
 
BEGIN_LOOP
 
<< Clear screen and initialize list with 20 entries >>
 
    CHANGE     FIELD(#TIME)   TO(*NULL)
    CHANGE     FIELD(#VALUES) TO(*NULL)
    SET_MODE   TO(*ADD)
    INZ_LIST   NAMED(#VALUES) NUM_ENTRYS(20)
 
    << Accept input until no errors exist in data >>
 
    DOUNTIL    COND('#ERRCOUNT = 0')
 
    SET_MODE   TO(*ADD)
    DISPLAY    FIELDS(#TIME) BROWSELIST(#VALUES)
 
    << Process all not "null" and not "accepted" records >>
 
    CHANGE     FIELD(#ERRCOUNT) TO(0)
    SELECTLIST NAMED(#VALUES) GET_ENTRYS(*NOTNULL *ADD)
               INSERT FIELDS(#TARGET) TO_FILE(TARGET)
               VAL_ERROR(L10)
            L10  IF_STATUS  IS_NOT(*OKAY)
                CHANGE     FIELD(#ERRCOUNT) TO('#ERRCOUNT + 1')
                SET_MODE   TO(*ADD)
                ELSE
                SET_MODE   TO(*DISPLAY)
                CHANGE     FIELD(#ACCEPTED) TO(YES)
                ENDIF
                UPD_ENTRY  IN_LIST(#VALUES)
                ENDIF
            ENDSELECT
 
            ENDUNTIL
 
END_LOOP
     The main processing loop of the program could be modified to allow updates to "accepted" records like this:
     << Define work fields for this function >>
 
DEFINE     FIELD(#ERRCOUNT) TYPE(*DEC) LENGTH(7) DECIMALS(0)
DEFINE     FIELD(#ADD_RRN)  TYPE(*DEC) LENGTH(15) DECIMALS(0)
DEFINE     FIELD(#ACCEPTED) TYPE(*CHAR) LENGTH(3)
           COLHDG('Target' 'has been' 'Accepted')
 
<< Define group to appear on top of screen >>
 
GROUP_BY   NAME(#TIME)   FIELDS(#YEAR #MONTH)
 
<< Define group that contains all fields to be inserted >>
 
GROUP_BY   NAME(#TARGET) FIELDS(#YEAR #MONTH #BRAND
           #QUANTITY #DOLLARS)
 
<< Define list to be used for data entry >>
 
DEF_LIST   NAME(#VALUES) FIELDS(#BRAND #QUANTITY #DOLLARS
          (#ACCEPTED *OUTPUT)(#ADD_RRN *HIDDEN))
 
<< Loop until EXIT or MENU function key used >>
 
BEGIN_LOOP
 
    << Clear screen and initialize list with 20 entries >>
 
    CHANGE     FIELD(#TIME)   TO(*NULL)
    CHANGE     FIELD(#VALUES) TO(*NULL)
    SET_MODE   TO(*ADD)
    INZ_LIST   NAMED(#VALUES) NUM_ENTRYS(20)
 
    DOUNTIL    COND('#ERRCOUNT = 0')
 
    SET_MODE   TO(*ADD)
    DISPLAY    FIELDS(#TIME) BROWSELIST(#VALUES)
 
    << Process all not "null" records >>
 
     CHANGE     FIELD(#ERRCOUNT) TO(0)
     SELECTLIST NAMED(#VALUES) GET_ENTRYS(*NOTNULL)
 
        IF     COND('#ACCEPTED = YES')
        UPDATE FIELDS(#TARGET) IN_FILE(TARGET) VAL_ERROR(L10)
               WITH_RRN(#ADD_RRN)
        ELSE
        INSERT FIELDS(#TARGET) TO_FILE(TARGET)
               VAL_ERROR(L10) RETURN_RRN(#ADD_RRN)
        ENDIF
 
   L10  IF_STATUS  IS_NOT(*OKAY)
        CHANGE     FIELD(#ERRCOUNT) TO('#ERRCOUNT + 1')
        ELSE
        CHANGE     FIELD(#ACCEPTED) TO(YES)
        ENDIF
 
        SET_MODE   TO(*ADD)
        UPD_ENTRY  IN_LIST(#VALUES)
        ENDIF
   ENDSELECT
 
   ENDUNTIL
 
END_LOOP
  • No labels