IDENTIFICATION DIVISION.
PROGRAM-ID. LIST0003.
AUTHOR. JIRO SUZUKI.
*------------------------------------------------------------
* コントロールブレイク＆リスト出力 サンプル
* １．単純明細
* ２．同一商品コード合計（合計位置不定型）
* ３．同一日付合計（合計位置固定。ページ最下部）
* ４．全体合計（合計位置固定。改ページ後）
*------------------------------------------------------------
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN01 ASSIGN TO IN01NAME
ACCESS MODE IS SEQUENTIAL.
SELECT OUT1 ASSIGN TO OUT1NAME
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD IN01.
COPY I-PRDCTDTL.
FD OUT1.
01 O-REC PIC X(132).
WORKING-STORAGE SECTION.
01 IN01NAME PIC X(80).
01 OUT1NAME PIC X(80).
*
01 CNS-AREA.
03 CNS-INIT-MSG.
05 PIC X(10) VALUE "----- PGM=".
05 PIC X(08) VALUE "LIST0003".
05 PIC X(11) VALUE "START -----".
03 CNS-TERM-MSG.
05 PIC X(10) VALUE "----- PGM=".
05 PIC X(08) VALUE "LIST0003".
05 PIC X(11) VALUE "END -----".
03 CNS-SW-OFF PIC 9(01) COMP-3 VALUE ZERO.
03 CNS-SW-ON PIC 9(01) COMP-3 VALUE 1.
03 CNS-DTL-MAX PIC 9(02) COMP-3 VALUE 20.
03 CNS-PAGE-MAX PIC 9(02) COMP-3 VALUE 22.
03 CNS-HD-1.
05 CNS-HD1-DATE PIC X(10).
05 PIC X(17) VALUE SPACE.
05 PIC N(05) VALUE "売上明細表".
05 PIC X(20) VALUE SPACE.
05 PIC X(05) VALUE "PAGE:".
05 CNS-HD-1-PAGENO PIC Z,ZZ9.
05 PIC X(75) VALUE SPACE.
03 CNS-HD-2.
05 PIC N(05) VALUE "売上年月日".
05 PIC X(05) VALUE SPACE.
05 PIC N(05) VALUE "商品コード".
05 PIC X(08) VALUE SPACE.
05 PIC N(02) VALUE "単価".
05 PIC X(08) VALUE SPACE.
05 PIC N(02) VALUE "数量".
05 PIC X(14) VALUE SPACE.
05 PIC N(02) VALUE "金額".
05 PIC X(59) VALUE SPACE.
03 CNS-SLASH PIC X(01) VALUE "/".
03 CNS-GOKEI1 PIC N(04) VALUE "商品合計".
03 CNS-GOKEI2 PIC N(05) VALUE "売上日合計".
03 CNS-GOKEI3 PIC N(04) VALUE " 総合計".
03 CNS-1 PIC 9(01) COMP-3 VALUE 1.
03 CNS-2 PIC 9(01) COMP-3 VALUE 2.
03 CNS-8 PIC 9(01) COMP-3 VALUE 8.
*
01 CNT-AREA.
03 CNT-IN01 PIC 9(11) COMP-3 VALUE ZERO.
03 CNT-PAGE PIC 9(11) COMP-3 VALUE ZERO.
03 CNT-LINE PIC 9(02) COMP-3 VALUE 20.
*
01 SW-AREA.
03 SW-ABEND PIC 9(01) COMP-3 VALUE ZERO.
*
01 WORK-AREA.
03 W-OLD-KEY.
05 W-OLD-PCHASEDATE PIC X(08).
05 W-OLD-PRDCTCD PIC X(08).
03 W-NEW-KEY.
05 W-NEW-PCHASEDATE PIC X(08).
05 W-NEW-PRDCTCD PIC X(08).
03 W-PRDCTSUM-QUANTITY PIC 9(09) COMP-3.
03 W-PRDCTSUM-AMOUNT PIC 9(13) COMP-3.
03 W-DATESUM-AMOUNT PIC 9(13) COMP-3.
03 W-ALL-AMOUNT PIC 9(13) COMP-3.
03 W-DTL.
05 W-DTL-PCHASEDATE.
07 W-DTL-PCHASEYY PIC X(04).
07 W-DTL-PCHASES1 PIC X(01).
07 W-DTL-PCHASEMM PIC X(02).
07 W-DTL-PCHASES2 PIC X(01).
07 W-DTL-PCHASEDD PIC X(02).
05 PIC X(06).
05 W-DTL-PRDCTCD PIC X(08).
05 PIC X(02).
05 W-DTL-PRICE PIC ZZZ,ZZZ,ZZ9.
05 PIC X(01).
05 W-DTL-QUANTITY PIC ZZZ,ZZZ,ZZ9.
05 PIC X(01).
05 W-DTL-AMOUNT PIC Z,ZZZ,ZZZ,ZZZ,ZZ9.
05 PIC X(65).
03 W-TTL1.
05 PIC X(16).
05 W-TTL1-PRDCTCD PIC X(08).
05 PIC X(05).
05 W-TTL1-GOKEI PIC N(04).
05 PIC X(01).
05 W-TTL1-QUANTITY PIC ZZZ,ZZZ,ZZ9.
05 PIC X(01).
05 W-TTL1-AMOUNT PIC Z,ZZZ,ZZZ,ZZZ,ZZ9.
05 PIC X(65).
03 W-TTL2.
05 W-TTL2-PCHASEDATE.
07 W-TTL2-PCHASEYY PIC X(04).
07 W-TTL2-PCHASES1 PIC X(01).
07 W-TTL2-PCHASEMM PIC X(02).
07 W-TTL2-PCHASES2 PIC X(01).
07 W-TTL2-PCHASEDD PIC X(02).
05 PIC X(29).
05 W-TTL2-GOKEI PIC N(05).
05 PIC X(01).
05 W-TTL2-AMOUNT PIC Z,ZZZ,ZZZ,ZZZ,ZZ9.
05 PIC X(65).
03 W-TTL3.
05 PIC X(41).
05 W-TTL3-GOKEI PIC N(04).
05 PIC X(01).
05 W-TTL3-AMOUNT PIC Z,ZZZ,ZZZ,ZZZ,ZZ9.
05 PIC X(65).
03 W-Z9 PIC Z9.
03 W-AMOUNT PIC 9(13) COMP-3.
03 W-DATE PIC X(06).
03 W-DATE-EDIT.
05 W-DATE-YY PIC X(02).
05 W-DATE-S1 PIC X(01).
05 W-DATE-MM PIC X(02).
05 W-DATE-S2 PIC X(01).
05 W-DATE-DD PIC X(02).
03 W-AFT-LINE PIC 9(02) COMP-3.
*------------------------------------------------------------
PROCEDURE DIVISION.
MAIN SECTION. *>全体処理
PERFORM INIT-PROC THRU INIT-EXIT.
PERFORM MAIN-PROC THRU MAIN-EXIT.
PERFORM TERM-PROC THRU TERM-EXIT.
STOP RUN.
*------------------------------------------------------------
INIT-PROC. *>初期処理
DISPLAY CNS-INIT-MSG.
*
ACCEPT IN01NAME FROM ARGUMENT-VALUE.
ACCEPT OUT1NAME FROM ARGUMENT-VALUE.
*
OPEN INPUT IN01
OUTPUT OUT1.
*
INITIALIZE WORK-AREA.
MOVE LOW-VALUE TO W-OLD-KEY W-NEW-KEY.
*
ACCEPT W-DATE FROM DATE.
MOVE W-DATE(1:2) TO W-DATE-YY.
MOVE W-DATE(3:2) TO W-Z9.
MOVE W-Z9 TO W-DATE-MM.
MOVE W-DATE(5:2) TO W-Z9.
MOVE W-Z9 TO W-DATE-DD.
MOVE CNS-SLASH TO W-DATE-S1 W-DATE-S2.
MOVE W-DATE-EDIT TO CNS-HD1-DATE.
INIT-EXIT.
*------------------------------------------------------------
MAIN-PROC. *>主処理
PERFORM READ-IN01.
PERFORM UNTIL W-NEW-KEY = HIGH-VALUE
EVALUATE TRUE
WHEN W-NEW-KEY > W-OLD-KEY
IF CNT-IN01 NOT = CNS-1
* 日付ブレーク処理
IF W-NEW-PCHASEDATE NOT = W-OLD-PCHASEDATE
PERFORM WRITE-TTL-PRDCTSUM
PERFORM WRITE-TTL-DATESUM
* 商品コードブレーク処理
ELSE
PERFORM WRITE-TTL-PRDCTSUM
END-IF
END-IF
* 同一キー処理
WHEN W-NEW-KEY = W-OLD-KEY
CONTINUE
WHEN OTHER
PERFORM ABEND-PROC
END-EVALUATE
PERFORM DTL-PROC
PERFORM READ-IN01
END-PERFORM.
MAIN-EXIT.
*------------------------------------------------------------
TERM-PROC. *>終了処理
IF SW-ABEND = CNS-SW-OFF
IF CNT-IN01 NOT = 0
PERFORM WRITE-TTL-PRDCTSUM
PERFORM WRITE-TTL-DATESUM
PERFORM WRITE-TTL
END-IF
END-IF.
*
CLOSE IN01
OUT1.
DISPLAY "IN01=" CNT-IN01.
DISPLAY "PAGE=" CNT-PAGE.
DISPLAY CNS-TERM-MSG.
TERM-EXIT.
*------------------------------------------------------------
READ-IN01. *>ＩＮ０１読込処理
*
MOVE W-NEW-KEY TO W-OLD-KEY.
*
READ IN01 INTO I-PRDCTDTL
AT END
MOVE HIGH-VALUE TO W-NEW-KEY
NOT AT END
MOVE I-PCHASEDATE TO W-NEW-PCHASEDATE
MOVE I-PRDCTCD TO W-NEW-PRDCTCD
ADD 1 TO CNT-IN01
END-READ.
*------------------------------------------------------------
DTL-PROC. *>明細処理
ADD CNS-1 TO CNT-LINE.
IF CNT-LINE > CNS-DTL-MAX
PERFORM WRITE-HEADER
END-IF.
PERFORM EDIT-DTL.
PERFORM SUM-PROC.
*------------------------------------------------------------
EDIT-DTL. *>明細編集処理
INITIALIZE W-DTL.
*
EVALUATE TRUE
* 改ページ後一行目はすべて表示
WHEN CNT-LINE = 1
* 日付が変わったらすべて表示
WHEN W-NEW-PCHASEDATE NOT = W-OLD-PCHASEDATE
PERFORM EDIT-DTL-SUB1
* 商品コードだけが変わったら商品コードは表示
WHEN W-NEW-PCHASEDATE = W-OLD-PCHASEDATE AND
W-NEW-PRDCTCD NOT = W-OLD-PRDCTCD
PERFORM EDIT-DTL-SUB2
* キーが変わっていないときはキー項目は非表示
WHEN OTHER
PERFORM EDIT-DTL-SUB3
END-EVALUATE.
*
MOVE I-PRICE TO W-DTL-PRICE.
MOVE I-QUANTITY TO W-DTL-QUANTITY.
COMPUTE W-AMOUNT = I-PRICE * I-QUANTITY.
MOVE W-AMOUNT TO W-DTL-AMOUNT.
*
PERFORM WRITE-DTL.
*
*------------------------------------------------------------
EDIT-DTL-SUB1. *>明細編集サブ処理１
MOVE I-PCHASEDATE (1:4) TO W-DTL-PCHASEYY.
MOVE I-PCHASEDATE (5:2) TO W-Z9.
MOVE W-Z9 TO W-DTL-PCHASEMM.
MOVE I-PCHASEDATE (7:2) TO W-Z9.
MOVE W-Z9 TO W-DTL-PCHASEDD.
MOVE CNS-SLASH TO W-DTL-PCHASES1 W-DTL-PCHASES2.
MOVE I-PRDCTCD TO W-DTL-PRDCTCD.
*------------------------------------------------------------
EDIT-DTL-SUB2. *>明細編集サブ処理２
MOVE SPACE TO W-DTL-PCHASEDATE.
MOVE I-PRDCTCD TO W-DTL-PRDCTCD.
*------------------------------------------------------------
EDIT-DTL-SUB3. *>明細編集サブ処理３
MOVE SPACE TO W-DTL-PCHASEDATE W-DTL-PRDCTCD.
*------------------------------------------------------------
WRITE-DTL. *>明細出力処理
MOVE W-DTL TO O-REC.
WRITE O-REC AFTER 1.
*------------------------------------------------------------
SUM-PROC. *>キー合計加算処理
* 商品コード単位合計
COMPUTE W-PRDCTSUM-QUANTITY = W-PRDCTSUM-QUANTITY + I-QUANTITY.
COMPUTE W-PRDCTSUM-AMOUNT = W-PRDCTSUM-AMOUNT + W-AMOUNT.
* 日付単位合計
COMPUTE W-DATESUM-AMOUNT = W-DATESUM-AMOUNT + W-AMOUNT.
* 全体合計
COMPUTE W-ALL-AMOUNT = W-ALL-AMOUNT + W-AMOUNT.
*------------------------------------------------------------
WRITE-TTL-PRDCTSUM.
INITIALIZE W-TTL1.
MOVE W-OLD-PRDCTCD TO W-TTL1-PRDCTCD.
MOVE W-PRDCTSUM-QUANTITY TO W-TTL1-QUANTITY.
MOVE W-PRDCTSUM-AMOUNT TO W-TTL1-AMOUNT.
MOVE CNS-GOKEI1 TO W-TTL1-GOKEI.
*
ADD CNS-1 TO CNT-LINE.
IF CNT-LINE > CNS-DTL-MAX
PERFORM WRITE-HEADER
END-IF.
MOVE W-TTL1 TO O-REC.
WRITE O-REC AFTER CNS-1.
*
MOVE ZERO TO W-PRDCTSUM-QUANTITY
W-PRDCTSUM-AMOUNT.
*------------------------------------------------------------
WRITE-TTL-DATESUM.
INITIALIZE W-TTL2.
MOVE W-OLD-PCHASEDATE (1:4) TO W-TTL2-PCHASEYY.
MOVE W-OLD-PCHASEDATE (5:2) TO W-Z9.
MOVE W-Z9 TO W-TTL2-PCHASEMM.
MOVE W-OLD-PCHASEDATE (7:2) TO W-Z9.
MOVE W-Z9 TO W-TTL2-PCHASEDD.
MOVE CNS-SLASH TO W-TTL2-PCHASES1 W-TTL2-PCHASES2.
MOVE W-DATESUM-AMOUNT TO W-TTL2-AMOUNT.
MOVE CNS-GOKEI2 TO W-TTL2-GOKEI.
*
COMPUTE W-AFT-LINE = CNS-PAGE-MAX - CNT-LINE.
MOVE W-TTL2 TO O-REC.
WRITE O-REC AFTER W-AFT-LINE.
*
MOVE ZERO TO W-DATESUM-AMOUNT.
MOVE CNS-DTL-MAX TO CNT-LINE.
*------------------------------------------------------------
WRITE-TTL.
INITIALIZE W-TTL3.
PERFORM WRITE-HEADER.
MOVE W-ALL-AMOUNT TO W-TTL3-AMOUNT.
MOVE CNS-GOKEI3 TO W-TTL3-GOKEI.
MOVE W-TTL3 TO O-REC.
WRITE O-REC AFTER CNS-1.
*------------------------------------------------------------
WRITE-HEADER. *>見出し出力処理
COMPUTE CNT-PAGE = CNT-PAGE + 1.
*
MOVE CNT-PAGE TO CNS-HD-1-PAGENO.
MOVE CNS-HD-1 TO O-REC.
* この分岐が汎用機で必要か否かは忘れた。不要だった気がする。
IF CNT-PAGE = CNS-1
WRITE O-REC
ELSE
WRITE O-REC AFTER PAGE
END-IF.
*
MOVE CNS-1 TO CNT-LINE.
*
MOVE CNS-HD-2 TO O-REC.
WRITE O-REC AFTER 2.
*------------------------------------------------------------
ABEND-PROC. *>異常発生時処理
DISPLAY "----- IN01 DATA NOT SORTED -----".
DISPLAY " THIS PROCEDURE ENDED ABNORMALY." .
MOVE CNS-SW-ON TO SW-ABEND.