CB545 V2 LVL78 01MAY72                 IBM OS AMERICAN NATIONAL STANDARD COBOL                       DATE FEB 27,1983
   1
00001   000100 IDENTIFICATION DIVISION.
00002   000200 PROGRAM-ID. RWEX04.
00003   000300 AUTHOR. JAY MOSELEY.
00004   000400 DATE-WRITTEN. APRIL, 2008.
00005   000410* ************************************************************* *
00006   000412* * MODIFICATIONS:                                              *
00007   000414* * ADDED GROUP ITEM TO INPUT RECORD DEFINITION AND CHANGED     * 20110227
00008   000416* * REPORT SECTION REFERENCES TO ELEMENTS UNDER GROUP TO FIX    * 20110227
00009   000418* * MISMATCHED CUSTOMER NAME/NUMBER ON REPORT.                  * 20110227
00010   000420* ************************************************************* *
00011   000500 DATE-COMPILED. FEB 27,1983
00013   000700* ************************************************************* *
00014   000800* REPORT WRITER EXAMPLE #4.                                     *
00015   000900* ************************************************************* *
00017   001100 ENVIRONMENT DIVISION.
00018   001200 CONFIGURATION SECTION.
00019   001300 SOURCE-COMPUTER. IBM-370.
00020   001400 OBJECT-COMPUTER. IBM-370.
00021   001500
00022   001600 INPUT-OUTPUT SECTION.
00023   001700 FILE-CONTROL.
00024   001800
00025   001900     SELECT TRANSACTION-DATA
00026   002000         ASSIGN TO UT-S-DATAIN.
00027   002100
00028   002200     SELECT REPORT-FILE
00029   002300         ASSIGN TO UR-S-SYSPRINT.
00030   002400
00031   002500 DATA DIVISION.
00032   002600 FILE SECTION.
00033   002700
00034   002800 FD  TRANSACTION-DATA
00035   002900     LABEL RECORDS ARE OMITTED
00036   003000     BLOCK CONTAINS 0 RECORDS
00037   003100     RECORD CONTAINS 80 CHARACTERS
00038   003200     DATA RECORD IS TRANSACTION-RECORD.
00039   003300
00040   003400 01  TRANSACTION-RECORD.
00041   003410     03  TR-CUSTOMER.                                             20110227
00042   003500         05  TR-CUSTOMER-NUMBER  PIC 9(04).                       20110227
00043   003600         05  FILLER              PIC X(01).                       20110227
00044   003700         05  TR-CUSTOMER-NAME    PIC X(16).                       20110227
00045   003800     03  FILLER                  PIC X(01).
00046   003900     03  TR-ITEM-NUMBER          PIC 9(05).
00047   004000     03  FILLER                  REDEFINES TR-ITEM-NUMBER.
00048   004100         05  TR-ITEM-DEPARTMENT  PIC 9(01).
00049   004200         05  FILLER              PIC 9(04).
00050   004300     03  FILLER                  PIC X(01).
00051   004400     03  TR-ITEM-COST            PIC 9(03)V99.
00052   004500     03  FILLER                  PIC X(47).
00053   004600
00054   004700 FD  REPORT-FILE
00055   004800     LABEL RECORDS ARE OMITTED
00056   004900     REPORT IS CUSTOMER-REPORT.
========================================================================================================================
   2
00057   005000
00058   005100 WORKING-STORAGE SECTION.
00059   005200 77  END-OF-FILE-SWITCH          PIC X(1)    VALUE 'N'.
00060   005300     88  END-OF-FILE                         VALUE 'Y'.
00061   005400
00062   005500 01  DISCOUNT-TABLE.
00063   005600     02  FILLER                  PIC 99      VALUE 05.
00064   005700     02  FILLER                  PIC 99      VALUE 07.
00065   005800     02  FILLER                  PIC 99      VALUE 10.
00066   005900     02  FILLER                  PIC 99      VALUE 15.
00067   006000     02  FILLER                  PIC 99      VALUE 06.
00068   006100     02  FILLER                  PIC 99      VALUE 22.
00069   006200     02  FILLER                  PIC 99      VALUE 12.
00070   006300     02  FILLER                  PIC 99      VALUE 09.
00071   006400     02  FILLER                  PIC 99      VALUE 20.
00072   006500 01  FILLER                      REDEFINES DISCOUNT-TABLE.
00073   006600     02  DISCOUNT                OCCURS 9 TIMES
00074   006700                                 INDEXED BY DISCOUNT-IX
00075   006800                                 PIC V99.
00076   006900
00077   007000 01  CALCULATED-FIELDS.
00078   007100     03  WS-DISCOUNT-AMT         PIC 9(3)V99.
00079   007200     03  WS-CHARGE-AMT           PIC 9(3)V99.
00080   007300
00081   007400 REPORT SECTION.
00082   007500 RD  CUSTOMER-REPORT
00083   007600     CONTROLS ARE FINAL, TR-CUSTOMER
00084   007700     PAGE LIMIT IS 66 LINES
00085   007800     HEADING 1
00086   007900     FIRST DETAIL 5
00087   008000     LAST DETAIL 58.
00088   008100
00089   008200 01  PAGE-HEAD-GROUP TYPE PAGE HEADING.
00090   008300     02  LINE 1.
00091   008400         03  COLUMN 27   PIC X(41) VALUE
00092   008500             'C U S T O M E R  C H A R G E  R E P O R T'.
00093   008600         03  COLUMN 90   PIC X(04) VALUE 'PAGE'.
00094   008700         03  COLUMN 95   PIC ZZZZ9 SOURCE PAGE-COUNTER.
00095   008800     02  LINE PLUS 2.
00096   008900         03  COLUMN 01   PIC X(09) VALUE 'CUST. NO.'.
00097   009000         03  COLUMN 15   PIC X(10) VALUE 'CUST. NAME'.
00098   009100         03  COLUMN 51   PIC X(09) VALUE 'ITEM COST'.
00099   009200         03  COLUMN 76   PIC X(11) VALUE 'DISCT. AMT.'.
00100   009300         03  COLUMN 91   PIC X(06) VALUE 'CHARGE'.
00101   009400
00102   009500 01  CHARGE-DETAIL TYPE DETAIL.
00103   009600     02  LINE PLUS 1.
00104   009700         03  COLUMN 51   PIC $$$$.99 SOURCE TR-ITEM-COST.
00105   009800         03  COLUMN 78   PIC $$$$.99 SOURCE WS-DISCOUNT-AMT.
00106   009900         03  COLUMN 93   PIC $$$$.99 SOURCE WS-CHARGE-AMT.
00107   010000
00108   010100 01  CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER              20110227
00109   010200     NEXT GROUP IS PLUS 2.
00110   010300     02  LINE PLUS 1.
00111   010400         03  COLUMN 03   PIC Z(04) SOURCE TR-CUSTOMER-NUMBER.
00112   010500         03  COLUMN 10   PIC X(16) SOURCE TR-CUSTOMER-NAME.
00113   010600         03  COLUMN 50   PIC $$$$$.99 SUM TR-ITEM-COST.
========================================================================================================================
   3
00114   010700         03  COLUMN 77   PIC $$$$$.99 SUM WS-DISCOUNT-AMT.
00115   010800         03  COLUMN 92   PIC $$$$$.99 SUM WS-CHARGE-AMT.
00116   010900
00117   011000 01  FINAL-TOTAL TYPE CONTROL FOOTING FINAL.
00118   011100     02  LINE PLUS 1.
00119   011200         03  COLUMN 10   PIC X(12) VALUE 'GRAND TOTALS'.
00120   011300         03  COLUMN 48   PIC $$$,$$$.99 SUM TR-ITEM-COST.
00121   011400         03  COLUMN 59   PIC X VALUE '*'.
00122   011500         03  COLUMN 75   PIC $$$,$$$.99 SUM WS-DISCOUNT-AMT.
00123   011600         03  COLUMN 86   PIC X VALUE '*'.
00124   011700         03  COLUMN 90   PIC $$$,$$$.99 SUM WS-CHARGE-AMT.
00125   011800         03  COLUMN 101  PIC X VALUE '*'.
00126   011900
00127   012000 PROCEDURE DIVISION.
00128   012100
00129   012200 000-INITIATE.
00130   012300
00131   012400     OPEN INPUT TRANSACTION-DATA,
00132   012500          OUTPUT REPORT-FILE.
00133   012600
00134   012700     INITIATE CUSTOMER-REPORT.
00135   012800
00136   012900     READ TRANSACTION-DATA
00137   013000         AT END
00138   013100             MOVE 'Y' TO END-OF-FILE-SWITCH.
00139   013200*    END-READ.
00140   013300
00141   013400     PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT
00142   013500         UNTIL END-OF-FILE.
00143   013600
00144   013700 000-TERMINATE.
00145   013800     TERMINATE CUSTOMER-REPORT.
00146   013900
00147   014000     CLOSE TRANSACTION-DATA,
00148   014100           REPORT-FILE.
00149   014200
00150   014300     STOP RUN.
00151   014400
00152   014500 100-PROCESS-TRANSACTION-DATA.
00153   014600     SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT.
00154   014700     COMPUTE WS-DISCOUNT-AMT ROUNDED =
00155   014800         TR-ITEM-COST * DISCOUNT (DISCOUNT-IX).
00156   014900     COMPUTE WS-CHARGE-AMT =
00157   015000         TR-ITEM-COST - WS-DISCOUNT-AMT.
00158   015100     GENERATE CUSTOMER-REPORT.
00159   015200     READ TRANSACTION-DATA
00160   015300       AT END
00161   015400             MOVE 'Y' TO END-OF-FILE-SWITCH.
00162   015500*    END-READ.
00163   015600
00164   015700 199-EXIT.
00165   015800     EXIT.
00166   015900
00167   016000
========================================================================================================================
   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                     BL=1     000   DNM=1-181     DS 0CL21     GROUP
       DNM=1-208     03  TR-CUSTOMER-NUMBER              BL=1     000   DNM=1-208     DS 4C        DISP-NM
       DNM=1-236     03  FILLER                          BL=1     004   DNM=1-236     DS 1C        DISP
       DNM=1-252     03  TR-CUSTOMER-NAME                BL=1     005   DNM=1-252     DS 16C       DISP
       DNM=1-278     02  FILLER                          BL=1     015   DNM=1-278     DS 1C        DISP
       DNM=1-297     02  TR-ITEM-NUMBER                  BL=1     016   DNM=1-297     DS 5C        DISP-NM
       DNM=1-321     02  FILLER                          BL=1     016   DNM=1-321     DS 0CL5      GROUP      R
       DNM=1-343     03  TR-ITEM-DEPARTMENT              BL=1     016   DNM=1-343     DS 1C        DISP-NM
       DNM=1-371     03  FILLER                          BL=1     017   DNM=1-371     DS 4C        DISP-NM
       DNM=1-390     02  FILLER                          BL=1     01B   DNM=1-390     DS 1C        DISP
       DNM=1-409     02  TR-ITEM-COST                    BL=1     01C   DNM=1-409     DS 5C        DISP-NM
       DNM=1-431     02  FILLER                          BL=1     021   DNM=1-431     DS 47C       DISP
       DNM=1-450     FD  REPORT-FILE                    DCB=02          DNM=1-450                  QSAM                F
       DNM=1-474     01  -0001                           BL=2     000   DNM=1-474     DS 133C      DISP
       DNM=2-000     77  END-OF-FILE-SWITCH              BL=3     000   DNM=2-000     DS 1C        DISP
       DNM=2-031     88  END-OF-FILE                                    DNM=2-031
       DNM=2-053     01  DISCOUNT-TABLE                  BL=3     008   DNM=2-053     DS 0CL18     GROUP
       DNM=2-080     02  FILLER                          BL=3     008   DNM=2-080     DS 2C        DISP-NM
       DNM=2-099     02  FILLER                          BL=3     00A   DNM=2-099     DS 2C        DISP-NM
       DNM=2-118     02  FILLER                          BL=3     00C   DNM=2-118     DS 2C        DISP-NM
       DNM=2-137     02  FILLER                          BL=3     00E   DNM=2-137     DS 2C        DISP-NM
       DNM=2-156     02  FILLER                          BL=3     010   DNM=2-156     DS 2C        DISP-NM
       DNM=2-175     02  FILLER                          BL=3     012   DNM=2-175     DS 2C        DISP-NM
       DNM=2-194     02  FILLER                          BL=3     014   DNM=2-194     DS 2C        DISP-NM
       DNM=2-213     02  FILLER                          BL=3     016   DNM=2-213     DS 2C        DISP-NM
       DNM=2-232     02  FILLER                          BL=3     018   DNM=2-232     DS 2C        DISP-NM
       DNM=2-251     01  FILLER                          BL=3     008   DNM=2-251     DS 0CL18     GROUP      R
       DNM=2-273         DISCOUNT-IX                                    DNM=2-273                  INDEX-NM
       DNM=2-291     02  DISCOUNT                        BL=3     008   DNM=2-291     DS 2C        DISP-NM       O
       DNM=2-309     01  CALCULATED-FIELDS               BL=3     020   DNM=2-309     DS 0CL10     GROUP
       DNM=2-339     02  WS-DISCOUNT-AMT                 BL=3     020   DNM=2-339     DS 5C        DISP-NM
       DNM=2-364     02  WS-CHARGE-AMT                   BL=3     025   DNM=2-364     DS 5C        DISP-NM
       DNM=2-387     01  PRINT-SWITCH                    BL=3     030   DNM=2-387     DS 1C        DISP-NM
       DNM=2-409     RD  CUSTOMER-REPORT                                DNM=2-409
       DNM=2-436     01  CTL.LVL                         BL=3     038   DNM=2-436     DS 2P        COMP-3
       DNM=2-453     01  TER.COD                         BL=3     040   DNM=2-453     DS 1C        DISP
       DNM=2-470     01  FRS.GEN                         BL=3     048   DNM=2-470     DS 1C        DISP
       DNM=2-487     01  LIN.SAV                         BL=3     050   DNM=2-487     DS 2C        COMP
       DNM=3-000     01  FRS.GRP                         BL=3     058   DNM=3-000     DS 1C        DISP
       DNM=3-017     01  ABS.LIN                         BL=3     060   DNM=3-017     DS 2C        COMP
       DNM=3-034     01  LIN.NUM                         BL=3     068   DNM=3-034     DS 2P        COMP-3
       DNM=3-051     77  -0002                           BL=3     06A   DNM=3-051     DS 21C       DISP
       DNM=3-066     77  -0003                           BL=3     07F   DNM=3-066     DS 21C       DISP
       DNM=3-084     01  LINE-COUNTER                    BL=3     098   DNM=3-084     DS 3P        COMP-3
       DNM=3-106     01  PAGE-COUNTER                    BL=3     0A0   DNM=3-106     DS 3P        COMP-3
       DNM=3-128     01  RPT.RCD                         BL=3     0A8   DNM=3-128     DS 0CL133    GROUP
       DNM=3-148     02  CTL.CHR                         BL=3     0A8   DNM=3-148     DS 1C        DISP
       DNM=3-165     02  RPT.LIN                         BL=3     0A9   DNM=3-165     DS 132C      DISP
       DNM=3-182     02  E.0001                          BL=3     0C3   DNM=3-182     DS 41C       DISP       R
       DNM=3-198     02  E.0002                          BL=3     102   DNM=3-198     DS 4C        DISP       R
       DNM=3-217     02  E.0003                          BL=3     107   DNM=3-217     DS 5C        NM-EDIT    R
       DNM=3-240     02  E.0004                          BL=3     0A9   DNM=3-240     DS 9C        DISP       R
       DNM=3-256     02  E.0005                          BL=3     0B7   DNM=3-256     DS 10C       DISP       R
========================================================================================================================
   5
       INTRNL NAME   LVL SOURCE NAME                     BASE   DISPL   INTRNL NAME   DEFINITION   USAGE      R  O  Q  M
       DNM=3-272     02  E.0006                          BL=3     0DB   DNM=3-272     DS 9C        DISP       R
       DNM=3-288     02  E.0007                          BL=3     0F4   DNM=3-288     DS 11C       DISP       R
       DNM=3-304     02  E.0008                          BL=3     103   DNM=3-304     DS 6C        DISP       R
       DNM=3-320     02  E.0009                          BL=3     0DB   DNM=3-320     DS 7C        NM-EDIT    R
       DNM=3-345     02  E.0010                          BL=3     0F6   DNM=3-345     DS 7C        NM-EDIT    R
       DNM=3-370     02  E.0011                          BL=3     105   DNM=3-370     DS 7C        NM-EDIT    R
       DNM=3-395     02  E.0012                          BL=3     0AB   DNM=3-395     DS 4C        NM-EDIT    R
       DNM=3-416     02  E.0013                          BL=3     0B2   DNM=3-416     DS 16C       DISP       R
       DNM=3-432     02  E.0014                          BL=3     0DA   DNM=3-432     DS 8C        NM-EDIT    R
       DNM=3-457     02  E.0015                          BL=3     0F5   DNM=3-457     DS 8C        NM-EDIT    R
       DNM=3-482     02  E.0016                          BL=3     104   DNM=3-482     DS 8C        NM-EDIT    R
       DNM=4-000     02  E.0017                          BL=3     0B2   DNM=4-000     DS 12C       DISP       R
       DNM=4-016     02  E.0018                          BL=3     0D8   DNM=4-016     DS 10C       NM-EDIT    R
       DNM=4-045     02  E.0019                          BL=3     0E3   DNM=4-045     DS 1C        DISP       R
       DNM=4-061     02  E.0020                          BL=3     0F3   DNM=4-061     DS 10C       NM-EDIT    R
       DNM=4-090     02  E.0021                          BL=3     0FE   DNM=4-090     DS 1C        DISP       R
       DNM=4-106     02  E.0022                          BL=3     102   DNM=4-106     DS 10C       NM-EDIT    R
       DNM=4-135     02  E.0023                          BL=3     10D   DNM=4-135     DS 1C        DISP       R
       DNM=4-151     01  N.0001                          BL=3     130   DNM=4-151     DS 2C        COMP
       DNM=4-167     01  N.0002                          BL=3     138   DNM=4-167     DS 2C        COMP
       DNM=4-183     01  N.0003                          BL=3     140   DNM=4-183     DS 2C        COMP
       DNM=4-202     01  GRP.IND                         BL=3     148   DNM=4-202     DS 0CL1      GROUP
       DNM=4-222     02  GP.0000                         BL=3     148   DNM=4-222     DS 1C        DISP
       DNM=4-239     01  S.0001                          BL=3     150   DNM=4-239     DS 4P        COMP-3
       DNM=4-255     01  S.0002                          BL=3     158   DNM=4-255     DS 4P        COMP-3
       DNM=4-271     01  S.0003                          BL=3     160   DNM=4-271     DS 4P        COMP-3
       DNM=4-287     01  S.0004                          BL=3     168   DNM=4-287     DS 4P        COMP-3
       DNM=4-306     01  S.0005                          BL=3     170   DNM=4-306     DS 4P        COMP-3
       DNM=4-322     01  S.0006                          BL=3     178   DNM=4-322     DS 4P        COMP-3
========================================================================================================================
   6

                                                  CONDENSED LISTING
 131     OPEN       001112                    134     INITIATE   001182                    136     READ       001188
 138     MOVE       0011A8                    141     PERFORM    0011AE                    145     TERMINATE  0011D8
 147     CLOSE      0011DE                    150     STOP       00125A                    153     SET        001260
 154     COMPUTE    001274                    156     COMPUTE    0012C2                    158     GENERATE   0012DE
 159     READ       0012F0                    161     MOVE       001310                    165     EXIT       001316

*STATISTICS*     SOURCE RECORDS =   167     DATA DIVISION STATEMENTS =    37     PROCEDURE DIVISION STATEMENTS =    15
*OPTIONS IN EFFECT*     SIZE = 2097152  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                          ITEM COST                DISCT. AMT.    CHARGE
   152   J. LANGDON                                $50.41                      $6.50         $43.91
  2468   L. MORRISEY                              $268.33                     $39.66        $228.67
  3451   M. JACKSON                               $222.84                     $23.96        $198.88
  4512   S. LEVITT                                $383.18                     $45.88        $337.30
  5417   K. CONKLIN                               $543.41                     $60.50        $482.91
  6213   Z. HAMPTON                               $299.35                     $26.05        $273.30
  7545   M. LARSON                                $798.87                     $75.57        $723.30

         GRAND TOTALS                           $2,566.39 *                  $278.12 *    $2,288.27 *

========================================================================================================================