CB545 V2 LVL78 01MAY72 IBM OS AMERICAN NATIONAL STANDARD COBOL DATE APR 1,1980
1
00001 000100 IDENTIFICATION DIVISION.
00002 000200 PROGRAM-ID. RWEX02.
00003 000300 AUTHOR. JAY MOSELEY.
00004 000400 DATE-WRITTEN. MARCH, 2008.
00005 000500 DATE-COMPILED. APR 1,1980
00007 000700* ************************************************************* *
00008 000800* REPORT WRITER EXAMPLE #2. *
00009 000900* ************************************************************* *
00011 001100 ENVIRONMENT DIVISION.
00012 001200 CONFIGURATION SECTION.
00013 001300 SOURCE-COMPUTER. IBM-370.
00014 001400 OBJECT-COMPUTER. IBM-370.
00015 001500
00016 001600 INPUT-OUTPUT SECTION.
00017 001700 FILE-CONTROL.
00018 001800
00019 001900 SELECT TRANSACTION-DATA
00020 002000 ASSIGN TO UT-S-DATAIN.
00021 002100
00022 002200 SELECT REPORT-FILE
00023 002300 ASSIGN TO UR-S-SYSPRINT.
00024 002400
00025 002500 DATA DIVISION.
00026 002600 FILE SECTION.
00027 002700
00028 002800 FD TRANSACTION-DATA
00029 002900 LABEL RECORDS ARE OMITTED
00030 003000 BLOCK CONTAINS 0 RECORDS
00031 003100 RECORD CONTAINS 80 CHARACTERS
00032 003200 DATA RECORD IS TRANSACTION-RECORD.
00033 003300
00034 003400 01 TRANSACTION-RECORD.
00035 003500 03 TR-CUSTOMER-NUMBER PIC 9(04).
00036 003600 03 FILLER PIC X(01).
00037 003700 03 TR-CUSTOMER-NAME PIC X(16).
00038 003800 03 FILLER PIC X(01).
00039 003900 03 TR-ITEM-NUMBER PIC 9(05).
00040 004000 03 FILLER REDEFINES TR-ITEM-NUMBER.
00041 004100 05 TR-ITEM-DEPARTMENT PIC 9(01).
00042 004200 05 FILLER PIC 9(04).
00043 004300 03 FILLER PIC X(01).
00044 004400 03 TR-ITEM-COST PIC 9(03)V99.
00045 004500 03 FILLER PIC X(47).
00046 004600
00047 004700 FD REPORT-FILE
00048 004800 LABEL RECORDS ARE OMITTED
00049 004900 REPORT IS CUSTOMER-REPORT.
00050 005000
00051 005100 WORKING-STORAGE SECTION.
00052 005200 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'.
00053 005300 88 END-OF-FILE VALUE 'Y'.
00054 005400
00055 005500 01 DISCOUNT-TABLE.
00056 005600 02 FILLER PIC 99 VALUE 05.
========================================================================================================================
2
00057 005700 02 FILLER PIC 99 VALUE 07.
00058 005800 02 FILLER PIC 99 VALUE 10.
00059 005900 02 FILLER PIC 99 VALUE 15.
00060 006000 02 FILLER PIC 99 VALUE 06.
00061 006100 02 FILLER PIC 99 VALUE 22.
00062 006200 02 FILLER PIC 99 VALUE 12.
00063 006300 02 FILLER PIC 99 VALUE 09.
00064 006400 02 FILLER PIC 99 VALUE 20.
00065 006500 01 FILLER REDEFINES DISCOUNT-TABLE.
00066 006600 02 DISCOUNT OCCURS 9 TIMES
00067 006700 INDEXED BY DISCOUNT-IX
00068 006800 PIC V99.
00069 006900
00070 007000 01 CALCULATED-FIELDS.
00071 007100 03 WS-DISCOUNT-AMT PIC 9(3)V99.
00072 007200 03 WS-CHARGE-AMT PIC 9(3)V99.
00073 007300
00074 007400 REPORT SECTION.
00075 007500 RD CUSTOMER-REPORT
00076 007600 CONTROL IS TR-CUSTOMER-NUMBER
00077 007700 PAGE LIMIT IS 66 LINES
00078 007800 HEADING 1
00079 007900 FIRST DETAIL 5
00080 008000 LAST DETAIL 58.
00081 008100
00082 008200 01 PAGE-HEAD-GROUP TYPE PAGE HEADING.
00083 008300 02 LINE 1.
00084 008400 03 COLUMN 27 PIC X(41) VALUE
00085 008500 'C U S T O M E R C H A R G E R E P O R T'.
00086 008600 03 COLUMN 90 PIC X(04) VALUE 'PAGE'.
00087 008700 03 COLUMN 95 PIC ZZZZ9 SOURCE PAGE-COUNTER.
00088 008800 02 LINE PLUS 2.
00089 008900 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'.
00090 009000 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'.
00091 009100 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'.
00092 009200 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'.
00093 009300 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'.
00094 009400 03 COLUMN 64 PIC X(08) VALUE 'DISCT. %'.
00095 009500 03 COLUMN 76 PIC X(11) VALUE 'DISCT. AMT.'.
00096 009600 03 COLUMN 91 PIC X(06) VALUE 'CHARGE'.
00097 009700
00098 009800 01 CHARGE-DETAIL TYPE DETAIL.
00099 009900 02 LINE PLUS 1.
00100 010000 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER.
00101 010100 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME.
00102 010200 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT.
00103 010300 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER.
00104 010400 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST.
00105 010500 03 COLUMN 67 PIC V99 SOURCE DISCOUNT (DISCOUNT-IX).
00106 010600 03 COLUMN 69 PIC X(01) VALUE '%'.
00107 010700 03 COLUMN 78 PIC $$$$.99 SOURCE WS-DISCOUNT-AMT.
00108 010800 03 COLUMN 93 PIC $$$$.99 SOURCE WS-CHARGE-AMT.
00109 010900
00110 011000 01 CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER-NUMBER
00111 011100 NEXT GROUP IS PLUS 2.
00112 011200 02 LINE PLUS 1.
00113 011300 03 COLUMN 92 PIC $$$$$.99 SUM WS-CHARGE-AMT.
00114 011400 03 COLUMN 101 PIC X VALUE '*'.
========================================================================================================================
3
00115 011500
00116 011600 PROCEDURE DIVISION.
00117 011700
00118 011800 000-INITIATE.
00119 011900
00120 012000 OPEN INPUT TRANSACTION-DATA,
00121 012100 OUTPUT REPORT-FILE.
00122 012200
00123 012300 INITIATE CUSTOMER-REPORT.
00124 012400
00125 012500 READ TRANSACTION-DATA
00126 012600 AT END
00127 012700 MOVE 'Y' TO END-OF-FILE-SWITCH.
00128 012800* END-READ.
00129 012900
00130 013000 PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT
00131 013100 UNTIL END-OF-FILE.
00132 013200
00133 013300 000-TERMINATE.
00134 013400 TERMINATE CUSTOMER-REPORT.
00135 013500
00136 013600 CLOSE TRANSACTION-DATA,
00137 013700 REPORT-FILE.
00138 013800
00139 013900 STOP RUN.
00140 014000
00141 014100 100-PROCESS-TRANSACTION-DATA.
00142 014200 SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT.
00143 014300 COMPUTE WS-DISCOUNT-AMT ROUNDED =
00144 014400 TR-ITEM-COST * DISCOUNT (DISCOUNT-IX).
00145 014500 COMPUTE WS-CHARGE-AMT =
00146 014600 TR-ITEM-COST - WS-DISCOUNT-AMT.
00147 014700 GENERATE CHARGE-DETAIL.
00148 014800 READ TRANSACTION-DATA
00149 014900 AT END
00150 015000 MOVE 'Y' TO END-OF-FILE-SWITCH.
00151 015100* END-READ.
00152 015200
00153 015300 199-EXIT.
00154 015400 EXIT.
00155 015500
00156 015600
========================================================================================================================
4
INTRNL NAME LVL SOURCE NAME BASE DISPL INTRNL NAME DEFINITION USAGE R O Q M
DNM=1-121 FD TRANSACTION-DATA DCB=01 DNM=1-121 QSAM F
DNM=1-150 01 TRANSACTION-RECORD BL=1 000 DNM=1-150 DS 0CL80 GROUP
DNM=1-181 02 TR-CUSTOMER-NUMBER BL=1 000 DNM=1-181 DS 4C DISP-NM
DNM=1-209 02 FILLER BL=1 004 DNM=1-209 DS 1C DISP
DNM=1-225 02 TR-CUSTOMER-NAME BL=1 005 DNM=1-225 DS 16C DISP
DNM=1-251 02 FILLER BL=1 015 DNM=1-251 DS 1C DISP
DNM=1-270 02 TR-ITEM-NUMBER BL=1 016 DNM=1-270 DS 5C DISP-NM
DNM=1-294 02 FILLER BL=1 016 DNM=1-294 DS 0CL5 GROUP R
DNM=1-316 03 TR-ITEM-DEPARTMENT BL=1 016 DNM=1-316 DS 1C DISP-NM
DNM=1-344 03 FILLER BL=1 017 DNM=1-344 DS 4C DISP-NM
DNM=1-363 02 FILLER BL=1 01B DNM=1-363 DS 1C DISP
DNM=1-382 02 TR-ITEM-COST BL=1 01C DNM=1-382 DS 5C DISP-NM
DNM=1-404 02 FILLER BL=1 021 DNM=1-404 DS 47C DISP
DNM=1-423 FD REPORT-FILE DCB=02 DNM=1-423 QSAM F
DNM=1-447 01 -0001 BL=2 000 DNM=1-447 DS 133C DISP
DNM=1-462 77 END-OF-FILE-SWITCH BL=3 000 DNM=1-462 DS 1C DISP
DNM=2-000 88 END-OF-FILE DNM=2-000
DNM=2-022 01 DISCOUNT-TABLE BL=3 008 DNM=2-022 DS 0CL18 GROUP
DNM=2-049 02 FILLER BL=3 008 DNM=2-049 DS 2C DISP-NM
DNM=2-068 02 FILLER BL=3 00A DNM=2-068 DS 2C DISP-NM
DNM=2-087 02 FILLER BL=3 00C DNM=2-087 DS 2C DISP-NM
DNM=2-106 02 FILLER BL=3 00E DNM=2-106 DS 2C DISP-NM
DNM=2-125 02 FILLER BL=3 010 DNM=2-125 DS 2C DISP-NM
DNM=2-144 02 FILLER BL=3 012 DNM=2-144 DS 2C DISP-NM
DNM=2-163 02 FILLER BL=3 014 DNM=2-163 DS 2C DISP-NM
DNM=2-182 02 FILLER BL=3 016 DNM=2-182 DS 2C DISP-NM
DNM=2-201 02 FILLER BL=3 018 DNM=2-201 DS 2C DISP-NM
DNM=2-220 01 FILLER BL=3 008 DNM=2-220 DS 0CL18 GROUP R
DNM=2-242 DISCOUNT-IX DNM=2-242 INDEX-NM
DNM=2-260 02 DISCOUNT BL=3 008 DNM=2-260 DS 2C DISP-NM O
DNM=2-278 01 CALCULATED-FIELDS BL=3 020 DNM=2-278 DS 0CL10 GROUP
DNM=2-308 02 WS-DISCOUNT-AMT BL=3 020 DNM=2-308 DS 5C DISP-NM
DNM=2-333 02 WS-CHARGE-AMT BL=3 025 DNM=2-333 DS 5C DISP-NM
DNM=2-356 01 PRINT-SWITCH BL=3 030 DNM=2-356 DS 1C DISP-NM
DNM=2-378 RD CUSTOMER-REPORT DNM=2-378
DNM=2-405 01 CTL.LVL BL=3 038 DNM=2-405 DS 2P COMP-3
DNM=2-422 01 TER.COD BL=3 040 DNM=2-422 DS 1C DISP
DNM=2-439 01 FRS.GEN BL=3 048 DNM=2-439 DS 1C DISP
DNM=2-456 01 LIN.SAV BL=3 050 DNM=2-456 DS 2C COMP
DNM=2-473 01 FRS.GRP BL=3 058 DNM=2-473 DS 1C DISP
DNM=2-490 01 ABS.LIN BL=3 060 DNM=2-490 DS 2C COMP
DNM=3-000 01 LIN.NUM BL=3 068 DNM=3-000 DS 2P COMP-3
DNM=3-017 77 -0002 BL=3 06A DNM=3-017 DS 4C DISP-NM
DNM=3-032 77 -0003 BL=3 06E DNM=3-032 DS 4C DISP-NM
DNM=3-050 01 LINE-COUNTER BL=3 078 DNM=3-050 DS 3P COMP-3
DNM=3-072 01 PAGE-COUNTER BL=3 080 DNM=3-072 DS 3P COMP-3
DNM=3-094 01 RPT.RCD BL=3 088 DNM=3-094 DS 0CL133 GROUP
DNM=3-114 02 CTL.CHR BL=3 088 DNM=3-114 DS 1C DISP
DNM=3-131 02 RPT.LIN BL=3 089 DNM=3-131 DS 132C DISP
DNM=3-148 02 E.0001 BL=3 0A3 DNM=3-148 DS 41C DISP R
DNM=3-164 02 E.0002 BL=3 0E2 DNM=3-164 DS 4C DISP R
DNM=3-183 02 E.0003 BL=3 0E7 DNM=3-183 DS 5C NM-EDIT R
DNM=3-206 02 E.0004 BL=3 089 DNM=3-206 DS 9C DISP R
DNM=3-222 02 E.0005 BL=3 097 DNM=3-222 DS 10C DISP R
DNM=3-238 02 E.0006 BL=3 0A6 DNM=3-238 DS 5C DISP R
========================================================================================================================
5
INTRNL NAME LVL SOURCE NAME BASE DISPL INTRNL NAME DEFINITION USAGE R O Q M
DNM=3-254 02 E.0007 BL=3 0AF DNM=3-254 DS 8C DISP R
DNM=3-270 02 E.0008 BL=3 0BB DNM=3-270 DS 9C DISP R
DNM=3-286 02 E.0009 BL=3 0C8 DNM=3-286 DS 8C DISP R
DNM=3-302 02 E.0010 BL=3 0D4 DNM=3-302 DS 11C DISP R
DNM=3-318 02 E.0011 BL=3 0E3 DNM=3-318 DS 6C DISP R
DNM=3-334 02 E.0012 BL=3 08B DNM=3-334 DS 4C NM-EDIT R
DNM=3-355 02 E.0013 BL=3 092 DNM=3-355 DS 16C DISP R
DNM=3-371 02 E.0014 BL=3 0A8 DNM=3-371 DS 1C DISP-NM R
DNM=3-387 02 E.0015 BL=3 0B0 DNM=3-387 DS 5C DISP-NM R
DNM=3-403 02 E.0016 BL=3 0BB DNM=3-403 DS 7C NM-EDIT R
DNM=3-428 02 E.0017 BL=3 0CB DNM=3-428 DS 2C DISP-NM R
DNM=3-444 02 E.0018 BL=3 0CD DNM=3-444 DS 1C DISP R
DNM=3-460 02 E.0019 BL=3 0D6 DNM=3-460 DS 7C NM-EDIT R
DNM=3-485 02 E.0020 BL=3 0E5 DNM=3-485 DS 7C NM-EDIT R
DNM=4-000 02 E.0021 BL=3 0E4 DNM=4-000 DS 8C NM-EDIT R
DNM=4-025 02 E.0022 BL=3 0ED DNM=4-025 DS 1C DISP R
DNM=4-041 01 N.0001 BL=3 110 DNM=4-041 DS 2C COMP
DNM=4-057 01 N.0002 BL=3 118 DNM=4-057 DS 2C COMP
DNM=4-073 01 GRP.IND BL=3 120 DNM=4-073 DS 0CL1 GROUP
DNM=4-093 02 GP.0000 BL=3 120 DNM=4-093 DS 1C DISP
DNM=4-110 01 S.0001 BL=3 128 DNM=4-110 DS 4P COMP-3
========================================================================================================================
6
CONDENSED LISTING
120 OPEN 000EF6 123 INITIATE 000F66 125 READ 000F6C
127 MOVE 000F8C 130 PERFORM 000F92 134 TERMINATE 000FBC
136 CLOSE 000FC2 139 STOP 00103E 142 SET 001044
143 COMPUTE 001058 145 COMPUTE 0010A6 147 GENERATE 0010C2
148 READ 0010C8 150 MOVE 0010E8 154 EXIT 0010EE
*STATISTICS* SOURCE RECORDS = 156 DATA DIVISION STATEMENTS = 35 PROCEDURE DIVISION STATEMENTS = 15
*OPTIONS IN EFFECT* SIZE = 3145728 BUF = 1048576 LINECNT = 57 SPACE1, FLAGW, SEQ, SOURCE
*OPTIONS IN EFFECT* DMAP, NOPMAP, CLIST, SUPMAP, NOXREF, LOAD, NODECK, APOST, NOTRUNC, NOLIB, VERB
*OPTIONS IN EFFECT* ZWB
========================================================================================================================
CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE
152 J. LANGDON 8 87653 $24.75 09% $2.23 $22.52
152 J. LANGDON 6 64025 $9.45 22% $2.08 $7.37
152 J. LANGDON 4 41915 $13.70 15% $2.06 $11.64
152 J. LANGDON 1 17410 $2.51 05% $.13 $2.38
$43.91 *
2468 L. MORRISEY 1 18520 $3.75 05% $.19 $3.56
2468 L. MORRISEY 2 20012 $4.20 07% $.29 $3.91
2468 L. MORRISEY 3 31572 $10.15 10% $1.02 $9.13
2468 L. MORRISEY 4 48792 $37.50 15% $5.63 $31.87
2468 L. MORRISEY 5 50407 $15.15 06% $.91 $14.24
2468 L. MORRISEY 6 61575 $20.10 22% $4.42 $15.68
2468 L. MORRISEY 7 79204 $51.70 12% $6.20 $45.50
2468 L. MORRISEY 8 85075 $37.84 09% $3.41 $34.43
2468 L. MORRISEY 9 98476 $87.94 20% $17.59 $70.35
$228.67 *
3451 M. JACKSON 3 37847 $27.90 10% $2.79 $25.11
3451 M. JACKSON 5 58492 $68.50 06% $4.11 $64.39
3451 M. JACKSON 6 60010 $20.40 22% $4.49 $15.91
3451 M. JACKSON 8 85260 $78.52 09% $7.07 $71.45
3451 M. JACKSON 9 90520 $27.52 20% $5.50 $22.02
$198.88 *
4512 S. LEVITT 2 24680 $30.50 07% $2.14 $28.36
4512 S. LEVITT 5 56784 $52.53 06% $3.15 $49.38
4512 S. LEVITT 6 60410 $12.15 22% $2.67 $9.48
4512 S. LEVITT 7 78952 $89.25 12% $10.71 $78.54
4512 S. LEVITT 8 85278 $49.75 09% $4.48 $45.27
4512 S. LEVITT 8 87492 $64.25 09% $5.78 $58.47
4512 S. LEVITT 9 97204 $84.75 20% $16.95 $67.80
$337.30 *
5417 K. CONKLIN 1 13579 $35.72 05% $1.79 $33.93
5417 K. CONKLIN 2 24615 $18.75 07% $1.31 $17.44
5417 K. CONKLIN 3 34928 $37.45 10% $3.75 $33.70
5417 K. CONKLIN 4 48527 $87.50 15% $13.13 $74.37
5417 K. CONKLIN 5 50150 $18.95 06% $1.14 $17.81
5417 K. CONKLIN 5 54652 $38.92 06% $2.34 $36.58
5417 K. CONKLIN 5 59765 $98.95 06% $5.94 $93.01
5417 K. CONKLIN 7 71572 $18.95 12% $2.27 $16.68
5417 K. CONKLIN 8 85175 $80.10 09% $7.21 $72.89
5417 K. CONKLIN 9 90275 $4.60 20% $.92 $3.68
5417 K. CONKLIN 9 91572 $18.57 20% $3.71 $14.86
5417 K. CONKLIN 9 97576 $84.95 20% $16.99 $67.96
$482.91 *
6213 Z. HAMPTON 1 15792 $64.25 05% $3.21 $61.04
6213 Z. HAMPTON 1 19975 $98.75 05% $4.94 $93.81
6213 Z. HAMPTON 3 34576 $51.15 10% $5.12 $46.03
6213 Z. HAMPTON 4 49512 $85.20 15% $12.78 $72.42
$273.30 *
7545 M. LARSON 1 14676 $38.45 05% $1.92 $36.53
========================================================================================================================
C U S T O M E R C H A R G E R E P O R T PAGE 2
CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE
7545 M. LARSON 1 18592 $82.51 05% $4.13 $78.38
7545 M. LARSON 1 19994 $98.98 05% $4.95 $94.03
7545 M. LARSON 2 21214 $15.15 07% $1.06 $14.09
7545 M. LARSON 3 37515 $82.12 10% $8.21 $73.91
7545 M. LARSON 3 38592 $96.15 10% $9.62 $86.53
7545 M. LARSON 4 48485 $87.14 15% $13.07 $74.07
7545 M. LARSON 5 52762 $37.92 06% $2.28 $35.64
7545 M. LARSON 5 57684 $80.15 06% $4.81 $75.34
7545 M. LARSON 7 79015 $96.25 12% $11.55 $84.70
7545 M. LARSON 8 80123 $5.60 09% $.50 $5.10
7545 M. LARSON 8 82462 $20.15 09% $1.81 $18.34
7545 M. LARSON 9 91520 $18.15 20% $3.63 $14.52
7545 M. LARSON 9 93715 $40.15 20% $8.03 $32.12
$723.30 *
========================================================================================================================