I am working on a bit of code at home and that is suppose to find and identify errors is a input file. I got it just about right, but two little errors are hitting me. The major problem though is this. I have to make a code that identifies "3077.B22" as an error because the first 5 columns are suppose to be numeric, but my current code is letting it pass. It hits every thing else though so I have to believe that it is seeing the period as a decimal point. Here is what I got that concerns to this part.
01 PART-NUMBER-CHECK.
05 P-N-NUM-1 PIC X(5).
05 P-N-LETTER PIC X.
05 P-N-NUM-2 PIC XX.
300-VALIDATE-PART-NUMBER.
MOVE 'NO' TO FIELD-ERROR-SWITCH
MOVE PART-NUMBER TO PART-NUMBER-CHECK
EVALUATE P-N-NUM-1
WHEN 00001 THRU 99999 CONTINUE
WHEN OTHER MOVE 'YES' TO FIELD-ERROR-SWITCH
END-EVALUATE
IF P-N-LETTER IS NUMERIC
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
IF P-N-LETTER IS ALPHABETIC-LOWER
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
IF P-N-NUM-2 IS ALPHABETIC
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
IF (P-N-NUM-2 > 00 AND < 69)
OR (P-N-NUM-2 >77 AND < 100)
CONTINUE
ELSE
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
IF FIELD-ERROR-SWITCH = 'YES'
MOVE 'YES' TO RECORD-ERROR-SWITCH
MOVE 'Part Number' TO FIELD-NAME
MOVE PART-NUMBER TO FIELD-VALUE
PERFORM 400-WRITE-DETAIL-LINE
END-IF.
My second problem is similar cause it is seeing an * in another field as a alphabetic.
Here is the paragraph to that:
340-VALIDATE-INITIAL.
MOVE 'NO' TO FIELD-ERROR-SWITCH
INSPECT INITIALS
TALLYING I-CHECK FOR ALL SPACES
IF I-CHECK > 0
MOVE 'YES' TO FIELD-ERROR-SWITCH
MOVE 0 TO I-CHECK
END-IF
IF INITIALS IS NUMERIC
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
IF FIELD-ERROR-SWITCH = 'YES'
MOVE 'YES' TO RECORD-ERROR-SWITCH
MOVE 'Initials' TO FIELD-NAME
MOVE INITIALS TO FIELD-VALUE
PERFORM 400-WRITE-DETAIL-LINE
END-IF.
Please help, I am done as soon as I get over this little bump in the road.
Given the following declaration:
01 PART-NUMBER-CHECK.
05 P-N-NUM-1 PIC X(5).
05 P-N-LETTER PIC X.
05 P-N-NUM-2 PIC XX.
and something like:
MOVE 'NO' TO FIELD-ERROR-SWITCH
MOVE '3077.B22' TO PART-NUMBER-CHECK
EVALUATE P-N-NUM-1
WHEN 00001 THRU 99999 CONTINUE
WHEN OTHER MOVE 'YES' TO FIELD-ERROR-SWITCH
END-EVALUATE
Why isn't the FIELD-ERROR-SWITCH set to 'YES'? COBOL casts
00001 and 99999 into their PIC X equivalents before applying
the range tests (casting rules here are rather complicated so I'm not going to
get into it). The actual test COBOL performs here
is roughly equivalent to the following:
IF '00001' <= '3077.' AND '99999' >= '3077.'
Given that these are string tests the condition is
true, meaning that you bypass setting the FIELD-ERROR-SWITCH. Using
a THRU range test in COBOL is very useful but requires a bit of caution. Only use
THRU when you know you have valid data to begin with or are doing single character
comparisons. For example
05 TEST-CHAR PIC X.
88 IS-DIGIT VALUE '0' THRU '9'.
88 IS-LOWER-LETTER VALUE 'a' THRU 'i',
'j' THRU 'r',
's' THRU 'z'.
88 IS-UPPER-LETTER VALUE 'A' THRU 'I',
'J' THRU 'R',
'S' THRU 'Z'.
88 IS-SPACE VALUE SPACE.
Then code like:
MOVE SOME-CHAR TO TEST-CHAR
EVALUATE TRUE
WHEN IS-DIGIT
DISPLAY 'IS A DIGIT'
WHEN IS-LOWER-LETTER OR IS-UPPER-LETTER
DISPLAY 'IS ALPHA'
WHEN IS-SPACE
DISPLAY 'IS A SPACE'
WHEN OTHER
DISPLAY 'IS A SOMETHING ELSE'
END-EVALUATE
is pretty much bullet proof.
Why did I break the alphabet range up into distinct groups? Check out the EBCDIC
collating sequence and you will find that some non alphabet characters sneak
in between 'i' and 'j' then again between 'r' and 's'! Oh, how I love EBCDIC!
How to solve your problem? Something as simple as:
IF P-N-NUM-1 IS NUMERIC
IF P-N-NUM-1 = ZERO
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
ELSE
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
would do the trick. The NUMERIC test ensures that P-N-NUM-1 is composed
of only digits. The ZERO test ensures that it is not zero. In this case negative numbers
are excluded on the NUMERIC test. Period/plus/minus are not NUMERIC when the
item being tested is declared as PIC X or PIC 9. Had the elementary item been declared as PIC S9(5) PACKED-DECIMAL, then a leading sign would be pass the NUMERIC test. The COBOL NUMERIC class test takes a bit of study to fully understand.
Big hint: Ensure that things that are supposed to be numeric are stored
in elementary items that are declared as numeric. I would try declaring P-N-NUM-1 and
P-N-NUM-2 using PIC 9. Move un-validated data into PART-NUMBER-CHECK which by default
is PIC X so no errors occur, then validate elementary numeric data items using
IF NUMERIC tests. Once you know you have numeric data then your range tests (e.g. 00001 THRU 99999,
greater/less than) will not lead you astray - as happened here.
Why is an '*' sneaking through your second bit of code? You never set an error on non-alpha characters,
only on numerics. Why not try flipping your NUMERIC test into a NOT ALPHABETIC test?
See if that helps!
You are on the right track, but does your compiler support the NumVal function? You could do this:
01 Part-Num 9(5).9(2).
Compute Part-Num = Function NumVal( Part-Num-Input )
on exception
Set Part-Num-Not-Valid to true
End-Compute
A long time since I wrote my last COBOL, and I don't have a compiler at hand, so expect some sintax checks in the code, but you'll get the idea ...
01 PART-NUMBER-CHECK.
05 P-N-NUM-1 .
07 p-x-occ occurs 5 pic X.
05 P-N-NUM-1-N redefines P-N-NUM-1. .
07 p-n-occ occurs 5 pic 9.
05 P-N-LETTER PIC X.
05 P-N-NUM-2 PIC XX.
01 FIELD-ERROR-SWITCH pic x(3).
88 no-error value 'NO'.
300-VALIDATE-PART-NUMBER.
MOVE 'NO' TO FIELD-ERROR-SWITCH
MOVE PART-NUMBER TO PART-NUMBER-CHECK.
perform validate-p-n-occurs varying I from 1 to 5.
if no-error
IF ( P-N-LETTER IS NUMERIC or P-N-LETTER IS ALPHABETIC-LOWER or
P-N-NUM-2 IS ALPHABETIC)
MOVE 'YES' TO FIELD-ERROR-SWITCH
ELSE
IF (P-N-NUM-2 < 0) OR (P-N-NUM-20 > 68 AND < 79) OR (P-N-NUM-2 >99)
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF
END-IF
END-IF
IF FIELD-ERROR-SWITCH = 'YES'
MOVE 'YES' TO RECORD-ERROR-SWITCH
MOVE 'Part Number' TO FIELD-NAME
MOVE PART-NUMBER TO FIELD-VALUE
PERFORM 400-WRITE-DETAIL-LINE
END-IF.
validate-p-n-occurs.
IF p-x-occ(I) is not NUMERIC or (p-n-occ(I) < 0 or > 10)
MOVE 'YES' TO FIELD-ERROR-SWITCH
END-IF.
Related
We have to find more than one way to get the ascii value of a character.
On top of that we also need to get the sum of all the characters's ascii values.
I currently have the below and works alright for the first section where you need individual values
.
I just need to know if there is an easier way or a function to do this in Cobol?
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-COUNTERS.
03 WS-COUNTER PIC 9(05).
03 WS-INPUT PIC X(01).
03 WS-DISPLAY PIC 9(03).
01 W1-ARRAY.
03 ALPHABETIC-CHARS OCCURS 26 TIMES PIC X.
01 W3-ARRAY.
03 NUMERIC-CHARS OCCURS 26 TIMES PIC X.
PROCEDURE DIVISION.
A000-MAIN SECTION.
BEGIN.
PERFORM B000-INITIALIZE.
PERFORM C000-PROCESS UNTIL WS-COUNTER > 26.
PERFORM D000-END.
A099-EXIT.
STOP RUN.
B000-INITIALIZE SECTION.
ACCEPT WS-INPUT.
MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO W1-ARRAY.
MOVE "01234567890000000000000000" TO W3-ARRAY.
MOVE 1 TO WS-COUNTER.
MOVE 0 TO WS-DISPLAY.
B099-EXIT.
EXIT.
C000-PROCESS SECTION.
C001-BEGIN.
IF WS-INPUT IS NUMERIC
IF NUMERIC-CHARS(WS-COUNTER) = WS-INPUT
COMPUTE WS-DISPLAY = WS-COUNTER + 48 - 1
END-IF
ELSE
IF ALPHABETIC-CHARS(WS-COUNTER) = WS-INPUT
COMPUTE WS-DISPLAY = WS-COUNTER + 65 - 1
END-IF
END-IF.
ADD 1 TO WS-COUNTER.
C099-EXIT.
EXIT.
Have a look at FUNCTION ORD and keep in mind that you will get the ordinal number in the program's collating sequence (which may be EBCDIC or not the full ASCII).
As this function was introduced in the COBOL85 standard it should be available in most compilers (your question misses the compiler/machine you use).
I have an error code 18 in COBOL when I'm trying to write the output to a file. I'm using Micro Focus VS 2012. I have tried everything but it seem doesn't print the output correctly at this time.
...
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GRADE-FILE ASSIGN TO 'Grades.txt'.
SELECT PRINT-FILE ASSIGN TO 'Output.txt'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD GRADE-FILE
LABEL RECORDS ARE STANDARD.
01 GRADE-RECORD.
05 I-STUDENT PIC X(14).
05 I-GRADE1 PIC 999.
05 I-GRADE2 PIC 999.
05 I-GRADE3 PIC 999.
05 I-GRADE4 PIC 999.
05 I-GRADE5 PIC 999.
05 I-GRADE6 PIC 999.
FD PRINT-FILE
LABEL RECORDS ARE STANDARD.
01 PRINT-RECORD PIC X(80).
WORKING-STORAGE SECTION.
01 PROGRAM-VARIABLES.
05 W-AVERAGE PIC 999V99.
05 W-EOF-FLAG PIC X VALUE 'N'.
01 PAGE-TITLE.
05 PIC X(46) VALUE
' S I X W E E K G R A D E R E P O R T'.
01 HEADING-LINE1.
05 PIC X(51) VALUE
' Student T e s t S c o r e s Average'.
01 HEADING-LINE2.
05 PIC X(51) VALUE
'--------------------------------------------------'.
01 DETAIL-LINE.
05 PIC X VALUE SPACE.
05 O-STUDENT PIC X(14).
05 PIC X VALUE SPACE.
05 O-GRADE1 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE2 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE3 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE4 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE5 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE6 PIC ZZ9.
05 PIC X(4) VALUE SPACE.
05 O-AVERAGE PIC ZZ9.99.
PROCEDURE DIVISION.
10-MAINLINE.
OPEN INPUT GRADE-FILE
OUTPUT PRINT-FILE
PERFORM 20-PRINT-HEADINGS
PERFORM 30-PROCESS-LOOP
CLOSE GRADE-FILE
PRINT-FILE
STOP RUN.
20-PRINT-HEADINGS.
MOVE PAGE-TITLE TO PRINT-RECORD
WRITE PRINT-RECORD AFTER ADVANCING 1 LINE
MOVE HEADING-LINE1 TO PRINT-RECORD
WRITE PRINT-RECORD AFTER ADVANCING 3 LINES
MOVE HEADING-LINE2 TO PRINT-RECORD
WRITE PRINT-RECORD AFTER ADVANCING 1 LINE.
30-PROCESS-LOOP.
* PERFORM 40-READ-RECORD
READ GRADE-FILE
PERFORM UNTIL W-EOF-FLAG = 'Y'
PERFORM 50-COMPUTE-GRADE-AVERAGE
PERFORM 60-PRINT-DETAIL-LINE
READ GRADE-FILE
* PERFORM 40-READ-RECORD
END-PERFORM.
*40-READ-RECORD.
* READ GRADE-FILE
* AT END MOVE 'Y' TO W-EOF-FLAG.
50-COMPUTE-GRADE-AVERAGE.
COMPUTE W-AVERAGE ROUNDED = (I-GRADE1 + I-GRADE2 + I-GRADE3 + I-GRADE4 + I-GRADE5 + I-GRADE6 ) / 6.
60-PRINT-DETAIL-LINE.
MOVE SPACES TO DETAIL-LINE
MOVE I-STUDENT TO O-STUDENT
MOVE I-GRADE1 TO O-GRADE1
MOVE I-GRADE2 TO O-GRADE2
MOVE I-GRADE3 TO O-GRADE3
MOVE I-GRADE4 TO O-GRADE4
MOVE I-GRADE5 TO O-GRADE5
MOVE I-GRADE6 TO O-GRADE6
MOVE W-AVERAGE TO O-AVERAGE
WRITE PRINT-RECORD FROM DETAIL-LINE AFTER ADVANCING 1 LINE.
end program "GradeReport.Program1"
S I X W E E K G R A D E R E P O R T
Student T e s t S c o r e s Average
--------------------------------------------------
KellyAntonetz0 700 500 980 800 650 852 747.00
obertCain09708 207 907 309 406 2;1 25> 400.67
Dehaven0810870 940 850 930 892 122 981 785.83
rmon0760770800 810 750 92; 142 9>1 <1> 816.33
g0990930890830 940 901 =1> 41= ?82 65 872.50
06707108408809 6=9 ;52 565 <<0 900 870 924.33
78052076089Woo 493 9>4 520 760 760 830 734.50
Something prior to your COBOL program has pickled your file by removing all the spaces and shuffling the data to the left.
Your first student shows as KellyAntonetz but likely should be Kelly Antonetz. Since only one space was removed, the grade data has moved only one place to the left, so the numbers are still recognizable and although the average is a factor of 10 out, it is approximately correct.
It is not actually correct (except for the power of 10) because of that 2 following the 85. Where did that 2 come from?
It came from the next record, where the first-name should be Robert but you show as obertCain09708. The ASCII code for the letter R is X'82'. When treated as a number by COBOL the 8 will be ignored (or will cause a crash when in the trailing byte of a number). Your compiler doesn't cause the code to crash, but does treat the R as the number 2.
obertCain is only 9 bytes out of the 14 you have for the name. The five spaces/blanks which have been "lost" this time cause the numerics to be pulled-left by five bytes. From that point onward, explaining how the output you show fits the presumed input becomes an academic exercise only.
Further support is a reference for what would be a FILE STATUS code of 18 from a Micro Focus compiler, here: http://www.simotime.com/vsmfsk01.htm
Which says, for 18:
Read part record error: EOF before EOR or file open in wrong mode
(Micro Focus).
Your final record would "finish" before expected, with end-of-file being detected before 32 bytes have been read.
Note that the error is on your input file, not your output file.
Losing the spaces in that way can be done in many ways, so I can't guess what you are doing to the file before it gets to the COBOL program, but neither COBOL itself nor your code is doing that.
Take note of Emmad Kareem's comments. Use the FILE STATUS. Check the file-status field (define one per file) after each IO, so that you know when a problem occurs, and what the problem is.
Testing the file-status field for 10 on a file you are reading sequentially gives cleaner code than the AT END on the READ.
Note also that if your program had not crashed there, it would either loop infinitely or crash shortly afterwards. Probably in trying to fix your problem, you have commented-out your use of the "read paragraph" and in that paragraph is the only place you are setting end-of-file.
If you use the file-status instead of AT END, you don't need to define a flag/switch you can use an 88 on the file-status field and have the COBOL run-time set it for you directly, without you having to code it.
Just a couple of points about your DETAIL-LINE.
There is no need to MOVE SPACE to it, as you MOVE to each named field, and the (un-named) FILLERs have VALUE SPACE.
You don't necessarily need the (un-named) FILLERS. Try this:
01 DETAIL-LINE.
05 O-STUDENT PIC BX(14).
05 O-GRADE1 PIC ZZZ9.
05 O-GRADE2 PIC ZZZ9.
05 O-GRADE3 PIC ZZZ9.
05 O-GRADE4 PIC ZZZ9.
05 O-GRADE5 PIC ZZZ9.
05 O-GRADE6 PIC ZZZ9.
05 O-AVERAGE PIC Z(6)9.99.
If you work with COBOL, you may see this type of thing, so it is good to know. With massive amounts of output there is probably a small performance penalty. You may find it more convenient for "lining-up" output to headings.
Ah. Putting together you non-use of LINE SEQUENTIAL for your input file, I predict you have a "script" running some time before the COBOL program which is supposed to remove the record-terminators (whatever those are on your OS) at the end of each logical record, but that you have accidentally removed all whitespace from all positions of your record instead.
With LINE SEQUENTIAL you can have records of fixed-length which also happen to be "terminated". Unless the exercise specifically includes the removal of the record terminators, just use LINE SEQUENTIAL.
If you are supposed to remove the terminators, don't do so for whitespace which covers too much (be specific) and also "anchor" the change to the end of the record.
Having issues with using the GO-TO statement. This is suppose to run until the user types 'END'. If I type 'END' when I first open the program it will close out but if I type it after entering valid data for the first pass thru it just continues to bring back the user input data screen.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT USED-CAR-FILE-OUT
ASSIGN TO 'USED-CAR.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD USED-CAR-FILE-OUT.
01 USED-CAR-RECORD-OUT PIC X(80).
WORKING-STORAGE SECTION.
01 FIRST-RECORD PIC X(3) VALUE 'YES'.
01 ID-CODE PIC X(3).
01 TOTAL-CASH-PAYMENT PIC 9(5).
01 MONTHLY-PAYMENT PIC 9(4).
01 NUMBER-OF-MONTHS PIC 9(3).
01 TOTAL-BALANCE PIC S9(6)V99 VALUE ZEROS.
01 INTEREST-COLLECTED PIC 99V99 VALUE ZEROS.
01 MONTH-DIFF PIC 99 VALUE ZEROS.
01 MONTH-NUM PIC 99 VALUE ZEROS.
01 YEAR-NUM PIC 99 VALUE ZEROS.
01 ID-HOLD PIC X(3) VALUE SPACES.
01 PAYMENT-HOLD PIC X(3) VALUE SPACES.
01 DETAIL-LINE.
05 ID-CODE-DL PIC X(3).
05 PIC X(3) VALUE SPACES.
05 PIC X(4) VALUE 'Yr='.
05 YEAR-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(4) VALUE 'MO='.
05 MONTH-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Pmt='.
05 PAYMENT-DL PIC $$$,$$$.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Int='.
05 INTEREST-EARNED-DL PIC $$$$.99.
05 PIC X(3) VALUE SPACES.
05 PIC X(5) VALUE 'Bal='.
05 BALANCE-DL PIC $$$,$$$.99.
PROCEDURE DIVISION.
100-MAIN.
OPEN OUTPUT USED-CAR-FILE-OUT
PERFORM 200-USER-INPUT THRU 299-EXIT
CLOSE USED-CAR-FILE-OUT
STOP RUN.
200-USER-INPUT.
DISPLAY 'Used Car Sales Report'
DISPLAY 'Enter the ID code (or END) - maxium three char.'
ACCEPT ID-CODE
IF ID-CODE = 'END'
GO TO 299-EXIT
END-IF
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
DISPLAY 'Enter the Monthly Payment - maximum four digits'
ACCEPT MONTHLY-PAYMENT
DISPLAY 'Enter the Number of Months - maximum three digits'
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
299-EXIT.
EXIT.
300-RECORD-PROCESS.
IF TOTAL-CASH-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE TOTAL-CASH-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
MOVE 'NO' TO FIRST-RECORD
END-IF
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERORM 200-USER-INPUT
END-IF
IF MONTHLY-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE 'NO' TO FIRST-RECORD
END-IF
MOVE MONTHLY-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF TOTAL-CASH-PAYMENT > 0
MOVE 0 TO TOTAL-CASH-PaYMENT
MOVE 0 TO PAYMENT-DL
END-IF
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERFORM 200-USER-INPUT
END-IF.
EDIT solved the issue below
I also am having issues if months > 24. I step through the program and it shows my last detail line as the correct result but yet my output stops at 24 months. Thanks in advance.
AAAAAAAk!
PERFORM SEVERE-BEATING-ON-WHOEVER-MENTIONED-PERFORM-THROUGH
USING HEAVY-OBJECT
UNTIL PROMISE-EXTRACTED-TO-NEVER-DO-IT-AGAIN.
PERFORM THOUGH is EVIL. It causes layout-dependent code.
At the top control-level, use
PERFORM 200-USER-INPUT
UNTIL ID-CODE = 'END'.
(or possibly use 88 USER-INPUT-ENDED on ID-CODE - matter of style)
How you then determine whether to continue with input in 200-... is your choice, either
IF NOT USER-INPUT-ENDED
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
...
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
OR
IF NOT USER-INPUT-ENDED
PERFORM 210-ACCEPT-DETAILS.
210-ACCEPT-DETAILS.
DISPLAY 'Enter the Total Cash Payment - maximum five digits'.
ACCEPT TOTAL-CASH-PAYMENT.
...
ACCEPT NUMBER-OF-MONTHS.
PERFORM 300-RECORD-PROCESS.
Since you PERFORMED 200-... then only 200-... will be executed; 210-... is a new paragraph which can only be reached from 200-... IF END is not entered.
Next step is to slightly modify 300-...
Move the initialisation ( FIRST-RECORD = 'YES' code) before the PERFORM 300-... in 200-... and then modify the PERFORM 300-RECORD-PROCESS. to
PERFORM 300-RECORD-PROCESS
UNTIL TOTAL-BALANCE = 0.
(I'm assuming here that this is the report-terination condition; if it isn't, substitute your report-termination condition)
You can now restructure 300-... to calculate the interest payable, modify the year and month numbers and show the result. ALL of the PERFORMs in 300-... will disappear.
So, in essence you have
MAIN:perform user-input until end-detected.
user-input: get user data; perform calculations until balance is zero.
calculations: one month's calculations at a time.
This also has the advantage that if you choose, you could insert
IF MONTHLY-PAYMENT IS LESS THAN INTEREST-COLLECTED
MOVE 'ERR' TO ID-CODE.
And use 'ERR' in ID-CODE to produce an appropriate error-message in 300-... instead of the progressive report lines AND at the same time assign 0 to TOTAL-BALANCE which terminates the PERFORM 300-... UNTIL ....
Your use of GO TO and PERFORM THROUGH paragraph ranges has corrupted the procedure return mechanism that COBOL
uses to maintain proper program flow of control. In essence, you have a program that is invalid - it might compile
without error but is still an invalid program according to the rules of COBOL.
Here is an outline of what your program is doing from a flow of control perspective. The
mainline program is essentially:
100-MAIN.
PERFORM 200-USER-INPUT THRU 299-EXIT
This is asking COBOL to execute all the code found from the beginning of
200-USER-INPUT through to the end of 299-EXIT. The outline for these
procedures is:
200-USER-INPUT.
IF some condition GO TO 299-EXIT
...
PERFORM 300-RECORD-PROCESS
.
299-EXIT.
Notice that if some condition is true, program flow will skip past the end
of 200-USER-INPUT and jump into 299-EXIT. 299-EXIT does not do anything
very interesting, it is just an empty paragraph serving as the end of a
PERFORMed range of paragraphs.
In paragraph 300-RECORD-PROCESS you have a fair bit of code. The interesting
bit is:
300-RECORD-PROCESS.
...
PERFORM 200-USER-INPUT
Notice that PERFORM 200-USER-INPUT this is not a PERFORM THRU, as you had coded in 100-MAIN.
The problem is that when you get back into 200-USER-INPUT and some codition becomes
true (as it will when you enter 'EXIT'), the flow of control
jumps to 299-EXIT which is past the end of the paragraph
you are currently performing. From this point
forward the flow of control mechanism used by COBOL to manage return from PERFORM verbs has
been corrupted. There is no longer a normal flow of control mechanism to return back to where 200-USER-INPUT
was performed from in 300-RECORD-PROCESS.
What happens next is not what most programmers would expect. Most programmers seem to expect
that when the end of 299-EXIT is reached program flow should return to wherever the last PERFORM
was done. In this case, just after PERFORM 200-USER-INPUT. No, COBOL doesn't work that way, flow of control
will continue with the next executable statement following 299-EXIT. This gets you
right back to the first executable statement in 300-RECORD-PROCESS! And that is why you
are not getting expected behaviour from this program.
Logic flow in COBOL programs must ensure that the end of performed procedures are
always reached in the reverse order from which they were made. This corresponds to the call/return
stack semantics that
most programmers are familiar with.
My advice to you is to avoid the use of PERFORM THRU and GO TO. These are two of the biggest
evils left in the COBOL programming language today. These constructs are hang-overs from a
bygone era of programming and have no constructive benefit today.
Your problem is that you have created an infinite loop for yourself. You 200- paragraph PERFORMs the 300- paragraph, and your 300- paragraph PERFORMS your 200- paragraph.
You need to restructure your program.
A paragraph called 200-USER-INPUT should just concern itself with that.
repeat until end of input
get some input
if there is input to process
process the input
Yoiks! I just noticed you also PERFORM 300- from within 300-!
I need to find how many policies are in each territory based on the territory code. So everytime I find the territory in the record, I need to increment the count for that territory in my table
then I would be able to move it to my output. I can't figure out how to count the policies in each territory based on the record below. I've tried a variety of things but nothing seems to work.
If you need more information, please let me know.
Below is the definition and an excerpt from the record (total of 57 records)
rec-94-type pic x(2)
rec-94-policy-number pic x(8)
filler pic x(5)
rec-94-parish-code pic x(3)
filler pic x(1)
rec-94-territory-code pic x(1)
94A 018517 080 1
94A 027721 090 1
94A 036470 250 6
94A 049137 010 1
......
My most recent attempt:
05 T2-TERRITORY-COUNT.
10 FILLER PIC X(4) VALUE '1 '.
10 FILLER PIC X(4) VALUE '2 '.
10 FILLER PIC X(4) VALUE '3 '.
10 FILLER PIC X(4) VALUE '4 '.
10 FILLER PIC X(4) VALUE '5 '.
10 FILLER PIC X(4) VALUE '6 '.
10 FILLER PIC X(4) VALUE '7 '.
10 FILLER PIC X(4) VALUE '8 '.
10 FILLER PIC X(4) VALUE '9 '.
05 T2-TERRITORY-TABLE REDEFINES T2-TERRITORY-COUNT.
10 T2-ENTRY OCCURS 9 TIMES
INDEXED BY T2-INDEX.
15 T2-TERRITORY-CODE PIC X.
15 T2-TERRITORY-COUNTER PIC 999.
A000-MAINLINE.
PERFORM B000-OPENING-PROCEDURE.
PERFORM B600-PRINT-HEADINGS.
PERFORM B200-READ-FILE.
PERFORM B300-MAIN-PROCEDURE
UNTIL END-OF-FILE-SW = 'YES'.
PERFORM B800-MOVE-TERRITORY-CODE
VARYING T2-INDEX FROM 1 BY 1
UNTIL T2-INDEX > 9.
PERFORM B110-MOVE-COUNTS
PERFORM B100-CLOSING-PROCEDURE.
STOP RUN.
B000-OPENING-PROCEDURE.
OPEN OUTPUT REPORT-FILE.
OPEN OUTPUT PRINT-FILE.
OPEN INPUT INPUT-FILE.
B100-CLOSING-PROCEDURE.
PERFORM B500-PRINT-TOTAL-LINE.
CLOSE REPORT-FILE.
CLOSE PRINT-FILE.
CLOSE INPUT-FILE.
B200-READ-FILE.
READ INPUT-FILE INTO RECORD-TYPE-94
AT END MOVE 'YES' TO END-OF-FILE-SW.
B300-MAIN-PROCEDURE.
IF REC-94-TYPE = "94"
PERFORM B400-SEARCH-TERRITORY
PERFORM B900-COUNT-POLICIES
ELSE
WRITE REPORT-RECORD FROM RECORD-TYPE-94
END-IF.
ADD 1 TO A-LINE-COUNT.
PERFORM B200-READ-FILE.
B400-SEARCH-TERRITORY.
SET T1-INDEX TO 1.
SEARCH T1-ENTRY
AT END
DISPLAY 'PARISH NOT FOUND IN TABLE'
CALL 'CEE3ABD' USING BY VALUE 12 BY VALUE 1
WHEN
REC-94-PARISH-CODE = T1-PARISH(T1-INDEX)
MOVE T1-TERRITORY(T1-INDEX) TO
REC-94-TERRITORY-CODE
ADD 1 TO A-DISK-COUNTER
PERFORM B700-MOVE-RECORDS
END-SEARCH.
B500-PRINT-TOTAL-LINE.
MOVE A-LINE-COUNT TO TOTAL-RECORDS.
MOVE A-DISK-COUNTER TO TOTAL-POLICIES.
WRITE PRINT-RECORD FROM TOTAL-LINE.
B600-PRINT-HEADINGS.
ADD 1 TO A-PAGE-COUNT.
MOVE A-PAGE-COUNT TO PRINT-PAGE-NUMBER.
WRITE PRINT-RECORD FROM HEADER.
WRITE PRINT-RECORD FROM HEADER-LINE-2.
WRITE PRINT-RECORD FROM COLUMN-LINE.
B700-MOVE-RECORDS.
MOVE REC-94-TYPE TO REC-94-TYPE-OUT
MOVE REC-94-POLICY-NUMBER TO REC-94-POLICY-NUMBER-OUT
MOVE REC-94-PARISH-CODE TO REC-94-PARISH-CODE-OUT
MOVE REC-94-TERRITORY-CODE TO REC-94-TERRITORY-CODE-OUT
WRITE REPORT-RECORD FROM TRNREC94-OUT.
B800-MOVE-TERRITORY-CODE.
MOVE T2-TERRITORY-CODE(T2-INDEX) TO DET-TERRITORY.
WRITE PRINT-RECORD FROM DETAIL-LINE.
B900-COUNT-POLICIES.
MOVE ZEROES TO T2-TERRITORY-COUNTER(T2-INDEX).
SET T2-INDEX TO 1.
SEARCH T2-ENTRY
AT END
DISPLAY 'NO POLICIES FOUND.'
WHEN
REC-94-TERRITORY-CODE =
T2-TERRITORY-CODE(T2-INDEX)
ADD 1 TO T2-TERRITORY-COUNTER(T2-INDEX)
END-SEARCH.
MOVE T2-TERRITORY-COUNTER(T2-INDEX) TO DET-NUMBER-POLICIES.
WRITE PRINT-RECORD FROM DETAIL-LINE.
I'd appreciate any pointers or just the correct direction to go in for this.. Thanks in advance!
My final code:
PERFORM B000-OPENING-PROCEDURE.
PERFORM B600-PRINT-HEADINGS.
PERFORM B200-READ-FILE.
PERFORM B300-MAIN-PROCEDURE
UNTIL END-OF-FILE-SW = 'YES'.
PERFORM C100-MOVE-COUNTS
VARYING T2-INDEX FROM 1 BY 1
UNTIL T2-INDEX > 9.
PERFORM B100-CLOSING-PROCEDURE.
STOP RUN.
B000-OPENING-PROCEDURE.
OPEN OUTPUT REPORT-FILE.
OPEN OUTPUT PRINT-FILE.
OPEN INPUT INPUT-FILE.
B100-CLOSING-PROCEDURE.
PERFORM B500-PRINT-TOTAL-LINE.
CLOSE REPORT-FILE.
CLOSE PRINT-FILE.
CLOSE INPUT-FILE.
B200-READ-FILE.
READ INPUT-FILE INTO RECORD-TYPE-94
AT END MOVE 'YES' TO END-OF-FILE-SW.
B300-MAIN-PROCEDURE.
IF REC-94-TYPE = "94"
PERFORM B400-SEARCH-TERRITORY
ELSE
WRITE REPORT-RECORD FROM RECORD-TYPE-94
END-IF.
ADD 1 TO A-LINE-COUNT.
PERFORM B200-READ-FILE.
B400-SEARCH-TERRITORY.
SET T1-INDEX TO 1.
SEARCH T1-ENTRY
AT END
DISPLAY 'PARISH NOT FOUND IN TABLE'
CALL 'CEE3ABD' USING BY VALUE 12 BY VALUE 1
WHEN
REC-94-PARISH-CODE = T1-PARISH(T1-INDEX)
MOVE T1-TERRITORY(T1-INDEX) TO
REC-94-TERRITORY-CODE
ADD 1 TO A-DISK-COUNTER
PERFORM B700-MOVE-RECORDS
PERFORM B900-COUNT-POLICIES
END-SEARCH.
B500-PRINT-TOTAL-LINE.
MOVE A-LINE-COUNT TO TOTAL-RECORDS.
MOVE A-DISK-COUNTER TO TOTAL-POLICIES.
WRITE PRINT-RECORD FROM TOTAL-LINE.
B600-PRINT-HEADINGS.
ADD 1 TO A-PAGE-COUNT.
MOVE A-PAGE-COUNT TO PRINT-PAGE-NUMBER.
WRITE PRINT-RECORD FROM HEADER.
WRITE PRINT-RECORD FROM HEADER-LINE-2.
WRITE PRINT-RECORD FROM COLUMN-LINE.
B700-MOVE-RECORDS.
MOVE REC-94-TYPE TO REC-94-TYPE-OUT
MOVE REC-94-POLICY-NUMBER TO REC-94-POLICY-NUMBER-OUT
MOVE REC-94-PARISH-CODE TO REC-94-PARISH-CODE-OUT
MOVE REC-94-TERRITORY-CODE TO REC-94-TERRITORY-CODE-OUT
WRITE REPORT-RECORD FROM TRNREC94-OUT.
B900-COUNT-POLICIES.
SET T2-INDEX TO 1.
SEARCH T2-ENTRY
AT END
DISPLAY 'NO POLICIES FOUND.'
WHEN
REC-94-TERRITORY-CODE = T2-TERRITORY-CODE(T2-INDEX)
DD 1 TO T2-TERRITORY-COUNTER(T2-INDEX)
END-SEARCH.
C100-MOVE-COUNTS.
MOVE T2-TERRITORY-CODE(T2-INDEX) TO DET-TERRITORY.
MOVE T2-TERRITORY-COUNTER(T2-INDEX) TO DET-NUMBER-POLICIES.
WRITE PRINT-RECORD FROM DETAIL-LINE.
The version of B900 with the search statement should work, but B900 is called, and only called once, from A000. Move the PERFORM B900 statement to B300 and you should collect a count for each record read.
Also, T2-TERRITORY-COUNTER is initialized with spaces. Please initialize it with zeros. Depending on your compiler, it might not make a difference, but it is easier to understand the intent of the variable if it starts from zero.
* update *
Your updated code still has spaces for T2-TERRITORY-COUNTER.
Perhaps the following will help. It is based on your code, but some parts were removed to make the relevant parts easier to see. The code below works for GNU Cobol (formerly OpenCobol - see sourceforge.net).
IDENTIFICATION DIVISION.
PROGRAM-ID. COUNT-TERRITORY.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT POLICY-FILE ASSIGN TO 'POLICY.DAT'
FILE STATUS IS POLICY-FILE-STATUS
ORGANIZATION IS LINE SEQUENTIAL.
SELECT REPORT-FILE ASSIGN TO 'POLICY.RPT'
FILE STATUS IS REPORT-FILE-STATUS
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD POLICY-FILE.
01 POLICY-RECORD PIC X(20).
FD REPORT-FILE.
01 REPORT-RECORD PIC X(132).
WORKING-STORAGE SECTION.
01 IS-POLICY-FILE-AT-END PIC XXX VALUE 'NO '.
88 POLICY-FILE-AT-END VALUE 'YES'.
01 POLICY-FILE-STATUS PIC 9(2).
88 POLICY-FILE-OK VALUES 0 10.
* VALUE 00 = SUCCESS
* VALUE 10 = END OF FILE
01 REPORT-FILE-STATUS PIC 9(2).
88 REPORT-FILE-OK VALUES 0 10.
* VALUE 00 = SUCCESS
* VALUE 10 = END OF FILE
01 RECORD-TYPE-94.
05 REC-94-TYPE PIC X(2).
88 INCLUDED-RECORD-TYPE VALUE '94'.
05 REC-94-POLICY-NUMBER PIC X(8).
05 FILLER PIC X(5).
05 REC-94-PARISH-CODE PIC X(3).
05 FILLER PIC X(1).
05 REC-94-TERRITORY-CODE PIC X(1).
01 T2-TERRITORY-COUNT.
05 FILLER PIC X(4) VALUE '1000'.
05 FILLER PIC X(4) VALUE '2000'.
05 FILLER PIC X(4) VALUE '3000'.
05 FILLER PIC X(4) VALUE '4000'.
05 FILLER PIC X(4) VALUE '5000'.
05 FILLER PIC X(4) VALUE '6000'.
05 FILLER PIC X(4) VALUE '7000'.
05 FILLER PIC X(4) VALUE '8000'.
05 FILLER PIC X(4) VALUE '9000'.
01 T2-TERRITORY-TABLE REDEFINES T2-TERRITORY-COUNT.
05 T2-ENTRY OCCURS 9 TIMES
INDEXED BY T2-INDEX.
10 T2-TERRITORY-CODE PIC X.
10 T2-TERRITORY-COUNTER PIC 999.
PROCEDURE DIVISION.
A000-MAINLINE.
PERFORM B000-OPENING-PROCEDURE
PERFORM B200-READ-FILE
PERFORM B300-MAIN-PROCEDURE
UNTIL POLICY-FILE-AT-END
PERFORM C100-WRITE-TERRITORY-COUNTS
PERFORM B100-CLOSING-PROCEDURE
STOP RUN
.
B000-OPENING-PROCEDURE.
OPEN INPUT POLICY-FILE
OPEN OUTPUT REPORT-FILE
.
B100-CLOSING-PROCEDURE.
CLOSE POLICY-FILE
CLOSE REPORT-FILE
.
B200-READ-FILE.
READ POLICY-FILE INTO RECORD-TYPE-94
AT END SET POLICY-FILE-AT-END TO TRUE
PERFORM D100-CHECK-POLICY-FILE-STATUS
.
B300-MAIN-PROCEDURE.
IF INCLUDED-RECORD-TYPE
PERFORM B900-COUNT-POLICIES
ELSE
WRITE REPORT-RECORD FROM RECORD-TYPE-94
PERFORM D200-CHECK-REPORT-FILE-STATUS
END-IF
PERFORM B200-READ-FILE
.
B900-COUNT-POLICIES.
SET T2-INDEX TO 1
SEARCH T2-ENTRY
AT END
DISPLAY 'TERRITORY ' REC-94-TERRITORY-CODE
' UNKNOWN'
WHEN REC-94-TERRITORY-CODE = T2-TERRITORY-CODE (T2-INDEX)
ADD 1 TO T2-TERRITORY-COUNTER (T2-INDEX)
END-SEARCH
.
C100-WRITE-TERRITORY-COUNTS.
MOVE SPACES TO REPORT-RECORD
WRITE REPORT-RECORD
PERFORM D200-CHECK-REPORT-FILE-STATUS
PERFORM VARYING T2-INDEX FROM 1 BY 1
UNTIL T2-INDEX > 9
STRING 'POLICY COUNT FOR TERRITORY '
T2-TERRITORY-CODE (T2-INDEX)
': '
T2-TERRITORY-COUNTER (T2-INDEX)
INTO REPORT-RECORD
WRITE REPORT-RECORD
PERFORM D200-CHECK-REPORT-FILE-STATUS
END-PERFORM
.
D100-CHECK-POLICY-FILE-STATUS.
IF NOT POLICY-FILE-OK
DISPLAY 'ERROR CODE READING POLICY FILE: '
POLICY-FILE-STATUS
END-IF
.
D200-CHECK-REPORT-FILE-STATUS.
IF NOT REPORT-FILE-OK
DISPLAY 'ERROR CODE WRITING REPORT FILE: '
POLICY-FILE-STATUS
END-IF
.
You PERFORM B900-COUNT-POLICIES only once, after the end-of-file is already reached.
B900- also just uses whatever value T2-INDEX last had.
You have two main choices: either a loop to do it; or, assuming that your territory is zero to less-than-or-equal-to nine - in which case you can use the value of the territory to set the value for your index and just add. SEARCH is possible (the reason it didn't work for you was still the execution of the paragraph only after end-of-file, not with each record), but in my experience it is not a method that is chosen for this type of task.
If you want to use the territory to get the value for the index to use for the ADD, use SET:
SET T2-INDEX TO rec-94-territory-code
Except you can't. rec-94-territory-code is an alpha-numeric (a PIC X field. This is good for anything not used in a calculation). It is unproblematic to define a new numeric field in your WORKING-STORAGE and first
MOVE rec-94-territory-code TO new-numeric-field
then
SET T2-INDEX TO new-numeric-field
For the loop, I think you can already get there.
However, before you do any adding either way, it would be a good idea if your per-territory counts started off at zero. Yours state off at space. Even if that "works", it is not good practice.
So you need to start those from zero - a loop is good for now.
In the light of your code changes, your next problem is how you've attempted to set initial values to your table of counts.
For now, add a paragraph after your OPEN paragraph and PERFORM that new paragraph. In that paragraph, make a loop to set the values in your table to zero, starting from the first and ending with the ninth.
I want to acheive the below
a string of pic X(5) contains A1992 and is incremented to A9999 , after it reaches A9999 , the A should be replaced by B and the other characters should be reinitialized to 0000 ie B0000 , this should happen until Z9999 , is it possible somehow ?
or if you could show me how to increment A till Z that would be suffice
You will need to do some manual character manipulation on this one. There are several parts, first, you need to handle the simple addition of the numeric portion, then you need to handle the rollover of that to increment the alpha portion.
Data structures similar to this might be helpful:
01 Some-Work-Area.
02 Odometer-Char-Vals pic x(27) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
02 Odometer-Char occurs 27 pic x.
02 Odo-Char-Ndx pic s9(8) binary.
01 My-Odometer.
88 End-Odometer-Value value 'Z9999'.
02 My-Odometer-X pic X.
02 My-Odometer-9 pic 9999.
88 Carry-Is-True value 9999.
This would be used with a simple perform loop like so:
Move 0 to My-Odometer-9
Move 1 to Odo-Char-Ndx
Move Odometer-Char-Vals (Odo-Char-Ndx) to My-Odometer-X
Perform until End-Odometer-Value
Add 1 to My-Odometer-9
Display My-Odometer
If Carry-Is-True
Move 0 to My-Odometer-9
Add 1 to Odo-Char-Ndx
Move Odometer-Char-Vals (Odo-Char-Ndx) to My-Odometer-X
End-If
End-Perform
That is one way you could do it.
Please note, the code above took some shortcuts (aka skanky hacks) -- like putting a pad cell in the Odometer-Char array so I don't have to range check it. You wouldn't want to use this for anything but examples and ideas.
I'd probably do this with a nested perform loop.
Storage:
01 ws-counter-def
03 ws-counter-def-alpha-list pic x(27) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
03 ws-counter-def-num pic 9(4) comp-3.
01 ws-counter redefines ws-counter-def
03 ws-counter-alpha occurs 27 times indexed by counter-idx pic x.
03 ws-counter-num pic 9(4) comp-3.
01 ws-variable
03 ws-variable-alpha pic X
03 ws-variable-num pic X(4).
Procedure:
Initialize counter-idx.
Move 1992 to ws-counter-num.
Perform varying counter-idx from 1 by 1 until counter-idx > 26
move ws-counter-alpha(counter-idx) to ws-variable-alpha
perform until ws-counter-num = 9999
add 1 to ws-counter-
move ws-counter-num to ws-variable-num.
*do whatever it is you need to do to the pic X(5) value in ws-variable*
end-perform
move zeros to ws-counter-num
end-perform.
Just can't help myself... How about this...
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01.
02 ALL-LETTERS PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
02 LETTERS REDEFINES ALL-LETTERS.
03 LETTER PIC X OCCURS 26 INDEXED BY I.
01 START-NUMBER PIC 9(4).
01 COUNTER.
02 COUNTER-LETTER PIC X.
02 COUNTER-NUMBER PIC 9(4).
PROCEDURE DIVISION.
MOVE 1992 TO START-NUMBER
PERFORM VARYING I FROM 1 BY 1 UNTIL I > LENGTH OF ALL-LETTERS
MOVE LETTER (I) TO COUNTER-LETTER
PERFORM TEST AFTER VARYING COUNTER-NUMBER FROM START-NUMBER BY 1
UNTIL COUNTER-NUMBER = 9999
DISPLAY COUNTER - or whatever else you need to do with the counter...
END-PERFORM
MOVE ZERO TO START-NUMBER
END-PERFORM
GOBACK
.
This will print all the "numbers" beginning with A1992 through to Z9999.
Basically stole Marcus_33's code and twiked it a tiny bit more. If you feel so inclined please upvote his answer, not mine
For lovers of obfuscated COBOL, here's the shortest (portable) version I can think of (assuming a compiler with Intrinsic Functions):
IDENTIFICATION DIVISION.
PROGRAM-ID. so.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ws-counter value "A00".
03 ws-alpha pic x.
03 ws-number pic 99.
PROCEDURE DIVISION.
1.
Perform with test after until ws-counter > "Z99"
Display ws-counter, " " with no advancing
Add 1 To ws-number
On size error
Move zero to ws-number
perform with test after until ws-alpha is alphabetic-upper or > "Z"
Move Function Char (Function Ord( ws-alpha ) + 1) to ws-alpha
end-perform
End-add
End-perform.
END PROGRAM so.
Tested on OpenVMS/COBOL. I shorten the value to X(3) since it's boring to watch run. A non-portable version (if you are aware of the Endianness of your platform) is to redefined the prefix as a S9(4) COMP and increment the low-order bits directly. But that solution wouldn't be any shorter...