Sample COBOL Input and DDDL Output › Sample COBOL Input and DDDL Output
Sample COBOL Input and DDDL Output
001000 ID DIVISION.
002000 PROGRAM-ID. PRANDEM1.
003000 AUTHOR. CA, INC.
004000 REMARKS. SAMPLE PROGRAM CONTAINING FILES
005000 CUSTOMER-FILE, ORDER-FILE, AND RPTFILE.
006000 CUSTOMER-FILE AND ORDER-FILE HAVE BEEN
007000 SORTED ON CUSTOMER NUMBER. THIS
008000 PROGRAM MATCHES ORDERS TO THE CUSTOMER
009000 AND PRODUCES A REPORT OF ALL ORDERS
010000 FOR ALL CUSTOMERS.
011000
012000 ENVIRONMENT DIVISION.
013000 INPUT-OUTPUT SECTION.
014000 FILE-CONTROL.
015000 SELECT CUSTOMER-FILE ASSIGN UT-2400-S-CUSTIN.
016000 SELECT ORDER-FILE ASSIGN UT-2400-S-ORDERIN.
017000 SELECT RPTFILE ASSIGN UT-S-SYSLST.
018000
019000 DATA DIVISION.
020000 FILE SECTION.
021000 FD RPTFILE
022000 RECORDING MODE F
023000 LABEL RECORDS ARE OMITTED
024000 RECORD CONTAINS 133
025000 DATA RECORDS ARE TITLE-REC DETAIL-REC.
026000
027000 01 TITLE-REC PIC X(133).
028000 01 DETAIL-REC.
029000 05 FILLER PIC X.
030000 05 RPT-CUST-NO PIC X(10).
031000 05 FILLER PIC XXX.
032000 05 RPT-NAME PIC X(20).
033000 05 FILLER PIC X(5).
034000 05 RPT-ORD-IDENT.
035000 10 RPT-ORD PIC X(7).
036000 10 FILLER PIC XXX.
037000 05 RPT-DATE-REQ PIC X(8).
038000 05 FILLER PIC X(76).
039000
040000 FD CUSTOMER-FILE
041000 RECORDING MODE F
042000 LABEL RECORDS ARE OMITTED
043000 RECORD CONTAINS 104 CHARACTERS
044000 DATA RECORD IS CUSTOMER.
045000
046000 01 CUSTOMER.
047000 03 CUST-NUMBER PIC X(10).
048000 03 CUST-NAME PIC X(20).
049000 03 CUST-ADDRESS.
050000 05 CUST-ADDR1 PIC X(20).
051000 05 CUST-ADDR2.
052000 06 CUST-CITY PIC X(15).
053000 06 CUST-ZIP-CODE PIC X(5).
054000 06 CUST-ZIPCODE REDEFINES CUST-ZIP-CODE
055000 PIC 9(5).
056000 03 CUST-CREDIT PIC XXX.
057000 88 CUST-CREDIT-EXEC VALUE IS 'AAA'.
058000 88 CUST-CREDIT-GOOD VALUE IS ' '.
059000 88 CUST-CREDIT-POOR VALUE IS 'XXX'.
060000 03 CUST-SALES-INFO.
061000 05 CUST-SALES-QTR OCCURS 4 TIMES.
062000 06 CUST-NUM-SALES PIC 9(5) COMP-3.
063000 06 CUST-AMT-SALES PIC S9(7) COMP-3.
064000 03 FILLER PIC XXX.
065000
066000
067000 FD ORDER-FILE
068000 RECORDING MODE F
069000 LABEL RECORDS ARE OMITTED
070000 RECORD CONTAINS 50 CHARACTERS
071000 BLOCK CONTAINS 100 RECORDS
072000 DATA RECORD IS ORDOR.
073000
074000 01 ORDOR.
075000 03 ORD-CUST-NUMBER PIC X(10).
076000 03 ORD-NUMBER PIC X(7).
077000 03 ORD-CUST-PO-NUMB PIC X(10).
078000 03 ORD-DATES.
079000 05 ORD-REQ-DATE PIC X(6).
080000 05 ORD-DATE-REQ REDEFINES ORD-REQ-DATE
081000 PIC 9(6).
082000 05 ORD-PROM-DATE PIC X(6).
083000 05 ORD-DATE-PROM REDEFINES ORD-PROM-DATE
084000 PIC 9(6).
085000 05 ORD-SHIPPED-DATE PIC X(6).
086000 05 ORD-DATE-SHIPPED REDEFINES ORD-SHIPPED-DATE
087000 PIC 9(6).
088000 03 ORD-SHIP-CODE PIC XX.
089000 88 ORD-SHIP-ALL VALUE IS 'AS'.
090000 88 ORD-SHIP-PART VALUE IS 'PS'.
091000 03 FILLER PIC XXX.
092000
093000
094000 WORKING-STORAGE SECTION.
095000
096000 01 PAGE-COUNT-WS PIC S99 VALUE +0.
097000 01 POSITION-IND-WS PIC X.
098000 01 PAGE-INCREMENT-WS PIC 9.
099000
100000 01 DATE-AS-INPUT-WS.
101000 05 INPUT-YY-WS PIC 99.
102000 05 INPUT-MM-WS PIC 99.
103000 05 INPUT-DD-WS PIC 99.
104000 01 DATE-FORMATTED-WS.
105000 05 FORMATTED-MM-WS PIC 99.
106000 05 FILLER PIC X VALUE '/'.
107000 05 FORMATTED-DD-WS PIC 99.
108000 05 FILLER PIC X VALUE '/'.
109000 05 FORMATTED-YY-WS PIC 99.
110000
111000 01 TITLE-1-WS.
112000 05 FILLER PIC X(52) VALUE SPACES.
113000 05 FILLER PIC X(29) VALUE
114000 'ORDER INFORMATION BY CUSTOMER'.
115000 05 FILLER PIC X(52) VALUE SPACES.
116000 01 TITLE-2-WS.
117000 05 FILLER PIC X(18) VALUE ' CUSTOMER NO '.
118000 05 FILLER PIC X(22) VALUE 'CUSTOMER NAME '.
119000 05 FILLER PIC X(9) VALUE 'ORDER '.
120000 05 FILLER PIC X(12) VALUE 'DATE REQ '.
121000 05 FILLER PIC X(72) VALUE SPACES.
122000
123000
124000 PROCEDURE DIVISION.
125000
126000 0100-HOUSEKEEPING.
127000 OPEN INPUT CUSTOMER-FILE.
128000 OPEN INPUT ORDER-FILE.
129000 OPEN OUTPUT RPTFILE.
130000 MOVE SPACES TO DETAIL-REC.
131000 MOVE SPACES TO CUST-NUMBER.
132000
133000 0200-GET-ORDER-INFO.
134000 READ ORDER-FILE RECORD
135000 AT END GO TO 9200-EOJ.
136000
137000 0300-GET-CUST-INFO.
138000 IF ORD-CUST-NUMBER = CUST-NUMBER
139000 GO TO 0500-GET-ORDER-INFO.
140000
141000 READ CUSTOMER-FILE RECORD
142000 AT END GO TO 9200-EOJ.
143000
144000 MOVE CUST-NUMBER TO RPT-CUST-NO.
145000 MOVE CUST-NAME TO RPT-NAME.
146000
147000 0500-GET-ORDER-INFO.
148000 MOVE ORD-NUMBER TO RPT-ORD.
149000 MOVE ORD-DATE-REQ TO DATE-AS-INPUT-WS.
150000 MOVE INPUT-YY-WS TO FORMATTED-YY-WS.
151000 MOVE INPUT-MM-WS TO FORMATTED-MM-WS.
152000 MOVE INPUT-DD-WS TO FORMATTED-DD-WS.
153000 MOVE DATE-FORMATTED-WS TO RPT-DATE-REQ.
154000
155000 PERFORM 9000-WRITE THRU 9010-EXIT.
156000 GO TO 0300-GET-CUST-INFO.
157000
158000* THIS PARAGRAPH CAUSES A REPORT FILE RECORD TO BE WRITTEN.
159000* IT CONTROLS SPACING AND PAGING OF THE REPORT.
160000
161000 9000-WRITE.
162000 MOVE ' ' TO POSITION-IND-WS.
163000 MOVE 1 TO PAGE-INCREMENT-WS.
164000 IF RPT-ORD NOT = SPACES MOVE '0' TO POSITION-IND-WS
165000 MOVE 2 TO PAGE-INCREMENT-WS.
166000 IF RPT-CUST-NO NOT = SPACES MOVE '-' TO POSITION-IND-WS
167000 MOVE 3 TO PAGE-INCREMENT-WS.
168000 WRITE DETAIL-REC AFTER POSITIONING POSITION-IND-WS.
169000 MOVE SPACES TO DETAIL-REC.
170000 ADD PAGE-INCREMENT-WS TO PAGE-COUNT-WS.
171000 IF PAGE-COUNT-WS GREATER THAN +58
172000 PERFORM 9100-NEW-PAGE THRU 9110-EXIT.
173000 9010-EXIT.
174000 EXIT.
175000
176000 9100-NEW-PAGE.
177000 WRITE TITLE-REC FROM TITLE-1-WS AFTER POSITIONING 0.
178000 MOVE SPACES TO TITLE-REC.
179000 WRITE TITLE-REC FROM TITLE-2-WS AFTER POSITIONING 3.
180000 MOVE SPACES TO TITLE-REC.
181000 MOVE +4 TO PAGE-COUNT-WS.
182000 9110-EXIT.
183000 EXIT.
184000
185000* CLOSE THE FILES AND EXIT FROM THE PROGRAM.
186000
187000 9200-EOJ.
188000 CLOSE CUSTOMER-FILE.
189000 CLOSE ORDER-FILE.
190000 CLOSE RPTFILE.
191000 9210-EXIT.
192000 STOP RUN.
193000
001000 ID DIVISION.
002000 PROGRAM-ID. PRANDEM2.
003000 AUTHOR. CA, INC.
004000 REMARKS. SAMPLE PROGRAM CONTAINING FILE
005000 CUSTOMER-FILE. THIS PROGRAM PRODUCES
006000 A REPORT OF ALL CUSTOMERS WITH A
007000 CREDIT RATING OF EXCELLENT.
008000
009000 ENVIRONMENT DIVISION.
010000 INPUT-OUTPUT SECTION.
011000 FILE-CONTROL.
012000 SELECT CUSTOMER-FILE ASSIGN UT-2400-S-CUSTIN.
013000 SELECT RPTFILE ASSIGN UT-S-SYSLST.
014000
015000 DATA DIVISION.
016000 FILE SECTION.
017000 FD RPTFILE
018000 RECORDING MODE F
019000 LABEL RECORDS ARE OMITTED
020000 RECORD CONTAINS 133
021000 DATA RECORDS ARE TITLE-REC DETAIL-REC.
022000
023000 01 TITLE-REC PIC X(133).
024000 01 DETAIL-REC.
025000 05 FILLER PIC X.
026000 05 RPT-CUST-NO PIC X(10).
027000 05 FILLER PIC XXX.
028000 05 RPT-CUST-NAME PIC X(20).
029000 05 FILLER PIC X(10).
030000 05 RPT-ADDR1 PIC X(20).
031000 05 FILLER PIC X(5).
032000 05 RPT-ADDR2 PIC X(20).
033000 05 FILLER PIC X(5).
034000 05 RPT-ZIP PIC X(20).
035000 05 FILLER PIC X(19).
036000
037000 FD CUSTOMER-FILE
038000 RECORDING MODE F
039000 LABEL RECORDS ARE OMITTED
040000 RECORD CONTAINS 104 CHARACTERS
041000 DATA RECORD IS CUSTOMER.
042000
043000 01 CUSTOMER.
044000 03 CUST-NUM PIC X(10).
045000 03 CUST-NAME PIC X(20).
046000 03 CUST-ADDRESS.
047000 05 CUST-ADDR1 PIC X(20).
048000 05 CUST-ADDR2.
049000 06 CUST-CITY PIC X(15).
050000 06 CUST-ZIP-CODE PIC X(5).
051000 03 CUST-CREDIT PIC XXX.
052000 88 CUST-CREDIT-EXEC VALUE IS 'AAA'.
053000 88 CUST-CREDIT-GOOD VALUE IS ' '.
054000 88 CUST-CREDIT-POOR VALUE IS 'XXX'.
055000 03 FILLER PIC X(31).
056000
057000
058000 WORKING-STORAGE SECTION.
059000
060000 01 PAGE-COUNT-WS PIC S99 VALUE +0.
061000 01 POSITION-IND-WS PIC X.
062000 01 PAGE-INCREMENT-WS PIC 9.
063000
064000 01 TITLE-1-WS.
065000 05 FILLER PIC X(46) VALUE SPACES.
066000 05 FILLER PIC X(41) VALUE
067000 'CUSTOMERS WITH AN EXCELLENT CREDIT RATING'.
068000 05 FILLER PIC X(46) VALUE SPACES.
069000 01 TITLE-2-WS.
070000 05 FILLER PIC X(18) VALUE ' CUSTOMER NO '.
071000 05 FILLER PIC X(22) VALUE 'CUSTOMER NAME '.
072000 05 FILLER PIC X(5) VALUE SPACES.
073000 05 FILLER PIC X(9) VALUE 'ADDRESS '.
074000 05 FILLER PIC X(79) VALUE SPACES.
075000
076000
077000 PROCEDURE DIVISION.
078000
079000 OPEN INPUT CUSTOMER-FILE.
080000 OPEN OUTPUT RPTFILE.
081000 MOVE SPACES TO DETAIL-REC.
082000
083000 0300-GET-CUST-INFO.
084000 READ CUSTOMER-FILE RECORD
085000 AT END GO TO 9200-EOJ.
086000
087000 IF NOT CUST-CREDIT-EXEC GO TO 0300-GET-CUST-INFO.
088000
089000
090000 MOVE CUST-NUM TO RPT-CUST-NO.
091000 MOVE CUST-NAME TO RPT-CUST-NAME.
092000 MOVE CUST-ADDR1 TO RPT-ADDR1.
093000 MOVE CUST-ADDR2 TO RPT-ADDR2.
094000 MOVE CUST-ZIP-CODE TO RPT-ZIP.
095000
096000 PERFORM 9000-WRITE THRU 9010-EXIT.
097000 GO TO 0300-GET-CUST-INFO.
098000
099000* THIS PARAGRAPH CAUSES A REPORT FILE RECORD TO BE WRITTEN.
100000* IT CONTROLS SPACING AND PAGING OF THE REPORT.
101000
102000 9000-WRITE.
103000 MOVE ' ' TO POSITION-IND-WS.
104000 MOVE 1 TO PAGE-INCREMENT-WS.
105000 WRITE DETAIL-REC AFTER POSITIONING POSITION-IND-WS.
106000 MOVE SPACES TO DETAIL-REC.
107000 ADD PAGE-INCREMENT-WS TO PAGE-COUNT-WS.
108000 IF PAGE-COUNT-WS GREATER THAN +58
109000 PERFORM 9100-NEW-PAGE THRU 9110-EXIT.
110000 9010-EXIT.
111000 EXIT.
112000
113000 9100-NEW-PAGE.
114000 WRITE TITLE-REC FROM TITLE-1-WS AFTER POSITIONING 0.
115000 MOVE SPACES TO TITLE-REC.
116000 WRITE TITLE-REC FROM TITLE-2-WS AFTER POSITIONING 3.
117000 MOVE SPACES TO TITLE-REC.
118000 MOVE +4 TO PAGE-COUNT-WS.
119000 9110-EXIT.
120000 EXIT.
121000
122000* CLOSE THE FILES AND EXIT FROM THE PROGRAM.
123000
124000 9200-EOJ.
125000 CLOSE CUSTOMER-FILE.
126000 CLOSE RPTFILE.
127000 9210-EXIT.
128000 STOP RUN.
129000
001000 ID DIVISION.
002000 PROGRAM-ID. PRANDEM2.
003000 AUTHOR. CA, INC.
004000 REMARKS. SAMPLE PROGRAM CONTAINING FILE
005000 CUSTOMER-FILE. THIS PROGRAM PRODUCES
006000 A REPORT OF ALL CUSTOMERS WITH A
007000 CREDIT RATING OF EXCELLENT.
008000
009000 ENVIRONMENT DIVISION.
010000 INPUT-OUTPUT SECTION.
011000 FILE-CONTROL.
012000 SELECT CUSTOMER-FILE ASSIGN UT-2400-S-CUSTIN.
013000 SELECT RPTFILE ASSIGN UT-S-SYSLST.
014000
015000 DATA DIVISION.
016000 FILE SECTION.
017000 FD RPTFILE
018000 RECORDING MODE F
019000 LABEL RECORDS ARE OMITTED
020000 RECORD CONTAINS 133
021000 DATA RECORDS ARE TITLE-REC DETAIL-REC.
022000
023000 01 TITLE-REC PIC X(133).
024000 01 DETAIL-REC.
025000 05 FILLER PIC X.
026000 05 RPT-CUST-NO PIC X(10).
027000 05 FILLER PIC XXX.
028000 05 RPT-CUST-NAME PIC X(20).
029000 05 FILLER PIC X(10).
030000 05 RPT-ADDR1 PIC X(20).
031000 05 FILLER PIC X(5).
032000 05 RPT-ADDR2 PIC X(20).
033000 05 FILLER PIC X(5).
034000 05 RPT-ZIP PIC X(20).
035000 05 FILLER PIC X(19).
036000
037000 FD CUSTOMER-FILE
038000 RECORDING MODE F
039000 LABEL RECORDS ARE OMITTED
040000 RECORD CONTAINS 104 CHARACTERS
041000 DATA RECORD IS CUSTOMER.
042000
043000 01 CUSTOMER.
044000 03 CUST-NUM PIC X(10).
045000 03 CUST-NAME PIC X(20).
046000 03 CUST-ADDRESS.
047000 05 CUST-ADDR1 PIC X(20).
048000 05 CUST-ADDR2.
049000 06 CUST-CITY PIC X(15).
050000 06 CUST-ZIP-CODE PIC X(5).
051000 03 CUST-CREDIT PIC XXX.
052000 88 CUST-CREDIT-EXEC VALUE IS 'AAA'.
053000 88 CUST-CREDIT-GOOD VALUE IS ' '.
054000 88 CUST-CREDIT-POOR VALUE IS 'XXX'.
055000 03 FILLER PIC X(31).
056000
057000
058000 WORKING-STORAGE SECTION.
059000
060000 01 PAGE-COUNT-WS PIC S99 VALUE +0.
061000 01 POSITION-IND-WS PIC X.
062000 01 PAGE-INCREMENT-WS PIC 9.
063000
064000 01 TITLE-1-WS.
065000 05 FILLER PIC X(46) VALUE SPACES.
066000 05 FILLER PIC X(41) VALUE
067000 'CUSTOMERS WITH AN EXCELLENT CREDIT RATING'.
068000 05 FILLER PIC X(46) VALUE SPACES.
069000 01 TITLE-2-WS.
070000 05 FILLER PIC X(18) VALUE ' CUSTOMER NO '.
071000 05 FILLER PIC X(22) VALUE 'CUSTOMER NAME '.
072000 05 FILLER PIC X(5) VALUE SPACES.
073000 05 FILLER PIC X(9) VALUE 'ADDRESS '.
074000 05 FILLER PIC X(79) VALUE SPACES.
075000
076000
077000 PROCEDURE DIVISION.
078000
079000 OPEN INPUT CUSTOMER-FILE.
080000 OPEN OUTPUT RPTFILE.
081000 MOVE SPACES TO DETAIL-REC.
082000
083000 0300-GET-CUST-INFO.
084000 READ CUSTOMER-FILE RECORD
085000 AT END GO TO 9200-EOJ.
086000
087000 IF NOT CUST-CREDIT-EXEC GO TO 0300-GET-CUST-INFO.
088000
089000
090000 MOVE CUST-NUM TO RPT-CUST-NO.
091000 MOVE CUST-NAME TO RPT-CUST-NAME.
092000 MOVE CUST-ADDR1 TO RPT-ADDR1.
093000 MOVE CUST-ADDR2 TO RPT-ADDR2.
094000 MOVE CUST-ZIP-CODE TO RPT-ZIP.
095000
096000 PERFORM 9000-WRITE THRU 9010-EXIT.
097000 GO TO 0300-GET-CUST-INFO.
098000
099000* THIS PARAGRAPH CAUSES A REPORT FILE RECORD TO BE WRITTEN.
100000* IT CONTROLS SPACING AND PAGING OF THE REPORT.
101000
102000 9000-WRITE.
103000 MOVE ' ' TO POSITION-IND-WS.
104000 MOVE 1 TO PAGE-INCREMENT-WS.
105000 WRITE DETAIL-REC AFTER POSITIONING POSITION-IND-WS.
106000 MOVE SPACES TO DETAIL-REC.
107000 ADD PAGE-INCREMENT-WS TO PAGE-COUNT-WS.
108000 IF PAGE-COUNT-WS GREATER THAN +58
109000 PERFORM 9100-NEW-PAGE THRU 9110-EXIT.
110000 9010-EXIT.
111000 EXIT.
112000
113000 9100-NEW-PAGE.
114000 WRITE TITLE-REC FROM TITLE-1-WS AFTER POSITIONING 0.
115000 MOVE SPACES TO TITLE-REC.
116000 WRITE TITLE-REC FROM TITLE-2-WS AFTER POSITIONING 3.
117000 MOVE SPACES TO TITLE-REC.
118000 MOVE +4 TO PAGE-COUNT-WS.
119000 9110-EXIT.
120000 EXIT.
121000
122000* CLOSE THE FILES AND EXIT FROM THE PROGRAM.
123000
124000 9200-EOJ.
125000 CLOSE CUSTOMER-FILE.
126000 CLOSE RPTFILE.
127000 9210-EXIT.
128000 STOP RUN.
129000
Copyright © 2013 CA.
All rights reserved.
|
|