支払更新プログラムで READ SUBFILE...NEXT MODIFIED および REWRITE SUBFILE を使用する例

図 152 に示すのは、支払更新プログラムの例 PAYUPDT です。 これに関連する DDS については 図 150 および 図 151 を参照してください。 関連した表示画面の例については 得意先支払い表示画面を参照してください。 得意先マスター・ファイル CUSMSTP の DDS については 図 132 を参照してください。

この例では、得意先からの支払いが登録されます。 オペレーターに対して、1 つまたは複数の得意先番号を入力して、各得意先の口座に入れる金額を入力するようにプロンプトが出されます。 プログラムは得意先番号を調べて、送り状が未処理になっている既存の得意先の支払いであれば、無条件に受け入れます。 得意先からの支払額によって過剰支払いが起きた場合、オペレーターはその支払いを受け取るか受け取らないかを選択できます。 得意先番号に対する得意先レコードが存在していない場合は、エラー・メッセージが出されます。 オペレーターが F12 を押してプログラムを終了するまで、支払いの入力を続けることができます。

図 150. 支払更新プログラムのデータ記述仕様の例 - 論理注文ファイル
  ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....
      A** THIS IS THE ORDER HEADER LOGICAL FILE ** ORDHDRL
      A
      A
      A                                      UNIQUE
      A          R ORDHDR                    PFILE(ORDHDRP)
      A*
      A            CUST
      A            INVNUM
      A            ORDERN
      A            ORDDAT
      A            CUSORD
      A            SHPVIA
      A            ORDSTS
      A            OPRNAM
      A            ORDAMT
      A            CUSTYP
      A            PRTDAT
      A            OPNSTS
      A            TOTLIN
      A            ACTMTH
      A            ACTYR
      A            STATE
      A            AMPAID
      A          K CUST
      A          K INVNUM
図 151. 支払更新プログラムのデータ記述仕様の例 - ディスプレイ装置ファイル
  ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....
      A* THIS IS THE DISPLAY DEVICE FILE FOR PAYUPDT ** PAYUPDTD
      A* ACCOUNTS RECEIVABLE INTERACTIVE PAYMENT UPDATE
      A*
      A
      A          R SUBFILE1                  SFL
      A                                      TEXT('SUBFILE FOR CUSTOMER PAYMENT'
      A*
      A            ACPPMT         4A  I  5  4TEXT('ACCEPT PAYMENT')
      A                                      VALUES('*YES' '*NO')
      A  51                                  DSPATR(RI MDT)
      A N51                                  DSPATR(ND PR)
      A*
      A            CUST           5   B  5 15TEXT('CUSTOMER NUMBER')
      A  52                                  DSPATR(RI)
      A  53                                  DSPATR(ND)
      A  54                                  DSPATR(PR)
      A*
      A            AMPAID         8 02B  5 24TEXT('AMOUNT PAID')
      A                                      CHECK(FE)
      A                                      AUTO(RAB)
      A                                      CMP(GT 0)
      A  52                                  DSPATR(RI)
      A  53                                  DSPATR(ND)
      A  54                                  DSPATR(PR)
      A*
      A            ECPMSG        31A  O  5 37TEXT('EXCEPTION MESSAGE')
      A  52                                  DSPATR(RI)
      A  53                                  DSPATR(ND)
      A  54                                  DSPATR(BL)
      A*
      A            OVRPMT         8Y 2O  5 70TEXT('OVERPAYMENT')
      A                                      EDTCDE(1)
      A  55                                  DSPATR(BL)
      A N56                                  DSPATR(ND)
      A*
      A            STSCDE         1A  H      TEXT('STATUS CODE')
      A          R CONTROL1                  TEXT('SUBFILE CONTROL')
      A                                      SFLCTL(SUBFILE1)
      A                                      SFLSIZ(17)
      A                                      SFLPAG(17)
      A  61                                  SFLCLR
      A  62                                  SFLDSP
      A  62                                  SFLDSPCTL
      A                                      OVERLAY
      A                                      LOCK
      A*
      A                                      HELP(99 'HELP KEY')
      A                                            CA12(98 'END PAYMENT UPDATE')
      A                                      CA11(97 'IGNORE INPUT')
      A*
      A  99                                  SFLMSG(' F11 - IGNORE INVALID INPUT+
      A                                                      F12 - END PAYMENT +
      A                                      UPDATE')
      A*
      A                                  1  2'CUSTOMER PAYMENT UPDATE PROMPT'
      A                                  1 65'DATE'
      A                                  1 71DATE EDTCDE(Y)
      A  63                              3  2'ACCEPT'
      A  63                              4  2'PAYMENT'
      A                                  3 14'CUSTOMER'
      A                                  3 26'PAYMENT'
      A  64                              3 37'EXCEPTION MESSAGE'
      A*
      A          R MESSAGE1                  TEXT('MESSAGE RECORD')
      A                                      OVERLAY
      A                                      LOCK
      A*
      A  71                             24  2' ACCEPT PAYMENT VALUES: (*NO *YES)
                                             DSPATR(RI)
図 152. 支払更新プログラム例のソース・リスト
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    2
                                     ソ ー ス
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
           000100 PROCESS APOST
     1     000200 IDENTIFICATION DIVISION.
     2     000300 PROGRAM-ID.  PAYUPDT.
           000400
     3     000500 ENVIRONMENT DIVISION.
     4     000600   CONFIGURATION SECTION.
     5     000700 SOURCE-COMPUTER. IBM-ISERIES
     6     000800 OBJECT-COMPUTER. IBM-ISERIES
     7     000900   INPUT-OUTPUT SECTION.
     8     001000   FILE-CONTROL.
     9     001100     SELECT CUSTOMER-INVOICE-FILE
    10     001200         ASSIGN TO DATABASE-ORDHDRL
    11     001300         ORGANIZATION IS INDEXED
    12     001400         ACCESS MODE IS SEQUENTIAL
    13     001500         RECORD KEY IS COMP-KEY
    14     001600         FILE STATUS IS STATUS-CODE-ONE.
    15     001700     SELECT CUSTOMER-MASTER-FILE
    16     001800         ASSIGN TO DATABASE-CUSMSTP
    17     001900         ORGANIZATION IS INDEXED
    18     002000         ACCESS IS RANDOM
    19     002100         RECORD KEY IS CUST OF CUSTOMER-MASTER-RECORD.
    20     002200     SELECT PAYMENT-UPDATE-DISPLAY-FILE
    21     002300         ASSIGN TO WORKSTATION-PAYUPDTD
    22     002400         ORGANIZATION IS TRANSACTION
    23     002500         ACCESS IS DYNAMIC
    24     002600         RELATIVE KEY IS REL-NUMBER
    25     002700         FILE STATUS IS STATUS-CODE-ONE
    26     002800         CONTROL-AREA IS WS-CONTROL.
           002900
    27     003000 DATA DIVISION.
    28     003100 FILE SECTION.
    29     003200 FD  CUSTOMER-INVOICE-FILE.
    30     003300 01  CUSTOMER-INVOICE-RECORD.
           003400     COPY DDS-ORDHDR OF ORDHDRL.
          +000001*    I-O FORMAT:ORDHDR     FROM FILE ORDHDRL    OF LIBRARY CBLGUIDE           ORDHDR
          +000002*                                                                             ORDHDR
          +000003*          USER SUPPLIED KEY BY RECORD KEY CLAUSE                             ORDHDR
    31    +000004       05  ORDHDR.                                                            ORDHDR
    32    +000005           06 CUST                  PIC X(5).                                 ORDHDR
          +000006*                  CUSTOMER NUMBER                                            ORDHDR
    33    +000007           06 INVNUM                PIC S9(5)         COMP-3.                 ORDHDR
          +000008*                  INVOICE NUMBER                                             ORDHDR
    34    +000009           06 ORDERN                PIC S9(5)         COMP-3.                 ORDHDR
          +000010*                  ORDER NUMBER                                               ORDHDR
    35    +000011           06 ORDDAT                PIC S9(6)         COMP-3.                 ORDHDR
          +000012*                  DATE ORDER ENTERED                                         ORDHDR
    36    +000013           06 CUSORD                PIC X(15).                                ORDHDR
          +000014*                  CUSTOMER PURCHASE ORDER NUMBER                             ORDHDR
    37    +000015           06 SHPVIA                PIC X(15).                                ORDHDR
          +000016*                  SHIPPING INSTRUCTIONS                                      ORDHDR
    38    +000017           06 ORDSTS                PIC S9(1)         COMP-3.                 ORDHDR
          +000018*                  ORDER SATAUS 1PCS 2CNT  3CHK 4RDY 5PRT 6PCK                ORDHDR
    39    +000019           06 OPRNAM                PIC X(10).                                ORDHDR
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    3
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
          +000020*                  OPERATOR WHO ENTERED ORD                                   ORDHDR
    40    +000021           06 ORDAMT                PIC S9(6)V9(2)    COMP-3.                 ORDHDR
          +000022*                  DOLLAR AMOUNT OF ORDER                                     ORDHDR
    41    +000023           06 CUSTYP                PIC S9(1)         COMP-3.                 ORDHDR
          +000024*                  CUSTOMER TYPE 1=GOV 2=SCH 3=BUS 4=PVT 5=OT                 ORDHDR
    42    +000025           06 PRTDAT                PIC S9(6)         COMP-3.                 ORDHDR
          +000026*                  DATE ORDER WAS PRINTED                                     ORDHDR
    43    +000027           06 OPNSTS                PIC S9(1)         COMP-3.                 ORDHDR
          +000028*                  ORDER OPEN STATUS 1=OPEN 2= CLOSE 3=CANCEL                 ORDHDR
    44    +000029           06 TOTLIN                PIC S9(3)         COMP-3.                 ORDHDR
          +000030*                  TOTAL LINE ITEMS IN ORDER                                  ORDHDR
    45    +000031           06 ACTMTH                PIC S9(2)         COMP-3.                 ORDHDR
          +000032*                  ACCOUNTING MONTH OF SALE                                   ORDHDR
    46    +000033           06 ACTYR                 PIC S9(2)         COMP-3.                 ORDHDR
          +000034*                  ACCOUNTING YEAR OF SALE                                    ORDHDR
    47    +000035           06 STATE                 PIC X(2).                                 ORDHDR
          +000036*                  STATE                                                      ORDHDR
    48    +000037           06 AMPAID                PIC S9(6)V9(2)    COMP-3.                 ORDHDR
          +000038*                  AMOUNT PAID                                                ORDHDR
    49     003500 66  COMP-KEY RENAMES CUST THRU INVNUM.
           003600
    50     003700 FD  CUSTOMER-MASTER-FILE.
    51     003800 01  CUSTOMER-MASTER-RECORD.
           003900     COPY DDS-CUSMST OF CUSMSTP.
          +000001*    I-O FORMAT:CUSMST     FROM FILE CUSMSTP    OF LIBRARY CBLGUIDE           CUSMST
          +000002*                          CUSTOMER MASTER RECORD                             CUSMST
          +000003*          USER SUPPLIED KEY BY RECORD KEY CLAUSE                             CUSMST
    52    +000004       05  CUSMST.                                                            CUSMST
    53    +000005           06 CUST                  PIC X(5).                                 CUSMST
          +000006*                  CUSTOMER NUMBER                                            CUSMST
    54    +000007           06 NAME                  PIC X(25).                                CUSMST
          +000008*                  CUSTOMER NAME                                              CUSMST
    55    +000009           06 ADDR                  PIC X(20).                                CUSMST
          +000010*                  CUSTOMER ADDRESS                                           CUSMST
    56    +000011           06 CITY                  PIC X(20).                                CUSMST
          +000012*                  CUSTOMER CITY                                              CUSMST
    57    +000013           06 STATE                 PIC X(2).                                 CUSMST
          +000014*                  STATE                                                      CUSMST
    58    +000015           06 ZIP                   PIC S9(5)         COMP-3.                 CUSMST
          +000016*                  ZIP CODE                                                   CUSMST
    59    +000017           06 SRHCOD                PIC X(6).                                 CUSMST
          +000018*                  CUSTOMER NUMBER SEARCH CODE                                CUSMST
    60    +000019           06 CUSTYP                PIC S9(1)         COMP-3.                 CUSMST
          +000020*                  CUSTOMER TYPE 1=GOV 2=SCH 3=BUS 4=PVT 5=OT                 CUSMST
    61    +000021           06 ARBAL                 PIC S9(6)V9(2)    COMP-3.                 CUSMST
          +000022*                  ACCOUNTS REC. BALANCE                                      CUSMST
    62    +000023           06 ORDBAL                PIC S9(6)V9(2)    COMP-3.                 CUSMST
          +000024*                  A/R AMT. IN ORDER FILE                                     CUSMST
    63    +000025           06 LSTAMT                PIC S9(6)V9(2)    COMP-3.                 CUSMST
          +000026*                  LAST AMT. PAID IN A/R                                      CUSMST
    64    +000027           06 LSTDAT                PIC S9(6)         COMP-3.                 CUSMST
          +000028*                  LAST DATE PAID IN A/R                                      CUSMST
    65    +000029           06 CRDLMT                PIC S9(6)V9(2)    COMP-3.                 CUSMST
          +000030*                  CUSTOMER CREDIT LIMIT                                      CUSMST
    66    +000031           06 SLSYR                 PIC S9(8)V9(2)    COMP-3.                 CUSMST
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    4
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
          +000032*                  CUSTOMER SALES THIS YEAR                                   CUSMST
    67    +000033           06 SLSLYR                PIC S9(8)V9(2)    COMP-3.                 CUSMST
          +000034*                  CUSTOMER SALES LAST YEAR                                   CUSMST
           004000
    68     004100 FD  PAYMENT-UPDATE-DISPLAY-FILE.
    69     004200 01  PAYMENT-UPDATE-DISPLAY-RECORD.
           004300     COPY DDS-ALL-FORMATS OF PAYUPDTD.
    70    +000001       05  PAYUPDTD-RECORD PIC X(59).                                         <-ALL-FMTS
          +000002*  INPUT FORMAT:SUBFILE1   FROM FILE PAYUPDTD   OF LIBRARY CBLGUIDE           <-ALL-FMTS
          +000003*                          SUBFILE FOR CUSTOMER PAYMENT                       <-ALL-FMTS
    71    +000004       05  SUBFILE1-I    REDEFINES PAYUPDTD-RECORD.                           <-ALL-FMTS
    72    +000005           06 ACPPMT                PIC X(4).                                 <-ALL-FMTS
          +000006*                  ACCEPT PAYMENT                                             <-ALL-FMTS
    73    +000007           06 CUST                  PIC X(5).                                 <-ALL-FMTS
          +000008*                  CUSTOMER NUMBER                                            <-ALL-FMTS
    74    +000009           06 AMPAID                PIC S9(6)V9(2).                           <-ALL-FMTS
          +000010*                  AMOUNT PAID                                                <-ALL-FMTS
    75    +000011           06 ECPMSG                PIC X(31).                                <-ALL-FMTS
          +000012*                  EXCEPTION MESSAGE                                          <-ALL-FMTS
    76    +000013           06 OVRPMT                PIC S9(6)V9(2).                           <-ALL-FMTS
          +000014*                  OVERPAYMENT                                                <-ALL-FMTS
    77    +000015           06 STSCDE                PIC X(1).                                 <-ALL-FMTS
          +000016*                  STATUS CODE                                                <-ALL-FMTS
          +000017* OUTPUT FORMAT:SUBFILE1   FROM FILE PAYUPDTD   OF LIBRARY CBLGUIDE           <-ALL-FMTS
          +000018*                          SUBFILE FOR CUSTOMER PAYMENT                       <-ALL-FMTS
    78    +000019       05  SUBFILE1-O    REDEFINES PAYUPDTD-RECORD.                           <-ALL-FMTS
    79    +000020           06 SUBFILE1-O-INDIC.                                               <-ALL-FMTS
    80    +000021                07 IN51             PIC 1  INDIC 51.                          <-ALL-FMTS
    81    +000022                07 IN52             PIC 1  INDIC 52.                          <-ALL-FMTS
    82    +000023                07 IN53             PIC 1  INDIC 53.                          <-ALL-FMTS
    83    +000024                07 IN54             PIC 1  INDIC 54.                          <-ALL-FMTS
    84    +000025                07 IN55             PIC 1  INDIC 55.                          <-ALL-FMTS
    85    +000026                07 IN56             PIC 1  INDIC 56.                          <-ALL-FMTS
    86    +000027           06 CUST                  PIC X(5).                                 <-ALL-FMTS
          +000028*                  CUSTOMER NUMBER                                            <-ALL-FMTS
    87    +000029           06 AMPAID                PIC S9(6)V9(2).                           <-ALL-FMTS
          +000030*                  AMOUNT PAID                                                <-ALL-FMTS
    88    +000031           06 ECPMSG                PIC X(31).                                <-ALL-FMTS
          +000032*                  EXCEPTION MESSAGE                                          <-ALL-FMTS
    89    +000033           06 OVRPMT                PIC S9(6)V9(2).                           <-ALL-FMTS
          +000034*                  OVERPAYMENT                                                <-ALL-FMTS
    90    +000035           06 STSCDE                PIC X(1).                                 <-ALL-FMTS
          +000036*                  STATUS CODE                                                <-ALL-FMTS
          +000037*  INPUT FORMAT:CONTROL1   FROM FILE PAYUPDTD   OF LIBRARY CBLGUIDE           <-ALL-FMTS
          +000038*                          SUBFILE CONTROL                                    <-ALL-FMTS
    91    +000039       05  CONTROL1-I    REDEFINES PAYUPDTD-RECORD.                           <-ALL-FMTS
    92    +000040           06 CONTROL1-I-INDIC.                                               <-ALL-FMTS
    93    +000041                07 IN99             PIC 1  INDIC 99.                          <-ALL-FMTS
          +000042*                          HELP KEY                                           <-ALL-FMTS
    94    +000043                07 IN98             PIC 1  INDIC 98.                          <-ALL-FMTS
          +000044*                          END PAYMENT UPDATE                                 <-ALL-FMTS
    95    +000045                07 IN97             PIC 1  INDIC 97.                          <-ALL-FMTS
          +000046*                          IGNORE INPUT                                       <-ALL-FMTS
          +000047* OUTPUT FORMAT:CONTROL1   FROM FILE PAYUPDTD   OF LIBRARY CBLGUIDE           <-ALL-FMTS
          +000048*                          SUBFILE CONTROL                                    <-ALL-FMTS
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    5
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
    96    +000049       05  CONTROL1-O    REDEFINES PAYUPDTD-RECORD.                           <-ALL-FMTS
    97    +000050           06 CONTROL1-O-INDIC.                                               <-ALL-FMTS
    98    +000051                07 IN61             PIC 1  INDIC 61.                          <-ALL-FMTS
    99    +000052                07 IN62             PIC 1  INDIC 62.                          <-ALL-FMTS
   100    +000053                07 IN99             PIC 1  INDIC 99.                          <-ALL-FMTS
          +000054*                          HELP KEY                                           <-ALL-FMTS
   101    +000055                07 IN63             PIC 1  INDIC 63.                          <-ALL-FMTS
   102    +000056                07 IN64             PIC 1  INDIC 64.                          <-ALL-FMTS
          +000057*  INPUT FORMAT:MESSAGE1   FROM FILE PAYUPDTD   OF LIBRARY CBLGUIDE           <-ALL-FMTS
          +000058*                          MESSAGE RECORD                                     <-ALL-FMTS
          +000059*      05  MESSAGE1-I    REDEFINES PAYUPDTD-RECORD.                           <-ALL-FMTS
          +000060* OUTPUT FORMAT:MESSAGE1   FROM FILE PAYUPDTD   OF LIBRARY CBLGUIDE           <-ALL-FMTS
          +000061*                          MESSAGE RECORD                                     <-ALL-FMTS
   103    +000062       05  MESSAGE1-O    REDEFINES PAYUPDTD-RECORD.                           <-ALL-FMTS
   104    +000063           06 MESSAGE1-O-INDIC.                                               <-ALL-FMTS
   105    +000064                07 IN71             PIC 1  INDIC 71.                          <-ALL-FMTS
           004400
   106     004500 WORKING-STORAGE SECTION.
           004600
   107     004700 01  REL-NUMBER                    PIC 9(05)
           004800                                     VALUE ZEROS.
           004900
   108     005000 01  WS-CONTROL.
   109     005100    05  WS-IND                     PIC X(02).
   110     005200    05  WS-FORMAT                  PIC X(10).
   111     005300 01  SYSTEM-DATE.
   112     005400    05  SYSTEM-YEAR                PIC 99.
   113     005500    05  SYSTEM-MONTH               PIC 99.
   114     005600    05  SYSTEM-DAY                 PIC 99.
   115     005700 01  PROGRAM-DATE.
   116     005800    05  PROGRAM-MONTH              PIC 99.
   117     005900    05  PROGRAM-DAY                PIC 99.
   118     006000    05  PROGRAM-YEAR               PIC 99.
   119     006100 01  FILE-DATE REDEFINES PROGRAM-DATE
           006200                                   PIC S9(6).
   120     006300 01  EXCEPTION-STATUS.
   121     006400    05  STATUS-CODE-ONE            PIC XX.
   122     006500        88  SUBFILE-IS-FULL        VALUE '0M'.
   123     006600 01  EXCEPTION-MESSAGES.
   124     006700    05  MESSAGE-ONE                PIC X(31)
           006800        VALUE 'CUSTOMER DOES NOT EXIST        '.
   125     006900    05  MESSAGE-TWO                PIC X(31)
           007000        VALUE 'NO INVOICES EXIST FOR CUSTOMER '.
   126     007100    05  MESSAGE-THREE              PIC X(31)
           007200        VALUE 'CUSTOMER HAS AN OVER PAYMENT OF'.
   127     007300 01  PROGRAM-VARIABLES.
   128     007400    05  AMOUNT-OWED                PIC S9(6)V99.
   129     007500    05  AMOUNT-PAID                PIC S9(6)V99.
   130     007600    05  INVOICE-BALANCE            PIC S9(6)V99.
   131     007700 01  ERRPGM-PARAMETERS.
   132     007800    05  DISPLAY-PARAMETER          PIC X(8)
           007900                                     VALUE 'PAYUPDTD'.
   133     008000    05  DUMMY-ONE                  PIC X(6)
           008100                                     VALUE SPACES.
   134     008200    05  DUMMY-TWO                  PIC X(6)
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    6
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
           008300                                     VALUE SPACES.
   135     008400    05  STATUS-CODE-TWO.
   136     008500       10  PRIMARY                 PIC X(1).
   137     008600       10  SECONDARY               PIC X(1).
   138     008700       10  FILLER                  PIC X(5)
           008800                                     VALUE SPACES.
   139     008900    05  DUMMY-THREE                PIC X(10)
           009000                                     VALUE SPACES.
           009100
   140     009200 01  SWITCH-AREA.
   141     009300    05  SW01                       PIC 1.
   142     009400       88  WRITE-DISPLAY                 VALUE B'1'.
   143     009500       88  READ-DISPLAY                  VALUE B'0'.
   144     009600    05  SW02                       PIC 1.
   145     009700       88  SUBFILE1-FORMAT               VALUE B'1'.
   146     009800       88  NOT-SUBFILE1-FORMAT           VALUE B'0'.
   147     009900    05  SW03                       PIC 1.
   148     010000       88  CONTROL1-FORMAT               VALUE B'1'.
   149     010100       88  NOT-CONTROL1-FORMAT           VALUE B'0'.
   150     010200    05  SW04                       PIC 1.
   151     010300       88  NO-MORE-TRANSACTIONS-EXIST    VALUE B'1'.
   152     010400       88  TRANSACTIONS-EXIST            VALUE B'0'.
   153     010500    05  SW05                       PIC 1.
   154     010600       88  CUSTOMER-NOT-FOUND            VALUE B'1'.
   155     010700       88  CUSTOMER-EXIST                VALUE B'0'.
   156     010800    05  SW06                       PIC 1.
   157     010900       88  NO-MORE-INVOICES-EXIST        VALUE B'1'.
   158     011000       88  CUSTOMER-INVOICE-EXIST        VALUE B'0'.
   159     011100    05  SW07                       PIC 1.
   160     011200       88  NO-MORE-PAYMENT-EXIST         VALUE B'1'.
   161     011300       88  PAYMENT-EXIST                 VALUE B'0'.
   162     011400    05  SW08                       PIC 1.
   163     011500       88  INPUT-ERRORS-EXIST            VALUE B'1'.
   164     011600       88  NO-INPUT-ERRORS-EXIST         VALUE B'0'.
   165     011700    05  SW09                       PIC 1.
   166     011800       88  OVER-PAYMENT-DISPLAYED-ONCE   VALUE B'1'.
   167     011900       88  OVER-PAYMENT-NOT-DISPLAYED    VALUE B'0'.
           012000
   168     012100 01  INDICATOR-AREA.
   169     012200    05  IN99                       PIC 1 INDIC 99.
   170     012300       88 HELP-IS-NEEDED                 VALUE B'1'.
   171     012400       88 HELP-IS-NOT-NEEDED             VALUE B'0'.
   172     012500    05  IN98                       PIC 1 INDIC 98.
   173     012600       88 END-OF-PAYMENT-UPDATE          VALUE B'1'.
   174     012700    05  IN97                       PIC 1 INDIC 97.
   175     012800       88 IGNORE-INPUT                   VALUE B'1'.
   176     012900    05  IN51                       PIC 1 INDIC 51.
   177     013000       88 DISPLAY-ACCEPT-PAYMENT         VALUE B'1'.
   178     013100       88 DO-NOT-DISPLAY-ACCEPT-PAYMENT  VALUE B'0'.
   179     013200    05  IN52                       PIC 1 INDIC 52.
   180     013300       88 REVERSE-FIELD-IMAGE            VALUE B'1'.
   181     013400       88 DO-NOT-REVERSE-FIELD-IMAGE     VALUE B'0'.
   182     013500    05  IN53                       PIC 1 INDIC 53.
   183     013600       88 DO-NOT-DISPLAY-FIELD           VALUE B'1'.
   184     013700       88 DISPLAY-FIELD                  VALUE B'0'.
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    7
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
   185     013800    05  IN54                       PIC 1 INDIC 54.
   186     013900       88 PROTECT-INPUT-FIELD            VALUE B'1'.
   187     014000       88 DO-NOT-PROTECT-INPUT-FIELD     VALUE B'0'.
   188     014100    05  IN55                       PIC 1 INDIC 55.
   189     014200       88 MAKE-FIELD-BLINK               VALUE B'1'.
   190     014300       88 DO-NOT-MAKE-FIELD-BLINK        VALUE B'0'.
   191     014400    05  IN56                       PIC 1 INDIC 56.
   192     014500       88 DISPLAY-OVER-PAYMENT           VALUE B'1'.
   193     014600       88 DO-NOT-DISPLAY-OVER-PAYMENT    VALUE B'0'.
   194     014700    05  IN61                       PIC 1 INDIC 61.
   195     014800       88 CLEAR-SUBFILE                  VALUE B'1'.
   196     014900       88 DO-NOT-CLEAR-SUBFILE           VALUE B'0'.
   197     015000    05  IN62                       PIC 1 INDIC 62.
   198     015100       88 DISPLAY-SCREEN                 VALUE B'1'.
   199     015200       88 DO-NOT-DISPLAY-SCREEN          VALUE B'0'.
   200     015300    05  IN63                       PIC 1 INDIC 63.
   201     015400       88 DISPLAY-ACCEPT-HEADING         VALUE B'1'.
   202     015500       88 DO-NOT-DISPLAY-ACCEPT-HEADING  VALUE B'0'.
   203     015600    05  IN64                       PIC 1 INDIC 64.
   204     015700       88 DISPLAY-EXCEPTION              VALUE B'1'.
   205     015800       88 DO-NOT-DISPLAY-EXCEPTION       VALUE B'0'.
   206     015900    05  IN71                       PIC 1 INDIC 71.
   207     016000       88 DISPLAY-ACCEPT-MESSAGE         VALUE B'1'.
   208     016100       88 DO-NOT-DISPLAY-ACCEPT-MESSAGE  VALUE B'0'.
           016200
   209     016300 PROCEDURE DIVISION.
           016400
   210     016500 DECLARATIVES.
           016600
           016700 TRANSACTION-ERROR SECTION.
           016800     USE AFTER STANDARD ERROR PROCEDURE
           016900         PAYMENT-UPDATE-DISPLAY-FILE.
           017000 WORK-STATION-ERROR-HANDLER.
   211     017100     IF NOT (SUBFILE-IS-FULL) THEN
   212     017200       DISPLAY 'ERROR IN PAYMENT-UPDATE' STATUS-CODE-ONE
           017300     END-IF.
           017400 END DECLARATIVES.
           017500
           017600 MAIN-PROGRAM SECTION.
           017700 MAINLINE.
   213     017800     OPEN I-O      CUSTOMER-INVOICE-FILE
           017900                   CUSTOMER-MASTER-FILE
           018000                   PAYMENT-UPDATE-DISPLAY-FILE.
           018100
   214     018200     MOVE ALL B'0' TO INDICATOR-AREA
           018300                    SWITCH-AREA.
   215     018400     ACCEPT SYSTEM-DATE FROM DATE
           018500     END-ACCEPT.
   216     018600     MOVE SYSTEM-YEAR  TO PROGRAM-YEAR.
   217     018700     MOVE SYSTEM-MONTH TO PROGRAM-MONTH.
   218     018800     MOVE SYSTEM-DATE  TO PROGRAM-DAY.
   219     018900     SET WRITE-DISPLAY
           019000         CONTROL1-FORMAT
           019100         DO-NOT-DISPLAY-OVER-PAYMENT
           019200         DO-NOT-PROTECT-INPUT-FIELD
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    8
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
           019300         DO-NOT-REVERSE-FIELD-IMAGE
           019400         DO-NOT-MAKE-FIELD-BLINK
           019500         CLEAR-SUBFILE TO TRUE.
   220     019600     MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC.
                 *** CORRESPONDING items for statement 220:
                 ***     IN99
                 ***     IN61
                 ***     IN62
                 ***     IN63
                 ***     IN64
                 *** End of CORRESPONDING items for statement 220
   221     019700     WRITE PAYMENT-UPDATE-DISPLAY-RECORD
           019800         FORMAT IS 'CONTROL1'
           019900     END-WRITE.
   222     020000     SET DO-NOT-CLEAR-SUBFILE TO TRUE.
   223     020100     PERFORM INITIALIZE-SUBFILE-RECORD 17 TIMES.
   224     020200     SET DISPLAY-SCREEN TO TRUE.
   225     020300     MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC.
                 *** CORRESPONDING items for statement 225:
                 ***     IN99
                 ***     IN61
                 ***     IN62
                 ***     IN63
                 ***     IN64
                 *** End of CORRESPONDING items for statement 225
   226     020400     WRITE PAYMENT-UPDATE-DISPLAY-RECORD
           020500         FORMAT IS 'CONTROL1'
           020600     END-WRITE.
   227     020700     READ PAYMENT-UPDATE-DISPLAY-FILE RECORD
           020800         FORMAT IS 'CONTROL1'
           020900     END-READ.
   228     021000     MOVE CORR CONTROL1-I-INDIC TO INDICATOR-AREA.
                 *** CORRESPONDING items for statement 228:
                 ***     IN99
                 ***     IN98
                 ***     IN97
                 *** End of CORRESPONDING items for statement 228
           021100
   229     021200     PERFORM PROCESS-TRANSACTION-FILE
           021300       UNTIL END-OF-PAYMENT-UPDATE.
           021400
   230     021500     CLOSE CUSTOMER-INVOICE-FILE
           021600           CUSTOMER-MASTER-FILE
           021700           PAYMENT-UPDATE-DISPLAY-FILE.
   231     021800     STOP RUN.
           021900
           022000 PROCESS-TRANSACTION-FILE.
   232     022100     IF HELP-IS-NOT-NEEDED THEN
   233     022200        IF  IGNORE-INPUT THEN
   234     022300            SET WRITE-DISPLAY
           022400                CONTROL1-FORMAT
           022500                CLEAR-SUBFILE
           022600                DISPLAY-FIELD
           022700                DO-NOT-DISPLAY-OVER-PAYMENT
           022800                DO-NOT-PROTECT-INPUT-FIELD
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ    9
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
           022900                DO-NOT-REVERSE-FIELD-IMAGE
           023000                DO-NOT-DISPLAY-ACCEPT-PAYMENT
           023100                DO-NOT-DISPLAY-ACCEPT-HEADING
           023200                DO-NOT-DISPLAY-ACCEPT-MESSAGE
           023300                DO-NOT-MAKE-FIELD-BLINK TO TRUE
   235     023400            MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC
                 *** CORRESPONDING items for statement 235:
                 ***     IN99
                 ***     IN61
                 ***     IN62
                 ***     IN63
                 ***     IN64
                 *** End of CORRESPONDING items for statement 235
   236     023500            WRITE PAYMENT-UPDATE-DISPLAY-RECORD
           023600                FORMAT IS 'CONTROL1'
           023700            END-WRITE
   237     023800            SET DO-NOT-CLEAR-SUBFILE TO TRUE
   238     023900            MOVE 0 TO REL-NUMBER
   239     024000            PERFORM INITIALIZE-SUBFILE-RECORD 17 TIMES
           024100         ELSE
   240     024200            SET TRANSACTIONS-EXIST
           024300                DO-NOT-DISPLAY-ACCEPT-HEADING
           024400                DO-NOT-DISPLAY-ACCEPT-MESSAGE
           024500                DO-NOT-DISPLAY-EXCEPTION TO TRUE
   241     024600            PERFORM READ-MODIFIED-SUBFILE-RECORD
   242     024700            PERFORM TRANSACTION-VALIDATION
           024800                UNTIL NO-MORE-TRANSACTIONS-EXIST
   243     024900            SET NO-INPUT-ERRORS-EXIST TO TRUE
   244     025000            PERFORM TEST-FOR-RECORD-INPUT-ERRORS
           025100                VARYING REL-NUMBER
           025200                FROM    1
           025300                BY      1
           025400                UNTIL   REL-NUMBER IS GREATER THAN 17
           025500                OR      INPUT-ERRORS-EXIST
   245     025600            IF  NO-INPUT-ERRORS-EXIST THEN
   246     025700                IF  OVER-PAYMENT-DISPLAYED-ONCE THEN
   247     025800                    SET WRITE-DISPLAY
           025900                        CONTROL1-FORMAT
           026000                        DO-NOT-DISPLAY-OVER-PAYMENT
           026100                        DO-NOT-PROTECT-INPUT-FIELD
           026200                        DO-NOT-REVERSE-FIELD-IMAGE
           026300                        DO-NOT-MAKE-FIELD-BLINK
           026400                        DO-NOT-DISPLAY-ACCEPT-PAYMENT
           026500                        DO-NOT-DISPLAY-ACCEPT-HEADING
           026600                        DO-NOT-DISPLAY-ACCEPT-MESSAGE
           026700                        DO-NOT-DISPLAY-EXCEPTION
           026800                        CLEAR-SUBFILE
           026900                        DISPLAY-FIELD
           027000                          TO TRUE
   248     027100                    MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC
                 *** CORRESPONDING items for statement 248:
                 ***     IN99
                 ***     IN61
                 ***     IN62
                 ***     IN63
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL AS400 用        CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ   10
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
                 ***     IN64
                 *** End of CORRESPONDING items for statement 248
   249     027200                    WRITE PAYMENT-UPDATE-DISPLAY-RECORD
           027300                        FORMAT IS 'CONTROL1'
           027400                    END-WRITE
   250     027500                    SET DO-NOT-CLEAR-SUBFILE TO TRUE
   251     027600                    MOVE 0 TO REL-NUMBER
   252     027700                    PERFORM INITIALIZE-SUBFILE-RECORD 17 TIMES
           027800                ELSE
   253     027900                    SET OVER-PAYMENT-DISPLAYED-ONCE TO TRUE
           028000                END-IF
           028100            END-IF
           028200         END-IF
           028300     END-IF.
   254     028400     SET WRITE-DISPLAY, DISPLAY-SCREEN TO TRUE.
   255     028500     MOVE CORR INDICATOR-AREA TO MESSAGE1-O-INDIC.
                 *** CORRESPONDING items for statement 255:
                 ***     IN71
                 *** End of CORRESPONDING items for statement 255
   256     028600     WRITE PAYMENT-UPDATE-DISPLAY-RECORD
           028700         FORMAT IS 'MESSAGE1'
           028800     END-WRITE.
   257     028900     SET WRITE-DISPLAY, CONTROL1-FORMAT TO TRUE.
   258     029000     MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC.
                 *** CORRESPONDING items for statement 258:
                 ***     IN99
                 ***     IN61
                 ***     IN62
                 ***     IN63
                 ***     IN64
                 *** End of CORRESPONDING items for statement 258
   259     029100     WRITE PAYMENT-UPDATE-DISPLAY-RECORD
           029200         FORMAT IS 'CONTROL1'
           029300     END-WRITE.
   260     029400     READ PAYMENT-UPDATE-DISPLAY-FILE RECORD
           029500         FORMAT IS 'CONTROL1'
           029600     END-READ.
   261     029700     MOVE CORR CONTROL1-I-INDIC TO INDICATOR-AREA.
                 *** CORRESPONDING items for statement 261:
                 ***     IN99
                 ***     IN98
                 ***     IN97
                 *** End of CORRESPONDING items for statement 261
           029800
           029900 READ-MODIFIED-SUBFILE-RECORD.
   262     030000     READ SUBFILE PAYMENT-UPDATE-DISPLAY-FILE
           030100         NEXT MODIFIED RECORD FORMAT IS 'SUBFILE1'
   263     030200         AT END SET NO-MORE-TRANSACTIONS-EXIST TO TRUE
           030300     END-READ.
           030400
           030500 TEST-FOR-RECORD-INPUT-ERRORS.
   264     030600     READ SUBFILE PAYMENT-UPDATE-DISPLAY-FILE RECORD
           030700         FORMAT IS 'SUBFILE1'
           030800     END-READ.
   265     030900     IF  STSCDE OF SUBFILE1-I IS EQUAL TO '1' THEN
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ   11
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
   266     031000         SET INPUT-ERRORS-EXIST TO TRUE
           031100     END-IF.
           031200
           031300 TRANSACTION-VALIDATION.
   267     031400     MOVE CUST OF SUBFILE1-I OF PAYMENT-UPDATE-DISPLAY-RECORD
           031500         TO CUST OF CUSTOMER-MASTER-RECORD.
   268     031600     SET CUSTOMER-EXIST TO TRUE.
   269     031700     READ CUSTOMER-MASTER-FILE
   270     031800         INVALID KEY SET CUSTOMER-NOT-FOUND TO TRUE
           031900     END-READ.
   271     032000     IF  CUSTOMER-EXIST THEN
   272     032100         MOVE CUST OF CUSMST TO CUST OF ORDHDR
   273     032200         MOVE ZEROES TO INVNUM
   274     032300         SET CUSTOMER-INVOICE-EXIST TO TRUE
   275     032400         PERFORM START-ON-CUSTOMER-INVOICE-FILE
   276     032500         IF  CUSTOMER-INVOICE-EXIST THEN
   277     032600             PERFORM READ-CUSTOMER-INVOICE-RECORD
   278     032700             IF CUSTOMER-INVOICE-EXIST THEN
   279     032800                 PERFORM CUSTOMER-MASTER-FILE-UPDATE
   280     032900                 MOVE AMPAID OF SUBFILE1-I TO AMOUNT-PAID
   281     033000                 SET PAYMENT-EXIST TO TRUE
   282     033100                 PERFORM PAYMENT-UPDATE
           033200                     UNTIL NO-MORE-INVOICES-EXIST
           033300                     OR NO-MORE-PAYMENT-EXIST
   283     033400                 IF  ARBAL OF CUSTOMER-MASTER-RECORD IS NEGATIVE
   284     033500                     SET MAKE-FIELD-BLINK
           033600                         DISPLAY-FIELD
           033700                         DO-NOT-REVERSE-FIELD-IMAGE
           033800                         OVER-PAYMENT-NOT-DISPLAYED
           033900                         DISPLAY-OVER-PAYMENT
           034000                         DISPLAY-EXCEPTION
           034100                         DO-NOT-DISPLAY-ACCEPT-PAYMENT
           034200                         PROTECT-INPUT-FIELD TO TRUE
   285     034300                     MOVE ARBAL TO OVRPMT OF SUBFILE1-O
   286     034400                     MOVE MESSAGE-THREE TO ECPMSG OF SUBFILE1-O
   287     034500                     MOVE '0' TO STSCDE OF SUBFILE1-O
   288     034600                     PERFORM REWRITE-DISPLAY-SUBFILE-RECORD
           034700                 ELSE
   289     034800                     SET DO-NOT-DISPLAY-FIELD
           034900                         DO-NOT-DISPLAY-OVER-PAYMENT
           035000                         DO-NOT-REVERSE-FIELD-IMAGE
           035100                         DO-NOT-MAKE-FIELD-BLINK
           035200                         DO-NOT-DISPLAY-ACCEPT-PAYMENT
           035300                         PROTECT-INPUT-FIELD TO TRUE
   290     035400                     MOVE SPACES TO ECPMSG OF SUBFILE1-O
   291     035500                     MOVE ZEROES TO OVRPMT OF SUBFILE1-O
   292     035600                     MOVE '0' TO STSCDE OF SUBFILE1-O
   293     035700                     PERFORM REWRITE-DISPLAY-SUBFILE-RECORD
           035800                 END-IF
           035900             ELSE
   294     036000                 PERFORM NO-CUSTOMER-INVOICE-ROUTINE
           036100             END-IF
           036200         ELSE
   295     036300             PERFORM NO-CUSTOMER-INVOICE-ROUTINE
           036400         END-IF
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ   12
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
           036500     ELSE
   296     036600         SET REVERSE-FIELD-IMAGE
           036700             DO-NOT-PROTECT-INPUT-FIELD
           036800             DISPLAY-FIELD
           036900             DO-NOT-DISPLAY-OVER-PAYMENT
           037000             DO-NOT-MAKE-FIELD-BLINK
           037100             DISPLAY-EXCEPTION
           037200             DO-NOT-DISPLAY-ACCEPT-PAYMENT
           037300             DO-NOT-PROTECT-INPUT-FIELD TO TRUE
   297     037400         MOVE ZEROES TO OVRPMT OF SUBFILE1-O
   298     037500         MOVE MESSAGE-ONE TO ECPMSG OF SUBFILE1-O
   299     037600         MOVE '1' TO STSCDE OF SUBFILE1-O
   300     037700         PERFORM REWRITE-DISPLAY-SUBFILE-RECORD
           037800     END-IF.
   301     037900     PERFORM READ-MODIFIED-SUBFILE-RECORD.
           038000
           038100 START-ON-CUSTOMER-INVOICE-FILE.
   302     038200     START CUSTOMER-INVOICE-FILE
           038300         KEY IS GREATER THAN COMP-KEY
   303     038400         INVALID KEY SET NO-MORE-INVOICES-EXIST TO TRUE
           038500     END-START.
           038600
           038700 READ-CUSTOMER-INVOICE-RECORD.
   304     038800     READ CUSTOMER-INVOICE-FILE NEXT RECORD
   305     038900         AT END SET NO-MORE-INVOICES-EXIST TO TRUE
           039000     END-READ.
   306     039100     IF  CUST OF CUSTOMER-MASTER-RECORD
           039200         IS NOT EQUAL TO CUST OF CUSTOMER-INVOICE-RECORD THEN
   307     039300         SET NO-MORE-INVOICES-EXIST TO TRUE
           039400     END-IF.
           039500
           039600 CUSTOMER-MASTER-FILE-UPDATE.
   308     039700     MOVE FILE-DATE TO LSTDAT OF CUSTOMER-MASTER-RECORD.
   309     039800     MOVE AMPAID OF SUBFILE1-I
           039900         TO LSTAMT OF CUSTOMER-MASTER-RECORD.
   310     040000     SUBTRACT AMPAID OF SUBFILE1-I
           040100         FROM ARBAL OF CUSTOMER-MASTER-RECORD.
   311     040200     REWRITE CUSTOMER-MASTER-RECORD
           040300         INVALID KEY
   312     040400             DISPLAY 'ERROR IN REWRITE OF CUSTOMER MASTER'
           040500     END-REWRITE.
           040600
           040700  REWRITE-DISPLAY-SUBFILE-RECORD.
   313     040800     MOVE AMPAID OF SUBFILE1-I TO AMPAID OF SUBFILE1-O.
   314     040900     MOVE CUST OF SUBFILE1-I TO CUST OF SUBFILE1-O.
   315     041000     SET WRITE-DISPLAY TO TRUE.
   316     041100     SET SUBFILE1-FORMAT TO TRUE.
   317     041200     MOVE CORR INDICATOR-AREA TO SUBFILE1-O-INDIC.
                 *** CORRESPONDING items for statement 317:
                 ***     IN51
                 ***     IN52
                 ***     IN53
                 ***     IN54
                 ***     IN55
                 ***     IN56
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ   13
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
                 *** End of CORRESPONDING items for statement 317
   318     041300     REWRITE SUBFILE PAYMENT-UPDATE-DISPLAY-RECORD
           041400         FORMAT IS 'SUBFILE1'
           041500     END-REWRITE.
           041600
           041700 NO-CUSTOMER-INVOICE-ROUTINE.
   319     041800     IF  STSCDE OF SUBFILE1-I IS EQUAL TO '1' THEN
   320     041900        IF  ACPPMT OF SUBFILE1-I IS EQUAL TO '*NO' THEN
   321     042000           SET DO-NOT-DISPLAY-FIELD
           042100               DO-NOT-DISPLAY-OVER-PAYMENT
           042200               DO-NOT-REVERSE-FIELD-IMAGE
           042300               DO-NOT-MAKE-FIELD-BLINK
           042400               DO-NOT-DISPLAY-ACCEPT-PAYMENT
           042500               PROTECT-INPUT-FIELD
           042600                 TO TRUE
   322     042700            MOVE SPACES TO ECPMSG OF SUBFILE1-O
   323     042800            MOVE ZEROES TO OVRPMT OF SUBFILE1-O
   324     042900            MOVE '0' TO STSCDE OF SUBFILE1-O
   325     043000            PERFORM REWRITE-DISPLAY-SUBFILE-RECORD
           043100        ELSE
   326     043200            PERFORM CUSTOMER-MASTER-FILE-UPDATE
   327     043300            SET MAKE-FIELD-BLINK
           043400                DISPLAY-FIELD
           043500                DO-NOT-REVERSE-FIELD-IMAGE
           043600                OVER-PAYMENT-NOT-DISPLAYED
           043700                DISPLAY-OVER-PAYMENT
           043800                DISPLAY-EXCEPTION
           043900                DO-NOT-DISPLAY-ACCEPT-PAYMENT
           044000                PROTECT-INPUT-FIELD
           044100                  TO TRUE
   328     044200            MOVE ARBAL TO OVRPMT OF SUBFILE1-O
   329     044300            MOVE MESSAGE-THREE TO ECPMSG OF SUBFILE1-O
   330     044400            MOVE '0' TO STSCDE OF SUBFILE1-O
   331     044500            PERFORM REWRITE-DISPLAY-SUBFILE-RECORD
           044600         END-IF
           044700     ELSE
   332     044800         SET REVERSE-FIELD-IMAGE
           044900             DISPLAY-FIELD
           045000             DO-NOT-PROTECT-INPUT-FIELD
           045100             DO-NOT-DISPLAY-OVER-PAYMENT
           045200             DISPLAY-EXCEPTION
           045300             DISPLAY-ACCEPT-PAYMENT
           045400             DISPLAY-ACCEPT-HEADING
           045500             DISPLAY-ACCEPT-MESSAGE
           045600             DO-NOT-MAKE-FIELD-BLINK
           045700               TO TRUE
   333     045800         MOVE ZEROS TO OVRPMT OF SUBFILE1-O
   334     045900         MOVE MESSAGE-TWO TO ECPMSG OF SUBFILE1-O
   335     046000         MOVE '1' TO STSCDE OF SUBFILE1-O
   336     046100         PERFORM REWRITE-DISPLAY-SUBFILE-RECORD
           046200     END-IF.
           046300
           046400 PAYMENT-UPDATE.
   337     046500     SUBTRACT AMPAID OF CUSTOMER-INVOICE-RECORD
           046600         FROM ORDAMT OF CUSTOMER-INVOICE-RECORD
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/PAYUPDT         ISERIES1   06/02/15 15:08:37        ページ   14
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
           046700         GIVING AMOUNT-OWED.
   338     046800     SUBTRACT AMOUNT-PAID
           046900         FROM AMOUNT-OWED
           047000         GIVING INVOICE-BALANCE.
   339     047100     IF  INVOICE-BALANCE IS LESS THAN 0.01 THEN
   340     047200         MOVE 2 TO OPNSTS OF CUSTOMER-INVOICE-RECORD
   341     047300         MOVE ORDAMT OF CUSTOMER-INVOICE-RECORD
           047400           TO AMPAID OF CUSTOMER-INVOICE-RECORD
   342     047500         SUBTRACT AMOUNT-OWED
           047600             FROM AMOUNT-PAID
           047700     ELSE
   343     047800         ADD AMOUNT-PAID TO AMPAID OF CUSTOMER-INVOICE-RECORD
   344     047900         SET NO-MORE-PAYMENT-EXIST TO TRUE
           048000     END-IF.
   345     048100     REWRITE CUSTOMER-INVOICE-RECORD
           048200         INVALID KEY
   346     048300             DISPLAY 'ERROR IN REWRITE OF CUSTOMER INVOICE'
           048400     END-REWRITE.
   347     048500     IF  PAYMENT-EXIST THEN
   348     048600         PERFORM READ-CUSTOMER-INVOICE-RECORD
           048700     END-IF.
           048800
           048900 INITIALIZE-SUBFILE-RECORD.
   349     049000     MOVE SPACES TO CUST OF SUBFILE1-O.
   350     049100     MOVE SPACES TO ECPMSG OF SUBFILE1-O.
   351     049200     MOVE '0' TO STSCDE OF SUBFILE1-O.
   352     049300     MOVE ZEROS TO AMPAID OF SUBFILE1-O.
   353     049400     MOVE ZEROS TO OVRPMT OF SUBFILE1-O.
   354     049500     ADD 1 TO REL-NUMBER.
   355     049600     MOVE CORR INDICATOR-AREA TO SUBFILE1-O-INDIC.
                 *** CORRESPONDING items for statement 355:
                 ***     IN51
                 ***     IN52
                 ***     IN53
                 ***     IN54
                 ***     IN55
                 ***     IN56
                 *** End of CORRESPONDING items for statement 355
   356     049700     WRITE SUBFILE PAYMENT-UPDATE-DISPLAY-RECORD
           049800         FORMAT IS 'SUBFILE1'
           049900     END-WRITE.
                           * * * * *   ソ ー ス 仕 様 の 終 わ り   * * * * *

これは、得意先番号と支払額の入力を要求するためにワークステーションに表示される最初の表示画面です。


Customer Payment Update Prompt                                   Date  11/08/96

            Customer    Payment


            ______   _________
            ______   _________
            ______   _________
            ______   _________
            ______   _________
            ______   _________
            ______   _________
            ______   _________
            ______   _________
            ______   _________

            ______   _________
            ______   _________
            ______   _________
            ______   _________
            ______   _________

次のように、得意先番号と支払額を入力します。


Customer Payment Update Prompt                                   Date  11/08/96

            Customer    Payment


             34500      2000
             40500     30000
             36000      2500
             12500       200
             22799      4500
             41900      7500
             10001      5000
             49500      2500
             13300      3500
             56900      4000









支払過剰になるものや得意先番号が正しくないものは、次に示すように画面に残り、そのことを示すメッセージが表示されます。

Customer Payment Update Prompt                                   Date  11/08/96
Accept      Customer    Payment    Exception Message
Payment

_____        40500       30000     NO INVOICES EXIST FOR CUSTOMER

_____        12500         200     NO INVOICES EXIST FOR CUSTOMER

_____        41900        7500     NO INVOICES EXIST FOR CUSTOMER
             10001        5000     CUSTOMER DOES NOT EXIST

_____        13300        3500     NO INVOICES EXIST FOR CUSTOMER









Accept payment values: (*NO *YES)

次のようにして、どの支払いを受け付けるかを指定します。

Customer Payment Update Prompt                                   Date  11/08/96

Accept      Customer    Payment    Exception Message
Payment

  *NO        40500       30000     NO INVOICES EXIST FOR CUSTOMER

  *YES       12500         200     NO INVOICES EXIST FOR CUSTOMER

  *NO        41900        7500     NO INVOICES EXIST FOR CUSTOMER
             10001        5000     CUSTOMER DOES NOT EXIST

  *NO        13300        3500     NO INVOICES EXIST FOR CUSTOMER









Accept payment values: (*NO *YES)

受け付けられた支払いは処理され、支払過剰が次にように表示されます。

Customer Payment Update Prompt                                   Date  11/08/96
Accept      Customer    Payment    Exception Message
Payment

            12500         200      CUSTOMER HAS AN OVERPAYMENT OF         58.50

            10001        5000      CUSTOMER DOES NOT EXIST