I'm an "aspiring" programmer currently trying to learn Cobol. The code below is obviously a very simple Cobol program with hard-coded values. However I am curious to know how a more experienced Cobol programmer would improve such simple program. Maybe there are a lot of things I am missing?
Feel free to suggest how you would accomplish it.
IDENTIFICATION DIVISION.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WORK-FIELDS.
05 EMPTY-LINE PIC X(132) VALUE SPACES.
01 HEADLINE.
05 VALUE "Invoice Specification".
01 FOOTER.
05 VALUE "Invoice End".
01 CALC-FIELDS.
10 SPOILER PIC 9(4).
10 WINDSHIELD PIC 9(3).
10 PARTSUM PIC 9(4).
10 DISCOUNT PIC 9(4).
10 TO-PAY-EXKL PIC 9(6).
10 VAT PIC 9(3).
10 TOTAL-TO-PAY PIC 9(4).
01 PRINT-FIELDS.
05 GROUP-1.
10 PIC X(36)
VALUE "01 SPOILER left-front, 1250:-".
10 SPOILER-EDITED PIC Z,ZZZ.99.
10 PIC X(2) VALUE ":-".
05 GROUP-2.
10 PIC X(36)
VALUE "02 Windshield, 390:-".
10 WINDSHIELD-EDITED PIC Z,ZZZ.99.
10 PIC X(2) VALUE ":-".
05 GROUP-3.
10 PIC X(36)
VALUE "Part Sum".
10 PARTSUM-EDITED PIC Z,ZZZ.99.
10 PIC X(2) VALUE ":-".
05 GROUP-4.
10 PIC X(36)
VALUE "Discount 15%".
10 DISCOUNT-EDITED PIC Z,ZZZ.99.
10 PIC X(2) VALUE ":-".
05 GROUP-5.
10 PIC X(36)
VALUE "To Pay exkl VAT".
10 TO-PAY-EDITED PIC Z,ZZZ.99.
10 PIC X(2) VALUE ":-".
05 GROUP-6.
10 PIC X(36)
VALUE "Added VAT 25%".
10 VAT-EDITED PIC Z,ZZZ.99.
10 PIC X(2) VALUE ":-".
05 GROUP-7.
10 PIC X(36)
VALUE "Total Amount to Pay".
10 PIC X(4) VALUE "SEK ".
10 TOTAL-EDITED PIC Z,ZZZ.99.
10 PIC X(2) VALUE ":-".
PROCEDURE DIVISION.
100-GENERATE-INVOICE.
PERFORM 200-CALCULATE.
PERFORM 300-PRINT-VALUES.
STOP RUN.
200-CALCULATE.
MOVE 1250 TO SPOILER
MOVE SPOILER TO SPOILER-EDITED
MOVE 390 TO WINDSHIELD
MOVE WINDSHIELD TO WINDSHIELD-EDITED
ADD SPOILER WINDSHIELD TO PARTSUM
MOVE PARTSUM TO PARTSUM-EDITED
MULTIPLY PARTSUM BY 0.15 GIVING DISCOUNT
MOVE DISCOUNT TO DISCOUNT-EDITED
SUBTRACT DISCOUNT FROM PARTSUM GIVING TO-PAY-EXKL
MOVE TO-PAY-EXKL TO TO-PAY-EDITED
MULTIPLY TO-PAY-EXKL BY 0.25 GIVING VAT
MOVE VAT TO VAT-EDITED
MULTIPLY TO-PAY-EXKL BY 1.25 GIVING TOTAL-TO-PAY
MOVE TOTAL-TO-PAY TO TOTAL-EDITED
.
300-PRINT-VALUES.
DISPLAY HEADLINE
DISPLAY EMPTY-LINE
DISPLAY EMPTY-LINE
DISPLAY GROUP-1
DISPLAY GROUP-2
DISPLAY GROUP-3
DISPLAY GROUP-4
DISPLAY GROUP-5
DISPLAY GROUP-6
DISPLAY EMPTY-LINE
DISPLAY GROUP-7
DISPLAY EMPTY-LINE
DISPLAY EMPTY-LINE
DISPLAY FOOTER
.
We don't know the objective of this code. Things to consider:
Determine objectives
Determine inputs and outputs
Design input file/db access mode (sequential/random/start from a criteria...etc.).
Identify the business rules.
Design the output (will you just produce a result via display only, will you update a database? will you print a report?)
Design a flow for the processing expected.
Code the required parts.
Note that your code above has no PROCEDURE DIVISION.
Maybe some code here could help amongst the ton of code already out there:
Sample Code
Related
EDIT: Figured it out. I needed to call the read again at the end of A420-COUNT-MARKS
Edit: Working on a z/OS mainframe that I'm accessing via Vista TN3270. The program is submitted using JCL which was provided by the teacher.
I'm in school for programming and I have a COBOL assignment where my program reads a file full of subject names and codes and a file full of student marks and an associated subject code. It must use this info to create a report that lists all the subjects and count the number of students that received grades of A , B, C, D or F for each subject. It then totals up the amount of each grade at the bottom.
Report example:
01 ABC COLLEGE TESTING CENTER
02 TEST RESULTS SUMMARY DATE: yyyy/mm/dd
03
04 SUBJECT NAME A B C D F
05
06 xxxxxxxxxxxxxxxxxxxx 9,999 9,999 9,999 9,999 9,999
07 xxxxxxxxx 9,999 9,999 9,999 9,999 9,999
19
20 TOTAL 99,999 99,999 99,999 99,999 99,999
The problem is that my program is only outputting the header rows, but won't output the detail rows or the grand total row. I've written functions to perform these things but they're not getting any errors so I have no idea what's going wrong.
Here's my file control and file section:
FILE-CONTROL.
SELECT F01-SUBJ-FILE ASSIGN TO F01SUBJ.
SELECT F02-MARK-FILE ASSIGN TO F02MARK.
SELECT F03-REPT-FILE ASSIGN TO F03REPT.
FILE SECTION.
FD F01-SUBJ-FILE
RECORDING MODE IS F
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS F01-SUBJ-RECORD.
01 F01-SUBJ-RECORD.
05 F01-SUBJ-CODE PIC X(6).
05 F01-SUBJ-NAME PIC X(20).
05 PIC X(54).
FD F02-MARK-FILE
RECORDING MODE IS F
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS F02-MARK-RECORD
01 F02-MARK-RECORD.
05 F02-STUD-NAME PIC X(20).
05 F02-SUBJ-CODE PIC X(6).
05 PIC X.
05 F02-DATE-TEST PIC X(8).
05 F02-STUD-MARK PIC 9(3).
05 PIC X(42).
FD F03-REPT-FILE
RECORDING MODE IS F
RECORD CONTAINS 120 CHARACTERS
DATA RECORD IS F03-REPT-RECORD.
01 F03-REPT-RECORD.
05 PIC X(120).
Here's working storage:
WORKING-STORAGE SECTION.
01 W01-EOF-SWITCH.
05 W01-MARK-EOF PIC X VALUE 'N'.
05 W01-SUBJ-EOF PIC X VALUE 'N'.
01 W02-TEST-TABLE.
05 W02-SUBJ-COUNT PIC 99 VALUE 0.
05 W02-SUBJ-MAX PIC 99 VALUE 50.
05 W02-TEST-ROW OCCURS 1 TO 50
DEPENDING ON W02-SUBJ-COUNT
ASCENDING KEY IS W02-SUBJ-CODE
INDEXED BY W02-IDX.
10 W02-SUBJ-CODE PIC X(6) VALUE SPACES.
10 W02-SUBJ-NAME PIC X(20) VALUE SPACES.
10 W02-A-CTR PIC 9999 VALUE 0.
10 W02-B-CTR PIC 9999 VALUE 0.
10 W02-C-CTR PIC 9999 VALUE 0.
10 W02-D-CTR PIC 9999 VALUE 0.
10 W02-F-CTR PIC 9999 VALUE 0.
01 W03-REPT.
05 W03-HEADER-ROW1.
10 PIC X(9) VALUE SPACES.
10 PIC X(3) VALUE 'ABC'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'COLLEGE'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'TESTING'.
10 PIC X VALUE SPACES.
10 PIC X(6) VALUE 'CENTER'.
10 PIC X(85) VALUE SPACES.
05 W03-HEADER-ROW2.
10 PIC X(9) VALUE SPACES.
10 PIC X(4) VALUE 'TEST'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'RESULTS'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'SUMMARY'.
10 PIC X(11) VALUE SPACES.
10 PIC X(5) VALUE 'DATE:'.
10 PIC X VALUE SPACES.
10 W03-YEAR PIC 9999.
10 PIC X VALUE '/'.
10 W03-MONTH PIC 99.
10 PIC X VALUE '/'.
10 W03-DAY PIC 99.
10 PIC X(64) VALUE SPACES.
05 W03-HEADER-ROW3.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'SUBJECT'.
10 PIC X VALUE SPACES.
10 PIC X(4) VALUE 'NAME'.
10 PIC X(15) VALUE SPACES.
10 PIC X VALUE 'A'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'B'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'C'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'D'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'F'.
10 PIC X(59) VALUE SPACES.
05 W03-DETAIL-ROW.
10 PIC X VALUE SPACES.
10 W03-SUBJ-NAME PIC X(20).
10 PIC XXX VALUE SPACES.
10 W03-A-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-B-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-C-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-D-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-F-CTR PIC Z,ZZ9.
10 PIC X(59) VALUE SPACES.
01 W04-SYS-DATE.
05 W04-YEAR PIC 9999.
05 W04-MONTH PIC 99.
05 W04-DAY PIC 99.
01 W05-TOTALS.
05 W05-TOTAL-A PIC 99999 VALUE 0.
05 W05-TOTAL-B PIC 99999 VALUE 0.
05 W05-TOTAL-C PIC 99999 VALUE 0.
05 W05-TOTAL-D PIC 99999 VALUE 0.
05 W05-TOTAL-F PIC 99999 VALUE 0.
Here's procedure division
PROCEDURE DIVISION.
PERFORM A100-OPEN-FILES
PERFORM A200-WRITE-HEADINGS
PERFORM A300-PROCESS-SUBJECTS
PERFORM A400-PROCESS-MARKS
PERFORM A500-WRITE-TOTALS
PERFORM A600-CLOSE-FILES
STOP RUN
.
A100-OPEN-FILES.
* OPENS FILES
OPEN INPUT F01-SUBJ-FILE
F02-MARK-FILE
OPEN OUTPUT F03-REPT-FILE
.
A200-WRITE-HEADINGS.
* WRITES HEADERS TO THE REPORT FILE
MOVE W03-HEADER-ROW1 TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
MOVE FUNCTION CURRENT-DATE (1:8) TO W04-SYS-DATE
MOVE W04-YEAR TO W03-YEAR
MOVE W04-MONTH TO W03-MONTH
MOVE W04-DAY TO W03-DAY
MOVE W03-HEADER-ROW2 TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
MOVE W03-HEADER-ROW3 TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
.
A300-PROCESS-SUBJECTS.
* MOVES SUBJECT NAMES AND CODES INTO W02-TEST-TABLE
PERFORM A310-READ-RECORD
PERFORM UNTIL W01-SUBJ-EOF = 'Y'
IF W02-SUBJ-COUNT < W02-SUBJ-MAX
ADD 1 TO W02-SUBJ-COUNT
SET W02-IDX TO W02-SUBJ-COUNT
MOVE F01-SUBJ-CODE TO W02-SUBJ-CODE(W02-IDX)
MOVE F01-SUBJ-NAME TO W02-SUBJ-NAME(W02-IDX)
ELSE
DISPLAY "ERROR - SUBJECT FILE EXCEEDS MAX OF "
W02-SUBJ-MAX " RECORDS, RECORD IGNORED"
END-IF
PERFORM A310-READ-RECORD
END-PERFORM
.
A310-READ-RECORD.
* READS FROM THE SUBJECT FILE INTO THE SUBJECT RECORD
READ F01-SUBJ-FILE
AT END MOVE 'Y' TO W01-SUBJ-EOF
END-READ
.
A400-PROCESS-MARKS.
PERFORM A410-READ-RECORD
PERFORM A420-COUNT-MARKS
UNTIL W01-MARK-EOF = 'Y'
.
A410-READ-RECORD.
* READS FROM THE MARK FILE INTO THE MARK RECORD
READ F02-MARK-FILE
AT END MOVE 'Y' TO W01-MARK-EOF
END-READ
.
A420-COUNT-MARKS.
* COUNTS GRADE TOTALS
SET W02-IDX TO 1
SEARCH ALL W02-TEST-ROW
AT END DISPLAY 'INVALID INPUT RECORD: ' F02-MARK-RECORD
WHEN W02-SUBJ-CODE(W02-IDX) = F02-SUBJ-CODE
EVALUATE F02-STUD-MARK
WHEN "80" THRU "100"
ADD 1 TO W05-TOTAL-A
ADD 1 TO W02-A-CTR(W02-IDX)
WHEN "70" THRU "79"
ADD 1 TO W05-TOTAL-B
ADD 1 TO W02-B-CTR(W02-IDX)
WHEN "60" THRU "69"
ADD 1 TO W05-TOTAL-C
ADD 1 TO W02-C-CTR(W02-IDX)
WHEN "50" THRU "59"
ADD 1 TO W05-TOTAL-D
ADD 1 TO W02-D-CTR(W02-IDX)
WHEN OTHER
ADD 1 TO W05-TOTAL-F
ADD 1 TO W02-F-CTR(W02-IDX)
END-EVALUATE
END-SEARCH
.
A500-WRITE-TOTALS.
PERFORM A510-WRITE-SUBJ-GRADE-TOTALS
PERFORM A520-WRITE-GRADE-GRAND-TOTALS
.
A510-WRITE-SUBJ-GRADE-TOTALS.
PERFORM VARYING W02-IDX FROM 1 BY 1
UNTIL W02-IDX > W02-SUBJ-COUNT
MOVE W02-SUBJ-NAME(W02-IDX) TO W03-SUBJ-NAME
MOVE W02-A-CTR(W02-IDX) TO W03-A-CTR
MOVE W02-B-CTR(W02-IDX) TO W03-B-CTR
MOVE W02-C-CTR(W02-IDX) TO W03-C-CTR
MOVE W02-D-CTR(W02-IDX) TO W03-D-CTR
MOVE W02-F-CTR(W02-IDX) TO W03-F-CTR
MOVE W03-DETAIL-ROW TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
END-PERFORM
.
A520-WRITE-GRADE-GRAND-TOTALS.
* WRITES THE GRADE GRAND TOTALS TO THE REPORT FILE
* AFTER INSERTING A BLANK ROW
MOVE SPACES TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
MOVE W05-TOTAL-A TO W03-TOTAL-A
MOVE W05-TOTAL-B TO W03-TOTAL-B
MOVE W05-TOTAL-C TO W03-TOTAL-C
MOVE W05-TOTAL-D TO W03-TOTAL-D
MOVE W05-TOTAL-F TO W03-TOTAL-F
MOVE W03-TOTAL-ROW TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
.
A600-CLOSE-FILES.
* CLOSES THE FILES
CLOSE F01-SUBJ-FILE
F02-MARK-FILE
F03-REPT-FILE
.
I'm glad you figured it out, Tom.
I hope you're not turned off and will explore further. FYI, while ISPF, TSO/E, and other classic user interfaces still work (and some people still like them, and they'll continue to work "forever"), nowadays developers often use and prefer graphical user interfaces. There are some free ones, for example IBM Explorer for z/OS and its Remote System Explorer (RSE):
https://developer.ibm.com/mainframe/products/zosexplorer/
That works just fine on its own on a Mac or PC (Linux or Windows), as you prefer (with the RSE part on z/OS). All free. Or, if you wish, you can add a more "COBOL aware" editor (among several other features) if you add the IBM Z Open Development plug-ins:
https://developer.ibm.com/mainframe/products/ibm-z-open-development/
And that works too, free for 90 days. At the end of the 90 days you can either pay the going price to keep those plug-ins or uninstall them and just use the base/free Explorer for z/OS functions.
Maybe this'd be good feedback to your instructor/professor? Yes, your first experience with any programming language can be (for example) via emacs and a terminal emulator. Yes, you can write Apple Swift code (for example) with emacs, ISPF, or vi. However, these classic user interfaces aren't everybody's favorite firsts. Again, if you like a particular UI, and it works for you, no problem! But from a pedagogical perspective it's probably best to start with something more familiar to the audience.
On edit: As another example, if you happen to prefer Microsoft Visual Studio Code, then you can add IBM Z Open Editor free of charge to that IDE.
I figured out what was wrong with my program by placing a DISPLAY at the start of each function which output what function was running. I saw that it was in an infinite loop in A420-COUNT-MARKS and that I forgot to add a PERFORM A410-READ-RECORD at the end of it.
Trying to understand compute. Would it be correct to calculate the sum of the earned credits using FSemesterTotal which is a PIC 99V99 like this? COMPUTE FSemesterTotal = Earned + Earned. I think there is supposed to be a counter in my loop to check if i read in the first earned value so i can add it to the second value coming in not sure how to accomplish this in COBOL.
Currently my input is like this,
CMPS161 ALGORITHM DSGN/IMPLMNT I A 3.00
ENGL322 INTRO TO PROF/TECH WRITING A 3.00
MATH241 ELEM STATISTICS B 3.00
ART 106 SURV WORLD ART HIST II A 3.00
BIOL152 GENERAL BIOL LAB I B 1.00
CMPS257 DISCRETE STRUCTURE A 3.00
CMPS28O ALGORITHM DSGN/IMPLEM II B 3.00
CMPS290 COMPUTER ORGANIZATION A 3.00
CMPS390 DATA STRUCTURES B 3.00
GBIO153 GENERAL BIOL II B 3.00
CMPS294 INTERNET PROGRAMMING B 3.00
CMPS315 SYSTEM ADMINISTRATION A 3.00
CMPS329 COMPUTER NETWORKING SECURITY A 3.00
CMPS383 INFORMATION SYSTEMS A 3.00
CMPS415 INTERGRATED TECH SYSTEMS B 3.00
COBOL CODE
IDENTIFICATION DIVISION.
PROGRAM-ID. P2.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT myInFile ASSIGN TO "P2In.dat".
SELECT myOutFile ASSIGN TO "P2Out.dat".
DATA DIVISION.
FILE SECTION.
FD myInFile.
01 inRecord.
02 Course PIC X(13).
02 Title PIC X(32).
02 Grade PIC X(4).
02 Earned PIC 9V99.
02 FILLER PIC X(3).
FD myOutFile.
01 outRecord.
02 myCourse PIC X(13).
02 myTitle PIC X(32).
02 myGrade PIC X(4).
02 myEarned PIC 9.99.
02 FILLER PIC X(3).
WORKING-STORAGE SECTION.
01 E0F PIC X(3) VALUE "NO ".
01 NAME-HDR.
05 FILLER PIC X(10) VALUE "NAME HERE ".
01 SCHOOLID-HDR.
05 FILLER PIC X(8) VALUE "SCHOOLID"
01 COLUMN-HDR.
05 CCourse PIC X(6) VALUE "COURSE".
05 CSpace PIC X(7) VALUE SPACES.
05 HTitle PIC X(5) VALUE "TITLE".
05 HSpace PIC X(27) VALUE SPACES.
05 CGrade PIC XX VALUE "GR".
05 CSpace PIC XXX VALUE SPACES.
05 CEarned PIC X(6) VALUE "EARNED".
05 QSpace PIC X(4) VALUE SPACES.
05 Qpts PIC X(4) VALUE "Qpts".
01 FOOTER-SMS.
05 FSemester PIC X(28) VALUE " SEMESTER".
05 FSpaces PIC x(21) VALUE SPACES.
05 FSemesterTotal PIC 99V99.
01 FOOTER-CUMUL.
05 FCumulative PIC X(30) VALUE" CUMULATIVE".
05 FSpaces PIC X(19) VALUE SPACES.
05 FCumulTotal PIC 99V99.
01 QPTS-VAL.
05 QSpace PIC X(5) VALUE SPACES.
05 QPtsValue PIC 99V99.
01 GPA.
05 GSpace PIC XX VALUE SPACES.
05 GpaScore PIC 9.99.
PROCEDURE DIVISION.
MAIN-PROGRAM.
PERFORM HEADER.
PERFORM FILE-IO.
PERFORM CLOSING.
STOP RUN.
HEADER.
OPEN INPUT myInFile
OUTPUT myOutFile.
WRITE outRecord FROM NAME-HDR.
WRITE outRecord FROM SCHOOLID-HDR
AFTER ADVANCING 1 LINE.
WRITE outRecord FROM COLUMN-HDR
AFTER ADVANCING 2 LINES.
MOVE SPACES TO outRecord.
WRITE outRecord
AFTER ADVANCING 1 LINE.
FILE-IO.
READ myInFile
AT END
MOVE "YES" TO EOF.
DISPLAY NAME-HDR.
DISPLAY SCHOOLID-HDR.
DISPLAY SPACES.
DISPLAY SPACES.
DISPLAY "FALL 2014"
DISPLAY COLUMN-HDR.
PERFORM PROCESS-RECORD
UNTIL EOF = "YES".
PROCESS-RECORD.
MOVE Course to myCourse.
MOVE Title to myTitle.
MOVE Grade to myGrade.
MOVE Earned to myEarned.
WRITE outRecord
AFTER ADVANCING 1 LINE.
READ myInFile
AT END
MOVE "YES" TO EOF.
NOT AT END
IF myCourse = "ART 106 " THEN
DISPLAY FOOTER-SMS, QPTS-VAL, GPA
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA
DISPLAY SPACES.
DISPLAY "SPRING 2015"
END-IF.
IF myCourse = "CMPS285 " THEN
DISPLAY FOOTER-SMS, QPTS-VAL, GPA
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA
DISPLAY SPACES.
DISPLAY "FALL 2015"
END-IF.
IF myCourse = "CMPS294 " THEN
DISPLAY FOOTER-SMS, QPTS-VAL, GPA
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA
DISPLAY SPACES.
DISPLAY "SPRING 2016"
END-IF.
CLOSING.
DISPLAY FOOTER-SMS, QPTS-VAL, GPA.
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA.
CLOSE myInFile
myOutFile.
The question was: "Can I use COMPUTE this way?"
The answer is:
Yes, but you likely want to add a ON SIZE ERROR to cater for a possible size overflow, just in case your input data has too many entries.
If the question behind the question is: "Will the program work?"
The answer is no:
Despite the issues Brian already pointed out: you'll need a de-editing to change the data from 9.99 (4 bytes, not usable for arithmetic) to 9v99 (3 bytes, usable for arithmetic.
And if you don't use an ISAM file which is validated by the runtime: Always validate file input (the file may be broken and you likely don't want to abend or produce wrong results).
My situation is as follows.
I'm reading input from a file into the following working storage field:
WORKING-STORAGE SECTION.
01 WORK-FIELDS.
05 W1-INPUT.
10 TESTCASE-NUMBER PIC X(02).
10 PIC X(01).
10 TESTCASE-ID PIC X(18).
10 PIC X(01).
10 TESTCASE-CONTENT PIC X(20).
Depending on what the TESTCASE-ID contains, I have to eventually move the content of the TESTCASE-CONTENT field into either the AMOUNT-DECIMAL-FORMAT or the AMOUNT-DECIMAL-NUMBER field in the following copybook:
05 (*)AMOUNT.
10 AMOUNT-DECIMAL-FORMAT PIC S9(18) COMP-3.
10 AMOUNT-DECIMAL-NUMBER PIC S9(01) COMP-3.
10 AMOUNT-IN-XML-FORMAT PIC N(20).
I then have to do a call to another program which will process these parameters and fill the AMOUNT-IN-XML-FORMAT field.
Anyway, so my question is: What's the best way to move the content of my PIC X field into my S9 COMP-3 field?
Thanks in advance for your time!
I am trying to finish a program that I have started but am confused as to what I need to do and how to do the last step. The instructions are to:
At the end of report:
A. Print the number of personnel records processed.
B. The number of records where there was an unsuccessful search of the Dept Table.
C. The number of records where there was an unsuccessful search of the Title Table.
I have completed all of the program except this last step. Can someone please help me finish this program?
enter code here ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PERSONNEL-FILE
ASSIGN TO 'CH12PPPF.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT DEPT-TABLE-FILE
ASSIGN TO 'CH12PPDT.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT TITLE-TABLE-FILE
ASSIGN TO 'CH12PPTT.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRINT-FILE
ASSIGN TO 'THORNTONCA4.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD PERSONNEL-FILE.
01 PERSONNEL-REC.
05 SSNO-IN PIC 9(9).
05 NAME-IN PIC X(20).
05 SALARY-IN PIC 9(6).
05 CAMPUS-CODE-IN PIC 9.
05 DEPT-CODE-IN PIC 99.
05 TITLE-CODE-IN PIC 999.
FD DEPT-TABLE-FILE.
01 DEPT-REC.
05 T-DEPT-NO PIC 99.
05 T-DEPT-NAME PIC X(10).
FD TITLE-TABLE-FILE.
01 TITLE-REC.
05 T-TITLE-CODE PIC 999.
05 T-TITLE-NAME PIC X(10).
FD PRINT-FILE.
01 PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 STORED-AREAS.
05 MORE-RECS PIC X(3) VALUE 'YES'.
05 WS-DATE.
10 WS-YEAR PIC 9999.
10 WS-MONTH PIC 99.
10 WS-DAY PIC 99.
05 WS-PAGE-CT PIC 99
VALUE ZERO.
05 WS-LINE-CT PIC 99
VALUE ZERO.
01 HDR1-OUT.
05 PIC X(25)
VALUE SPACES.
05 PIC X(20)
VALUE 'FINAL REPORT'.
05 DATE-OUT.
10 MONTH-OUT PIC 99.
10 PIC X
VALUE '/'.
10 DAY-OUT PIC 99.
10 PIC X
VALUE '/'.
10 YEAR-OUT PIC 9999.
05 PIC X(2)
VALUE SPACES.
05 PIC X(5)
VALUE 'PAGE'.
05 PAGE-OUT PIC Z9.
*****************************************************************
* The Campus Table consists of 5 10-position names and will be *
* accessed as a direct-referenced table. EACH_CAMPUS *
* subscriped by the CAMPUS_CODE_IN will provide the name. *
*****************************************************************
01 CAMPUTS-TABLE
VALUE 'UPSTATE DOWNSTATE CITY MELVILLE HUNTINGTON'.
05 EACH-CAMPUS
OCCURS 5 TIMES PIC X(10).
*****************************************************************
* The Dept Table will be accessed by a SEARCH. Even if the *
* table is entered in Dept No sequence, there would be no *
* real benefit to using a SEARCH ALL since there are only *
* 25 entries. *
*****************************************************************
01 DEPT-TABLE.
05 DEPT-ENTRIES OCCURS 25 TIMES INDEXED BY X1.
10 DEPT-NO PIC 99.
10 DEPT-NAME PIC X(10).
*****************************************************************
* The Title Talbe will be accessed by a SEARCH ALL. To use a *
* binary seach the entries must be in sequence by a key *
* field and the table should be relatively large. *
*****************************************************************
01 TITLE-TABLE.
05 TITLE-ENTRIES OCCURS 50 TIMES
ASCENDING KEY IS TITLE-NO INDEXED BY X2.
10 TITLE-NO PIC 999.
10 TITLE-NAME PIC X(10).
01 DETAIL-REC.
05 PIC X(1) VALUE SPACES.
05 SSNO-OUT PIC 999B99B9999.
05 PIC X(1) VALUE SPACES.
05 NAME-OUT PIC X(20).
05 PIC X(1) VALUE SPACES.
05 SALARY-OUT PIC $ZZZ,ZZZ.
05 PIC X(1) VALUE SPACES.
05 CAMPUS-OUT PIC X(10).
05 PIC X(1) VALUE SPACES.
05 DEPT-OUT PIC X(10).
05 PIC X(1) VALUE SPACES.
05 TITLE-OUT PIC X(10).
PROCEDURE DIVISION.
100-MAIN-MODULE.
OPEN INPUT PERSONNEL-FILE
DEPT-TABLE-FILE
TITLE-TABLE-FILE
OUTPUT PRINT-FILE
MOVE FUNCTION CURRENT-DATE TO WS-DATE
MOVE WS-MONTH TO MONTH-OUT
MOVE WS-DAY TO DAY-OUT
MOVE WS-YEAR TO YEAR-OUT
PERFORM 500-HDG-RTN.
PERFORM 200-LOAD-DEPT-TABLE
PERFORM 300-LOAD-TITLE-TABLE
PERFORM UNTIL MORE-RECS = 'NO '
READ PERSONNEL-FILE
AT END
MOVE 'NO ' TO MORE-RECS
NOT AT END
PERFORM 400-CALC-RTN
END-READ
END-PERFORM
CLOSE PERSONNEL-FILE
DEPT-TABLE-FILE
TITLE-TABLE-FILE
PRINT-FILE
STOP RUN.
200-LOAD-DEPT-TABLE.
PERFORM VARYING X1 FROM 1 BY 1
UNTIL X1 > 25
READ DEPT-TABLE-FILE
AT END DISPLAY 'NOT ENOUGH DEPT TABLE RECORDS'
STOP RUN
END-READ
MOVE DEPT-REC TO DEPT-ENTRIES (X1)
END-PERFORM.
300-LOAD-TITLE-TABLE.
PERFORM VARYING X2 FROM 1 BY 1
UNTIL X2 > 50
READ TITLE-TABLE-FILE
AT END DISPLAY 'NOT ENOUH TITLE TABLE RECORDS'
STOP RUN
END-READ
MOVE TITLE-REC TO TITLE-ENTRIES (X2)
IF X2 > 1 THEN
IF TITLE-NO (X2) <= TITLE-NO (X2 - 1)
DISPLAY 'TITLE RECORDS ARE NOT IN SEQUENCE'
STOP RUN
END-IF
END-IF
END-PERFORM.
400-CALC-RTN.
MOVE SPACES TO DETAIL-REC
MOVE SSNO-IN TO SSNO-OUT
MOVE NAME-IN TO NAME-OUT
MOVE SALARY-IN TO SALARY-OUT
IF CAMPUS-CODE-IN >= 1 AND <= 5
MOVE EACH-CAMPUS (CAMPUS-CODE-IN) TO CAMPUS-OUT
END-IF
SET X1 TO 1
SEARCH DEPT-ENTRIES
AT END MOVE 'XXXXXXXXXX' TO DEPT-OUT
WHEN DEPT-CODE-IN = DEPT-NO (X1)
MOVE DEPT-NAME (X1) TO DEPT-OUT
END-SEARCH
SEARCH ALL TITLE-ENTRIES
AT END MOVE 'XXXXXXXXXX' TO TITLE-OUT
WHEN TITLE-NO (X2) = TITLE-CODE-IN
MOVE TITLE-NAME (X2) TO TITLE-OUT
END-SEARCH
WRITE PRINT-REC FROM DETAIL-REC
AFTER ADVANCING 2 LINES.
500-HDG-RTN.
ADD 1 TO WS-PAGE-CT
MOVE WS-PAGE-CT TO PAGE-OUT
WRITE PRINT-REC FROM HDR1-OUT
AFTER ADVANCING PAGE
MOVE ZEROS TO WS-LINE-CT.
You need to:
Produce code to accumulate all the values you need to print at the end
Produce definition(s) of the final part of the report
Produce the final part of report once the main input file has been processed, ie after your first PERFORM and before the CLOSE
You should get into the habit of checking all file statuses after each IO operation, using FILE-STATUS, and accurately report when something unexpected happens.
You'll find it worthwhile to give good names even to indexes, and use 88s wherever possible for IF or EVALUATE and avoid using things like this "IF CAMPUS-CODE-IN >= 1 AND <= 5".
I am getting very strange scenario. I have one array defined in my COBOL pgm.
05 A-TABLE.
10 A-TABLE-LIST OCCURS 10 TIMES INDEXED BY A-IDX.
15 FILLER PIC X(7) VALUE '<TEST>'.
15 A-LIST-VALUE PIC X(30).
15 FILLER PIC X(8) VALUE '</TEST>'.
I am setting A-IDX=1 and moving 'XYZ' to A-LIST-VALUE(A-IDX).
While displaying A-TABLE, it is showing as
XYZ------------------------------
and all spaces... :(
I am not getting what is the issue here?
Can anyone help me to resolve this?
Regards,
Saisha.
You cannot set values for a table that way. One way to set values in a table is to use a REDEFINES and a separate data area.
05 A-TABLE-X.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
10 FILLER PIC X(45)
VALUE '<TEST> </TEST>'.
05 A-TABLE REDEFINES A-TABLE-X.
10 A-TABLE-LIST OCCURS 10 TIMES INDEXED BY A-IDX.
15 FILLER PIC X(7).
15 A-LIST-VALUE PIC X(30).
15 FILLER PIC X(8).
That is pretty cumbersome. Another method is to MOVE the data in at runtime in an initialisation paragraph.
05 A-TABLE REDEFINES A-TABLE-X.
10 A-TABLE-LIST OCCURS 10 TIMES INDEXED BY A-IDX.
15 A-LIST-A PIC X(7).
15 A-LIST-VALUE PIC X(30).
15 A-LIST-B PIC X(8).
PERFORM VARYING A-IDX FROM 1 BY 1 UNTIL A-IDX > 1
MOVE '<TEST> TO A-LIST-A(A-IDX)
MOVE SPACES TO A-LIST-VALUE(A-IDX)
MOVE '</TEST> TO A-LIST-B(A-IDX)
END-PERFORM
I didn't try compiling any of these, this is just freehand.
As a side note, if you are using Enterprise COBOL version 3.2 or higher and you are trying to create XML in COBOL, there exists an XML GENERATE statement.
To my understanding, your question is why "XYZ<27 spaces>" is being displayed when only "XYZ" was moved. If so, you need to initialize before moving and trim the spaces before displaying or moving into another variable.
If your problem is not yet solved, describe much otherwise let us know how it was resolved.