000001******************************************** 000002** インデックスファイル 合計編集印字 000003******************************************** 000004 IDENTIFICATION DIVISION. 000005 PROGRAM-ID. TEST7. 000006 ENVIRONMENT DIVISION. 000007 INPUT-OUTPUT SECTION. 000008 FILE-CONTROL. 000009 SELECT AAFILE ASSIGN "rdata3.dat". 000010 SELECT BBFILE ASSIGN "rdata2.dat" 000011 ORGANIZATION INDEXED 000012 ACCESS MODE DYNAMIC 000013 RECORD KEY B01. 000014 SELECT PRFILE ASSIGN "PR4.dat". 000015 DATA DIVISION. 000016 FILE SECTION. 000017 FD AAFILE. 000018 01 A1REC. 000019 02 A01 PIC X(13). 000020 02 A02 PIC S9(05). 000021 02 FILLER PIC X(14). 000022 FD BBFILE. 000023 01 B1REC. 000024 02 B01 PIC X(13). 000025 02 B02 PIC N(20). 000026 02 B03 PIC X(08). 000027 02 B04 PIC S9(11). 000028 02 B05 PIC 9(04). 000029 02 FILLER PIC X(04). 000030 FD PRFILE. 000031 01 PRREC PIC X(80). 000032 WORKING-STORAGE SECTION. 000033 01 MIDA1. 000034 02 FILLER PIC X(22) VALUE SPACE. 000035 02 FILLER PIC N(09) VALUE "商 品 リ ス ト". 000036 01 MIDA2. 000037 02 FILLER PIC N(04) VALUE "コード ". 000038 02 FILLER PIC X(07) VALUE SPACE. 000039 02 FILLER PIC N(04) VALUE "商 品 ". 000040 02 FILLER PIC X(44) VALUE SPACE. 000041 02 FILLER PIC N(04) VALUE "金 額 ". 000042 01 MEI1. 000043 02 MEI1-1 PIC X(13). 000044 02 FILLER PIC X(02) VALUE SPACE. 000045 02 MEI1-2 PIC N(20). 000046 02 FILLER PIC X(04) VALUE SPACE. 000047 02 MEI1-3 PIC ZZ,ZZZ,ZZZ,ZZZ. 000048 01 GOUK. 000049 02 FILLER PIC X(47) VALUE SPACE. 000050 02 FILLER PIC N(04) VALUE "合 計 ". 000051 02 FILLER PIC X(04) VALUE SPACE. 000052 02 GOU1-3 PIC ZZ,ZZZ,ZZZ,ZZZ. 000053 01 N PIC 9(02) VALUE 30. 000054 01 N1 PIC 9(02) VALUE 0. 000055 01 X01 PIC S9(11) VALUE 0. 000056 01 X02 PIC S9(11) VALUE 0. 000057 PROCEDURE DIVISION. 000058 MAIN SECTION. 000059 IP1. 000060 OPEN INPUT AAFILE BBFILE. 000061 OPEN OUTPUT PRFILE. 000062 IP2. 000063 READ AAFILE AT END GO TO OWARI. 000064 MOVE A01 TO B01. 000065 READ BBFILE INVALID GO TO ERR1. 000066 IF N > 29 000067 MOVE SPACE TO PRREC 000068 WRITE PRREC BEFORE PAGE 000069 WRITE PRREC FROM MIDA1 BEFORE 1 000070 WRITE PRREC FROM MIDA2 BEFORE 2 000071 MOVE 0 TO N 000072 END-IF. 000073 COMPUTE X01 = A02 * B04 * B05. 000074 MOVE A01 TO MEI1-1. 000075 MOVE B02 TO MEI1-2. 000076 MOVE X01 TO MEI1-3. 000077 WRITE PRREC FROM MEI1 BEFORE 1. 000078 COMPUTE N = N + 1. 000079 COMPUTE X02 = X02 + X01. 000080 GO TO IP2. 000081 ERR1. 000082 DISPLAY "READ ERR " 000083 ACCEPT N1. 000084 OWARI. 000085 MOVE X02 TO GOU1-3. 000086 WRITE PRREC FROM GOUK BEFORE 1. 000087 CLOSE AAFILE BBFILE PRFILE. 000088 STOP RUN. 000089