I'm pretty new to Cobol, and got stuck trying to create something like a python dictionary, where we pass a key and the dictionary returns its value.
Python example:
>>> dict
{'AC': 'Acre', 'AL': 'Alagoas', 'AP': 'Amapa'}
>>> dict['AC']
'Acre'
I'm trying to do this in cobol, using redefines to create two arrays (one for the keys, other for the values).
I already created the arrays, but got stucked to associate these two arrays in a key-value function, once I can only access an array with integer values.
Here goes my data division, if someone can help with code samples.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WRK-KEYS.
02 FILLER PIC X(2) VALUE "AC".
02 FILLER PIC X(2) VALUE "AL".
02 FILLER PIC X(2) VALUE "AP".
01 WRK-TABLE-KEYS REDEFINES WRK-KEYS.
02 WRK-KEY PIC X(2) OCCURS 3 TIMES.
01 WRK-VALUES.
02 FILLER PIC X(19) VALUE "Acre".
02 FILLER PIC X(19) VALUE "Alagoas".
02 FILLER PIC X(19) VALUE "Amapa".
01 WRK-TABLE-VALUES REDEFINES WRK-VALUES.
02 WRK-VALUE PIC X(10) OCCURS 3 TIMES.
You can use a table, as shown in the example below:
IDENTIFICATION DIVISION.
PROGRAM-ID. STATES.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 STATES-TABLE.
05 FILLER PIC X(2) VALUE "AC".
05 FILLER PIC X(7) VALUE "Acre ".
05 FILLER PIC X(2) VALUE "AL".
05 FILLER PIC X(7) VALUE "Alagoas".
05 FILLER PIC X(2) VALUE "AP".
05 FILLER PIC X(7) VALUE "Amapá ".
01 RDF-STATES-TABLE REDEFINES STATES-TABLE.
05 STATE-GROUP OCCURS 3 TIMES.
10 STATE-CODE PIC X(2).
10 STATE-NAME PIC X(7).
PROCEDURE DIVISION.
DISPLAY "STATES : "STATES-TABLE.
DISPLAY 'STATE-CODE(1) : ' STATE-CODE(1).
DISPLAY 'STATE-NAME(1) : ' STATE-NAME(1).
DISPLAY 'STATE-CODE(2) : ' STATE-CODE(2).
DISPLAY 'STATE-NAME(2) : ' STATE-NAME(2).
DISPLAY 'STATE-CODE(3) : ' STATE-CODE(3).
DISPLAY 'STATE-NAME(3) : ' STATE-NAME(3).
STOP RUN.
Resulting in:
$ ./states
STATES : ACAcre ALAlagoasAPAmapá
STATE-CODE(1) : AC
STATE-NAME(1) : Acre
STATE-CODE(2) : AL
STATE-NAME(2) : Alagoas
STATE-CODE(3) : AP
STATE-NAME(3) : Amapá
Remember that á uses two bytes in UTF-8.
Related
I have a very simple COBOL code here that has a given input data and output data. The problem is that, it shows an error on line 60 which is the MOVE STUD-AGE TO AGE-OUT. and everytime I run OpenCOBOLIDE, I always get and error which is:
libcob: test.cob: 60: 'STUD-AGE' not numeric: ' '
WARNING - Implicit CLOSE of STUDENT-OUT ('C:\STUD-OUT.DAT')
WARNING - Implicit CLOSE of STUDENT-IN ('C:\STUD-IN.DAT')
And I don't know exactly what's wrong with it. Here is supposedly the input file I created:
----5---10---15---20---25---30---35---40--
00-123345 ALISON MARTIN WOLF 1912056
00-789012 KEN DENNIOS ROME 1914156
00-345678 JACK ADRIAN TOCKSIN 1622234
00-901234 EJHAYZ ALONEY 2045645
00-567890 CHARLES JOHN GUINNIVER 1813243
00-123457 JEAN MICHAEL YARTER 2034253
Here's the code to it:
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT STUDENT-IN ASSIGN TO "C:\STUD-IN.DAT".
SELECT STUDENT-OUT ASSIGN TO "C:\STUD-OUT.DAT".
DATA DIVISION.
FILE SECTION.
FD STUDENT-IN.
01 STUD-REC.
02 STUD-NO PIC X(10).
02 STUD-NAME PIC X(25).
02 STUD-AGE PIC 99.
02 STUD-ALLOWANCE PIC 999V99.
FD STUDENT-OUT.
01 PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 HDG-1.
02 FILLER PIC X(20) VALUE SPACES.
02 FILLER PIC X(22) VALUE "WILLOW PARK UNIVERSITY".
02 FILLER PIC X(14) VALUE " OF MADAGASCAR".
01 HDG-2.
02 FILLER PIC X(9) VALUE SPACES.
02 FILLER PIC X(14) VALUE "STUDENT NUMBER".
02 FILLER PIC X(8) VALUE SPACES.
02 FILLER PIC X(12) VALUE "STUDENT NAME".
02 FILLER PIC X(15) VALUE SPACES.
02 FILLER PIC X(3) VALUE "AGE".
02 FILLER PIC X(8) VALUE SPACES.
02 FILLER PIC X(9) VALUE "ALLOWANCE".
01 PRINT-LINE.
02 FILLER PIC X(9) VALUE SPACES.
02 SNO-OUT PIC X(10).
02 FILLER PIC X(12) VALUE SPACES.
02 SNAME-OUT PIC X(25).
02 FILLER PIC X(2) VALUE SPACE.
02 AGE-OUT PIC Z9.
02 FILLER PIC X(9) VALUE SPACES.
02 ALL-OUT PIC ZZZ.99.
01 E-O-F PIC XXX VALUE "NO".
PROCEDURE DIVISION.
OPEN INPUT STUDENT-IN
OUTPUT STUDENT-OUT.
WRITE PRINT-REC FROM HDG-1 BEFORE 1 LINE.
WRITE PRINT-REC FROM HDG-2 AFTER 2 LINES.
MOVE SPACES TO PRINT-REC.
WRITE PRINT-REC AFTER 1 LINE.
PERFORM READ-RTN UNTIL E-O-F = "YES".
PERFORM CLOSE-RTN.
READ-RTN.
READ STUDENT-IN AT END MOVE "YES" TO E-O-F.
MOVE STUD-NO TO SNO-OUT.
MOVE STUD-NAME TO SNAME-OUT.
MOVE STUD-AGE TO AGE-OUT.
MOVE STUD-ALLOWANCE TO ALL-OUT.
WRITE PRINT-REC FROM PRINT-LINE AFTER 1 LINE.
CLOSE-RTN.
CLOSE STUDENT-IN, STUDENT-OUT.
STOP RUN.
What I want to achieve is just to output the file correctly but the error only inputs the HDG-1 and then the rest blank.
To answer your question: COBOL accept numeric data however you define it.
So for "text data" (as long as it isn't UTF-16 or another multibyte encoded file) PIC 99 (which says "two digits in the default USAGE DISPLAY - so one byte per digit) is perfectly fine.
As with every other language: "never trust input data" is something I can recommend. For example: someone could run this program with a file that was saved with an UTF-8 encoded character in the name and then it "looks" right but the code has an unexpected shift in its data. For COBOL things like FUNCTION TEST-NUMVAL(inp) [ignores spaces and allows decimal-point] or IS NUMERIC (strict class test) can be useful.
Using data-check you could for example also skip empty lines or leading/trailing extra data (temporary rulers, headline, summary, ...).
For the actual problem:
It looks like you feed the program with a "common" text file, but you actually did not specify this so your COBOL implementation uses the default SEQUENTIAL. Because of the missing check of the input data you did not spot this directly.
To align expectations and code:
SELECT STUDENT-IN ASSIGN TO "C:\STUD-IN.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT STUDENT-OUT ASSIGN TO "C:\STUD-OUT.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
*-----------------------
IDENTIFICATION DIVISION.
*-----------------------
PROGRAM-ID. TOPACCTS
AUTHOR. Sohan Kundu.
*--------------------
ENVIRONMENT DIVISION.
*--------------------
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PRINT-LINE ASSIGN TO PRTLINE.
SELECT ACCT-REC ASSIGN TO ACCTREC.
*-------------
DATA DIVISION.
*-------------
FILE SECTION.
FD PRINT-LINE RECORD CONTAINS 80 CHARACTERS RECORDING MODE F.
01 PRINT-REC.
05 FILLER PIC X(01) VALUE SPACES.
05 FIRST-NAME-O PIC X(11).
05 FILLER PIC X(02) VALUE SPACES.
05 LAST-NAME-O PIC X(22).
05 FILLER PIC X(02) VALUE SPACES.
05 ACCT-BALANCE-O PIC X(12).
05 FILLER PIC X(30) VALUE SPACES.
*
FD ACCT-REC RECORD CONTAINS 80 CHARACTERS RECORDING MODE F.
01 ACCT-FIELDS.
05 FIRST-NAME PIC X(11).
05 LAST-NAME PIC X(22).
05 FILLER PIC X(28).
05 ACCT-BALANCE PIC X(12).
05 FILLER PIC X(7).
*
WORKING-STORAGE SECTION.
01 FLAGS.
05 LASTREC PIC X VALUE SPACE.
*
01 TOTAL-CLIENTS.
05 FILLER PIC X(14) VALUE
'# OF RECORDS: '.
05 CLIENTS PIC 9(3) VALUE ZERO.
05 FILLER PIC X(63) VALUE SPACES.
*
01 HEADER-1.
05 FILLER PIC X(30) VALUE 'REPORT FOR TOP ACCOUNT HOLDERS'.
05 FILLER PIC X(50) VALUE SPACES.
*
01 HEADER-2.
05 FILLER PIC X(05) VALUE 'Year '.
05 HDR-YR PIC 9(04).
05 FILLER PIC X(02) VALUE SPACES.
05 FILLER PIC X(06) VALUE 'Month '.
05 HDR-MO PIC X(02).
05 FILLER PIC X(02) VALUE SPACES.
05 FILLER PIC X(04) VALUE 'Day '.
05 HDR-DAY PIC X(02).
05 FILLER PIC X(53) VALUE SPACES.
*
01 HEADER-3.
05 FILLER PIC X(11) VALUE 'First Name '.
05 FILLER PIC X(02) VALUE SPACES.
05 FILLER PIC X(10) VALUE 'Last Name '.
05 FILLER PIC X(14) VALUE SPACES.
05 FILLER PIC X(08) VALUE 'Balance '.
05 FILLER PIC X(35) VALUE SPACES.
*
01 HEADER-4.
05 FILLER PIC X(11) VALUE '-----------'.
05 FILLER PIC X(02) VALUE SPACES.
05 FILLER PIC X(10) VALUE '----------'.
05 FILLER PIC X(14) VALUE SPACES.
05 FILLER PIC X(08) VALUE '--------'.
05 FILLER PIC X(35) VALUE SPACES.
*
01 WS-CURRENT-DATE-DATA.
05 WS-CURRENT-DATE.
10 WS-CURRENT-YEAR PIC 9(04).
10 WS-CURRENT-MONTH PIC 9(02).
10 WS-CURRENT-DAY PIC 9(02).
05 WS-CURRENT-TIME.
10 WS-CURRENT-HOURS PIC 9(02).
10 WS-CURRENT-MINUTE PIC 9(02).
10 WS-CURRENT-SECOND PIC 9(02).
10 WS-CURRENT-MILLISECONDS PIC 9(02).
*
*------------------
PROCEDURE DIVISION.
*------------------
OPEN-FILES.
OPEN INPUT ACCT-REC.
OPEN OUTPUT PRINT-LINE.
*
WRITE-HEADERS.
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-DATA.
MOVE WS-CURRENT-YEAR TO HDR-YR.
MOVE WS-CURRENT-MONTH TO HDR-MO.
MOVE WS-CURRENT-DAY TO HDR-DAY.
WRITE PRINT-REC FROM HEADER-1.
WRITE PRINT-REC FROM HEADER-2.
MOVE SPACES TO PRINT-REC.
WRITE PRINT-REC AFTER ADVANCING 1 LINES.
WRITE PRINT-REC FROM HEADER-3.
WRITE PRINT-REC FROM HEADER-4.
MOVE SPACES TO PRINT-REC.
*
READ-NEXT-RECORD.
PERFORM READ-RECORD
PERFORM UNTIL LASTREC = 'Y'
PERFORM IS-BALANCE-HIGH
PERFORM READ-RECORD
END-PERFORM
.
*
CLOSE-STOP.
WRITE PRINT-REC FROM TOTAL-CLIENTS.
CLOSE ACCT-REC.
CLOSE PRINT-LINE.
STOP RUN.
*
READ-RECORD.
READ ACCT-REC
AT END MOVE 'Y' TO LASTREC
END-READ.
*
IS-BALANCE-HIGH.
IF FUNCTION NUMVAL-C(ACCT-BALANCE) > 8500000 THEN
ADD 1 TO CLIENTS
PERFORM WRITE-RECORD
END-IF.
*
WRITE-RECORD.
MOVE FIRST-NAME TO FIRST-NAME-O.
MOVE LAST-NAME TO LAST-NAME-O.
MOVE ACCT-BALANCE TO ACCT-BALANCE-O.
WRITE PRINT-REC.
*
I want to read the account details from an input file and print if the balance is more than 8500000.
The code is showing the following error:
IGZ0201W A file attribute mismatch was detected. File PRINT-LINE in program TOPACCTS had a record length of 81 and
the file specified in the ASSIGN clause had a record length of 80.
IGZ0035S There was an unsuccessful OPEN or CLOSE of file PRTLINE in program TOPACCTS at relative location X'1E8'.
Neither FILE STATUS nor an ERROR declarative were specified. The status code was 39.
From compile unit TOPACCTS at entry point TOPACCTS at compile unit offset +000001E8 at entry offset +000001E8
at address 1B8001E8.
In the JCL that you are using to execute this program (as a batchjob), within the step with EXEC PGM=TOPACCTS, make sure that you use a DD-card for your output file PRTLINE which looks similar to this:
//PRTLINE DD DISP=(NEW,CATLG),DSN=YOUR.DSN.GOES.HERE,
// UNIT=SYSDA,SPACE=(CYL,(5,5)),
// RECFM=FB,LRECL=80
That way you'll avoid the status code '39', which indicates that there is a mismatch between your record length of 80 (as shown in your program with CONTAINS 80 CHARACTERS), and whatever you specified in your JCL's DD-card.
Ok so I'm making this application for school, which requires a certain format of spacing between the entries read in from .txt file. I've created the header using the filler term and the spacing works just fine, however when I apply the same method to the formatting of the records imported from the .txt it doesn't seem to work. I've tried everything under the sun and I can't make it work for the life of me!
This is what the output looks like now:
PARTNUMBER PARTNAME QUANTITY VALUE
1111111screws robertson 10 43210200Ajax
2222222screws robertson 08 41000100Ajax
2222233screws robertson 06 43210200Ajax
3333333screws robertson 04 41000100Ajax
4444444bolts dead 10 43210200Robo
5555555bolts dead 80 01000100Robo
But, it should be something like:
PARTNUMBER PARTNAME QUANTITY VALUE
1111111 screws robertson 10 43210200 Ajax
2222222 screws robertson 08 41000100 Ajax
2222233 screws robertson 06 43210200 Ajax
3333333 screws robertson 04 41000100 Ajax
4444444 bolts dead 10 43210200 Robo
5555555 bolts dead. 80 01000100 Robo
Below is the code that I think I need to make this happen, but again I'm just not sure why it isn't working
FILE SECTION.
FD INVENT-FILE-IN.
01 INVENT-RECORD-IN PIC X(49).
WORKING-STORAGE SECTION.
01 DISPLAY-HEADERS.
05 DISPLAY-PART-NUMBER PIC A(11)
VALUE "PARTNUMBER".
05 FILLER PIC X(1).
05 DISPLAY-PART-NAME PIC A(9)
VALUE "PARTNAME".
05 FILLER PIC X(4).
05 DISPLAY-QUANTITY PIC A(8)
VALUE "QUANTITY".
05 FILLER PIC X(2).
05 DISPLAY-VALUE PIC A(5)
VALUE "VALUE".
01 DISPLAY-RECORDS.
05 WS-INVENTORY-PART-NUMBER PIC 9(7).
05 FILLER PIC X(4) VALUE SPACES.
05 WS-INVENTORY-PART-NAME PIC X(20).
05 FILLER PIC X(4) VALUE SPACES.
05 WS-INVENTORY-QUANTITY PIC 9(4).
05 FILLER PIC X(2) VALUE SPACES.
05 WS-INVENTORY-VALUE PIC 9(8).
05 FILLER PIC X(1) VALUE SPACES.
05 WS-INVENTORY-SUPPLIER-CODE PIC X(5).
PROCEDURE DIVISION.
100-PROCESS-INVENTORY-FILE.
PERFORM 201-OPEN-INVENT-FILE.
PERFORM 202-DISPLAY-HEADER.
PERFORM 204-INPUT-INVENT-FILE
PERFORM 206-DISPLAY-RECORDS
UNTIL EOF-SWITCH = "Y".
PERFORM 205-TERMINATE-INVENTORY-FILE.
STOP RUN.
201-OPEN-INVENT-FILE.
OPEN INPUT INVENT-FILE-IN.
202-DISPLAY-HEADER.
DISPLAY DISPLAY-HEADERS.
206-DISPLAY-RECORDS.
MOVE INVENT-RECORD-IN TO DISPLAY-RECORDS.
DISPLAY DISPLAY-RECORDS.
READ INVENT-FILE-IN
AT END
MOVE "Y" TO EOF-SWITCH
NOT AT END
COMPUTE READ-COUNTER = READ-COUNTER + 1
END-READ.
204-INPUT-INVENT-FILE.
READ INVENT-FILE-IN
AT END
MOVE "Y" TO EOF-SWITCH
NOT AT END
COMPUTE READ-COUNTER = READ-COUNTER + 1
END-READ.
205-TERMINATE-INVENTORY-FILE.
CLOSE INVENT-FILE-IN.
As previously stated in the comments, in paragraph 206-DISPLAY-RECORDS, you are moving the entire input record to DISPLAY-RECORDS.
The problem here is that your input record is not formatted the same as your output record. This just means that you have to format it yourself. The easiest way to do this is to define your input input record differently. Something like this should do the trick:
FILE SECTION.
FD INVENT-FILE-IN.
01 INVENT-RECORD-IN.
05 INVENT-PART-NUMBER PIC 9(7).
05 INVENT-PART-NAME PIC X(20).
05 INVENT-QUANTITY PIC 9(4).
05 INVENT-VALUE PIC 9(8).
05 INVENT-SUPPLIER-CODE PIC X(5).
From here, its as easy as moving this fields to their equivalent spot in you DISPLAY-RECORDS:
206-DISPLAY-RECORDS.
MOVE INVENT-PART-NUMBER TO WS-INVENTORY-PART-NUMBER
MOVE INVENT-PART-NAME TO WS-INVENTORY-PART-NAME
MOVE INVENT-QUANTITY TO WS-INVENTORY-QUANTITY
MOVE INVENT-VALUE TO WS-INVENTORY-VALUE
MOVE INVENT-SUPPLIER-CODE TO WS-INVENTORY-SUPPLIER-CODE
READ INVENT-FILE-IN
AT END
MOVE "Y" TO EOF-SWITCH
NOT AT END
COMPUTE READ-COUNTER = READ-COUNTER + 1
END-READ.
I keep getting the error
"LOWMID-COMMISSION-CTR" was not a uniquely defined name. The definition
to be used could not be determined from the context.
And similar on all of my counters. I have no idea where I'm going wrong here, how is it not a uniquely defined name when it is clearly in the WORKING-STORAGE SECTION? Do I put it somewhere else so that it's a uniquely defined name? Below I have showed where I defined my counters, and where the counters are used.
IDENTIFICATION DIVISION.
PROGRAM-ID. LAB3.
AUTHOR.
******************************************************************
ENVIRONMENT DIVISION.
* defines the external files - an input file and output file
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SALES-FILE ASSIGN TO DATAIN
FILE STATUS IS EF-STATUS.
SELECT REPORT-FILE ASSIGN TO DATAOUT
FILE STATUS IS PF-STATUS.
DATA DIVISION.
* has two sections - the file section that describes the files
* and the working storage section - where output lines and
* processing variables are defined
FILE SECTION.
FD SALES-FILE.
01 SALES-RECORD.
05 EMPLOYEE-NAME-IN PIC X(24).
05 SALES-IN PIC 99999.
05 FILLER PIC X(51).
FD REPORT-FILE.
01 REPORT-RECORD PIC X(80).
WORKING-STORAGE SECTION.
01 FLAGS-AND-ACCUMLATORS.
05 LOW-COMMISSION-CTR PIC 99999 VALUE ZERO.
05 LOWMID-COMMISSION-CTR PIC 99999 VALUE ZERO.
05 HIGHMID-COMMISSION-CTR PIC 99999 VALUE ZERO.
05 HIGH-COMMISSION-CTR PIC 99999 VALUE ZERO.
05 TOTAL-SALES PIC $$$,$$9.99 VALUE ZERO.
05 TOTAL-COMMISSION PIC $$$,$$9.99 VALUE ZERO.
05 END-OF-FILE PIC XXX VALUE "NO".
05 EF-STATUS PIC 99 VALUE 0.
05 PF-STATUS PIC 99 VALUE 0.
05 COMMISSION PIC 99999V99.
01 REPORT-BLANK-LINE.
05 PIC X(80).
01 HEADING-LINE-1.
05 PIC X(30) VALUE SPACES.
05 PIC X(19) VALUE
"COMPANY OF AARON".
01 HEADING-LINE-2.
05 PIC X(30) VALUE SPACES.
05 PIC X(19) VALUE
"KEARNEY, MISSOURI".
01 HEADING-LINE-3.
05 PIC X(03) VALUE SPACES.
05 PIC X(48) VALUE
"Number of employees with up to 10,000 in sales: ".
05 LOW-COMMISSION-CTR PIC 99999.
01 HEADING-LINE-4.
05 PIC X(03) VALUE SPACES.
05 PIC X(52) VALUE
"Number of employees from 10,001 to 20,000 in sales: ".
05 LOWMID-COMMISSION-CTR PIC 99999.
01 HEADING-LINE-5.
05 PIC X(03) VALUE SPACES.
05 PIC X(52) VALUE
"Number of employees from 20,001 to 30,000 in sales: ".
05 HIGHMID-COMMISSION-CTR PIC 99999.
01 HEADING-LINE-6.
05 PIC X(03) VALUE SPACES.
05 PIC X(42) VALUE
"Number of employees over 30,000 in sales: ".
05 HIGH-COMMISSION-CTR PIC 99999.
01 HEADING-LINE-7.
05 PIC X(03) VALUE SPACES.
05 PIC X(13) VALUE
"Total Sales: ".
05 TOTAL-SALES PIC $$$,$$9.99.
01 HEADING-LINE-8.
05 PIC X(03) VALUE SPACES.
05 PIC X(18) VALUE
"TOTAL COMMISSION: ".
05 TOTAL-COMMISSION PIC $$$,$$9.99.
01 COLUMN-HEADING-1.
05 PIC X(03) VALUE SPACES.
05 PIC X(24) VALUE "SALESPERSON".
05 PIC X(15) VALUE "SALES".
05 PIC X(10) VALUE "COMMISSION".
01 COLUMN-HEADING-2.
05 PIC X(14) VALUE "SUMMARY REPORT".
01 DETAIL-LINE.
05 PIC X(03) VALUE SPACES.
05 EMPLOYEE-NAME-OUT PIC X(24).
05 SALES-OUT PIC $$$,$$9.
05 PIC X(05) VALUE SPACES.
05 COMMISSION-OUT PIC $$$,$$9.99.
PROCEDURE DIVISION.
1000-MAIN-CONTROL.
PERFORM 2000-INITIALIZE.
PERFORM UNTIL END-OF-FILE = "YES"
READ SALES-FILE
AT END
MOVE "YES" TO END-OF-FILE
NOT AT END
PERFORM 3000-PROCESS
END-PERFORM
PERFORM 4000-PROCESS.
STOP RUN.
2000-INITIALIZE.
OPEN INPUT SALES-FILE
OUTPUT REPORT-FILE.
WRITE REPORT-RECORD FROM HEADING-LINE-1.
WRITE REPORT-RECORD FROM HEADING-LINE-2.
WRITE REPORT-RECORD FROM REPORT-BLANK-LINE.
WRITE REPORT-RECORD FROM COLUMN-HEADING-1.
WRITE REPORT-RECORD FROM REPORT-BLANK-LINE.
3000-PROCESS.
IF SALES-IN < 10001
MULTIPLY SALES-IN BY .04 GIVING COMMISSION
ADD 1 TO LOW-COMMISSION-CTR
ADD COMMISSION TO TOTAL-COMMISSION
END-IF.
IF SALES-IN > 10000 AND < 20001
MULTIPLY SALES-IN BY .055 GIVING COMMISSION
ADD 1 TO LOWMID-COMMISSION-CTR
ADD COMMISSION TO TOTAL-COMMISSION
END-IF.
IF SALES-IN > 20000 AND < 30000
MULTIPLY SALES-IN BY .065 GIVING COMMISSION
ADD 1 TO HIGHMID-COMMISSION-CTR
ADD COMMISSION TO TOTAL-COMMISSION
END-IF.
IF SALES-IN > 30000
MULTIPLY SALES-IN BY .075 GIVING COMMISSION
ADD 1 TO HIGH-COMMISSION-CTR
ADD COMMISSION TO TOTAL-COMMISSION
END-IF.
MOVE EMPLOYEE-NAME-IN TO EMPLOYEE-NAME-OUT.
MOVE SALES-IN TO SALES-OUT.
MOVE COMMISSION TO COMMISSION-OUT.
WRITE REPORT-RECORD FROM DETAIL-LINE.
4000-PROCESS.
WRITE REPORT-RECORD FROM REPORT-BLANK-LINE.
WRITE REPORT-RECORD FROM COLUMN-HEADING-2.
WRITE REPORT-RECORD FROM HEADING-LINE-3.
WRITE REPORT-RECORD FROM HEADING-LINE-4.
WRITE REPORT-RECORD FROM HEADING-LINE-5.
WRITE REPORT-RECORD FROM HEADING-LINE-6.
WRITE REPORT-RECORD FROM HEADING-LINE-7.
WRITE REPORT-RECORD FROM HEADING-LINE-8.
4000-TERMINATE.
CLOSE SALES-FILE, REPORT-FILE.
Thje variable LOWMID-COMMISSION-CTR is defined twice.
once in FLAGS-AND-ACCUMLATORS
01 FLAGS-AND-ACCUMLATORS.
05 LOW-COMMISSION-CTR PIC 99999 VALUE ZERO.
05 LOWMID-COMMISSION-CTR PIC 99999 VALUE ZERO.
once in HEADING-LINE-4
01 HEADING-LINE-4.
05 PIC X(03) VALUE SPACES.
05 PIC X(52) VALUE
"Number of employees from 10,001 to 20,000 in sales: ".
05 LOWMID-COMMISSION-CTR PIC 99999.
So either
rename one of the LOWMID-COMMISSION-CTR to some thing else
01 HEADING-LINE-4.
05 PIC X(03) VALUE SPACES.
05 PIC X(52) VALUE
"Number of employees from 10,001 to 20,000 in sales: ".
05 HEADER-LOWMID-COMMISSION-CTR PIC 99999.
fully qualify the field.
Add 1
to LOWMID-COMMISSION-CTR
of FLAGS-AND-ACCUMLATORS
Same applies to other FLAGS-AND-ACCUMLATORS fields
I'm working on an assignment for my class, and I'm having an issue with getting a percentage to show the proper value for my COBOL Lab.
My issue is with PERCENT-DISCOUNT / WS-PERCENT-WITH-DISCOUNT (at least, I believe it is).
When the program is run, I get the result 50.0. The result I should be getting (assuming I did the math correctly by hand) is 55.6. I'm not too sure where I'm going wrong.
Here is the code that I currently have written for the program.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. LAB2.
AUTHOR. XXXXXXX XXXXXXXXXXX.
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IPT-FILE ASSIGN TO 'LAB2.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRT-FILE ASSIGN TO 'LAB2_OUTPUT.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
*
DATA DIVISION.
FILE SECTION.
*
FD IPT-FILE
RECORD CONTAINS 80 CHARACTERS
RECORDING MODE IS F
DATA RECORD IS INPUT-RECORD.
01 IPT-RECORD.
05 IPT-INV-NUMBER PIC 9(04).
05 IPT-INV-QUANTITY PIC 9(03).
05 IPT-INV-DESCRIPTION PIC X(13).
05 IPT-INV-UNITPRICE PIC 9999V99.
05 IPT-INV-PROD-CLASS PIC 9(01).
*
FD PRT-FILE
RECORD CONTAINS 132 CHARACTERS
RECORDING MODE IS F
DATA RECORD IS PRT-LINE.
01 PRT-LINE.
05 FILLER PIC X(04).
05 PRT-INV-NUMBER PIC 9(04).
05 FILLER PIC X(02).
05 PRT-EXTENDED-PRICE PIC Z,ZZZ,ZZ9.99.
05 FILLER PIC X(04).
05 PRT-DISCOUNT-AMOUNT PIC ZZZ,ZZ9.99.
05 FILLER PIC X(03).
05 PRT-NET-PRICE PIC Z,ZZZ,ZZ9.99.
05 FILLER PIC X(10).
05 PRT-PRODUCT-CLASS PIC 9.
05 FILLER PIC X(07).
05 PRT-TRANS-PERCENT PIC Z9.9.
05 FILLER PIC X(05).
05 PRT-TRANS-CHARGE PIC ZZZ,ZZ9.99.
*
WORKING-STORAGE SECTION.
*
01 EOF-SWITCH PIC X VALUE 'N'.
*
01 WS-EXTENDED-COST PIC 9(07)V99.
01 WS-DISCOUNT-AMOUNT PIC 9(06)V99.
01 WS-NET-COST PIC 9(07)V99.
01 WS-TRANS-PERCENT PIC ZZ9V9.
01 WS-TRANS-COST PIC 9(06)V99.
*
01 WS-TOTAL-EXTENDED-COST PIC 9(09)V99 VALUE ZERO.
01 WS-TOTAL-NET-COST PIC 9(08)V99 VALUE ZERO.
01 WS-TOTAL-TRANS-COST PIC 9(08)V99 VALUE ZERO.
01 WS-TOTAL-WITH-DISCOUNT PIC 99V9 VALUE ZERO.
01 WS-TOTAL-ITEMS PIC 99V9 VALUE ZERO.
01 WS-PERCENT-WITH-DISCOUNT PIC 99V9.
01 WS-TOTAL-NO-DISCOUNT PIC 99V9 VALUE ZERO.
*
01 HEADING-NAME.
05 MY-NAME PIC X(20) VALUE
'XXXXX XXXXXXX, LAB 2'.
01 HEADING-COLUMN-1.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-1-INV-NUM PIC X(03) VALUE 'INV'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-EXT-PRC PIC X(08) VALUE 'EXTENDED'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-DISC-AMT PIC X(08) VALUE 'DISCOUNT'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-NET-PRC PIC X(09) VALUE 'NET PRICE'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-CLASS PIC X(05) VALUE 'CLASS'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-TRANS-P PIC X(05) VALUE 'TRANS'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-TRANS-C PIC X(14) VALUE 'TRANSPORTATION'.
01 HEADING-COLUMN-2.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-INV-NUM PIC X(03) VALUE 'NUM'.
05 FILLER PIC X(09) VALUE SPACES.
05 COLUMN-2-EXT-PRC PIC X(08) VALUE 'PRICE'.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-DISC-AMT PIC X(08) VALUE 'AMOUNT'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-2-NET-PRC PIC X(09) VALUE SPACES.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-2-CLASS PIC X(05) VALUE SPACES.
05 FILLER PIC X(08) VALUE SPACES.
05 COLUMN-2-TRANS-P PIC X(05) VALUE '%'.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-TRANS-C PIC X(14) VALUE 'CHARGE'.
01 BLANK-LINE.
05 BLANK-SPACE PIC X VALUE SPACES.
01 TOTAL-FOOTER.
05 FILLER PIC X(07) VALUE SPACES.
05 TOTAL-EXTENDED-COST PIC $$$$,$$$,$$9.99.
05 FILLER PIC X(15) VALUE SPACES.
05 TOTAL-NET-COST PIC $$$,$$$,$$9.99.
05 FILLER PIC X(23) VALUE SPACES.
05 TOTAL-TRANS-COST PIC $$$,$$$,$$9.99.
01 TOTAL-NO-DISCOUNT-FOOTER.
05 TOTAL-SENTENCE PIC X(31) VALUE
'TOTAL ITEMS WITHOUT DISCOUNT = '.
05 TOTAL-NO-DISCOUNT PIC Z9.
01 PERCENT-DISCOUNT-FOOTER.
05 PERCENT-SENTENCE PIC X(44) VALUE
'PERCENT OF ITEMS THAT RECEIVED A DISCOUNT = '.
05 PERCENT-DISCOUNT PIC Z9.9.
*
PROCEDURE DIVISION.
*
OPEN INPUT IPT-FILE.
OPEN OUTPUT PRT-FILE.
*
WRITE PRT-LINE FROM HEADING-NAME AFTER ADVANCING 0 LINES.
WRITE PRT-LINE FROM HEADING-COLUMN-1 AFTER ADVANCING 3 LINES.
WRITE PRT-LINE FROM HEADING-COLUMN-2 AFTER ADVANCING 1 LINES.
WRITE PRT-LINE FROM BLANK-LINE AFTER ADVANCING 1 LINES.
*
READ IPT-FILE AT END MOVE 'Y' TO EOF-SWITCH.
*
PERFORM MAIN-LOOP UNTIL EOF-SWITCH EQUALS 'Y'.
*
DIVIDE WS-TOTAL-WITH-DISCOUNT BY WS-TOTAL-ITEMS
GIVING WS-PERCENT-WITH-DISCOUNT.
MULTIPLY WS-PERCENT-WITH-DISCOUNT BY 100
GIVING WS-PERCENT-WITH-DISCOUNT.
*
MOVE WS-TOTAL-EXTENDED-COST TO TOTAL-EXTENDED-COST.
MOVE WS-TOTAL-NET-COST TO TOTAL-NET-COST.
MOVE WS-TOTAL-TRANS-COST TO TOTAL-TRANS-COST.
MOVE WS-TOTAL-NO-DISCOUNT TO TOTAL-NO-DISCOUNT.
MOVE WS-PERCENT-WITH-DISCOUNT TO PERCENT-DISCOUNT.
*
WRITE PRT-LINE FROM TOTAL-FOOTER AFTER ADVANCING 3 LINES.
WRITE PRT-LINE FROM TOTAL-NO-DISCOUNT-FOOTER AFTER
ADVANCING 3 LINES.
WRITE PRT-LINE FROM BLANK-LINE AFTER ADVANCING 1 LINES.
WRITE PRT-LINE FROM PERCENT-DISCOUNT-FOOTER AFTER ADVANCING
1 LINES.
*
CLOSE IPT-FILE, PRT-FILE.
STOP RUN.
*
MAIN-LOOP.
MOVE SPACES TO PRT-LINE.
*
MULTIPLY IPT-INV-QUANTITY BY IPT-INV-UNITPRICE
GIVING WS-EXTENDED-COST ROUNDED.
MOVE WS-EXTENDED-COST TO PRT-EXTENDED-PRICE.
*
ADD 1 TO WS-TOTAL-ITEMS
*
IF WS-EXTENDED-COST IS GREATER THAN 200 THEN
MULTIPLY WS-EXTENDED-COST BY 0.11 GIVING
WS-DISCOUNT-AMOUNT ROUNDED
ADD 1 TO WS-TOTAL-WITH-DISCOUNT
*
ELSE
MOVE ZERO TO WS-DISCOUNT-AMOUNT
ADD 1 TO WS-TOTAL-NO-DISCOUNT
END-IF.
*
IF IPT-INV-PROD-CLASS IS EQUAL TO 1 THEN
MOVE 27.0 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.27 GIVING
WS-TRANS-COST ROUNDED
*
ELSE IF IPT-INV-PROD-CLASS IS EQUAL TO 2 THEN
MOVE 17.0 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.17 GIVING
WS-TRANS-COST ROUNDED
*
ELSE IF IPT-INV-QUANTITY IS GREATER THAN 100 THEN
MOVE 13.5 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.135 GIVING
WS-TRANS-COST ROUNDED
*
ELSE
MOVE ZERO TO WS-TRANS-PERCENT
MOVE 25.00 TO WS-TRANS-COST
END-IF.
*
SUBTRACT WS-EXTENDED-COST FROM WS-DISCOUNT-AMOUNT
GIVING WS-NET-COST.
ADD WS-EXTENDED-COST TO WS-TOTAL-EXTENDED-COST.
ADD WS-NET-COST TO WS-TOTAL-NET-COST.
ADD WS-TRANS-COST TO WS-TOTAL-TRANS-COST.
*
MOVE IPT-INV-NUMBER TO PRT-INV-NUMBER.
MOVE WS-EXTENDED-COST TO PRT-EXTENDED-PRICE.
MOVE WS-DISCOUNT-AMOUNT TO PRT-DISCOUNT-AMOUNT.
MOVE WS-NET-COST TO PRT-NET-PRICE.
MOVE IPT-INV-PROD-CLASS TO PRT-PRODUCT-CLASS.
MOVE WS-TRANS-PERCENT TO PRT-TRANS-PERCENT.
MOVE WS-TRANS-COST TO PRT-TRANS-CHARGE.
*
WRITE PRT-LINE AFTER ADVANCING 1 LINES.
*
READ IPT-FILE AT END MOVE 'Y' TO EOF-SWITCH.
Here is the information that the .dat file holds.
2047105TYPEWRITER 0800002
1742010HANDLE 0010001
2149150USB DRIVE 1200003
3761005TAPE 5000004
2791010BOLTS 0000751
3000100STAPLER 0002007
3001101OVERHEAD PROJ0099997
3002099PENCILS 0000097
4001184CANADIAN RUGS0150294
4003050CARPET 0040000
4005001WASTE BASKETS0003793
5001010HINGES 0010001
5003010PENS (GOLD) 0049992
5004400PENS (BLACK) 0002004
8888999HIGH CHAIR 9999991
8889412PLAY PEN 0074992
0001001LOW TEST 0000019
9999999LAST RECORD 0000011
Your problem is here:
01 WS-PERCENT-WITH-DISCOUNT PIC 99V9.
When you do your divide, you store the result in that field. If you expect it to be 0.556, what you are storing is 0.5, because you have only defined one decimal place, so the two low-order decimal places are simply truncated.
When you then multiply by 100, you make that 50.0.
If you define that field with three decimal places, your expected answer should appear (I've not checked your data).
However, a better way to do it is to define more integer digits, so that the field is large enough to hold your intermediate result and multiply by 100 first. Then you can divide (and you may want to consider ROUNDED on that, but it depends on the spec for the program).
There are a few questions here on problems with COMPUTE. Reading those questions and understanding the answers will help you get a good grasp on this. In COBOL, you define the accuracy you require, and you do that by supplying the correct number of integer and decimal digits.
You could also look through some of the other COBOL questions, where you'll find lots of advice on using FILE STATUS on your files, and checking the result of each IO. You can also use the file-status field you define to check for end-of-file, rather than using AT END/NOT AT END: you should find that it needs less code, and is more easy to understand.
Ditch as many full-stops/periods as you can. You need one at the end of the PROCEDURE DIVISION header, one at the end of a procedure-name, one at the end of a procedure, and one at the end of the program (if you have no procedure-names). All the others are superfluous. Commas in code tend to distract, you may find it clearer to use indentation and formatting of the statements.
Whilst it is well-constructed, your nested-IF would be better as an EVALUATE.
You have many constants in your program. It is better to define those as data-items, with a well-chosen name, so that the code "reads", and no-one has to wonder about the significance of 0.27. You also have examples where you have two constants which are obviously related, 27.0 and 0.27 for instance, which are better served by just being one thing. If someone "maintains" the program, they may only change one of the values without changing the other (not expecting there to be another).
Look also at the use of 88-level condition names. The "switch = y" can become "end-of-invoice-file" for instance, and that 88 can be on the file-status for that file, with a value of "10".
You should test your program with an empty input file, and see if you like the results.
As a beginner with COBOL, it is not a bad shot at all.