I would like to ask, how to move number in Text, e.g: 01 A PIC X(6) value "200030", to a number such as 01 B PIC 9(6) and I only want to extract the first 4 number of A. In Cobol this type of move using MOVE is forbidden, the move I used is MOVE A(1:4) to B.
It is not forbidden
you just need to
03 Field-x4 X(4).
03 Field-94 9(4).
Move Field-X4 to Field-94
COBOL provides a few ways to accomplish this sort of assignment. Start with
the declarations outlined in your question:
01 A PIC X(6) VALUE "200030".
01 B PIC 9(6).
Declare another data item along the lines of:
01 AAAABB.
05 AAAA PIC 9(4).
05 BB PIC 9(2).
The AAAABB declares a record structure (compound data item) containing two elementary
data items: AAAA and BB, both of which are numeric. Now you can do either of the
following:
MOVE A(1:4) TO B ; DISPLAY B
MOVE A TO AAAABB ; DISPLAY AAAA
DISPLAY BB
The displayed output will be:
002000
2000
30
Since AAAABB is a compound item it has a PIC X implicit data type. This in turn
allows you to assign virtually any data value and then decompose it by referring
to its individual components.
Beware, an assignment such as:
MOVE A TO AAAA; DISPLAY AAAA
This will generally compile (with warnings about truncation) and produce the following
result:
0030
The most significant digits have been truncated (probably not what you wanted).
COBOL is reasonably flexible with respect to data manipulation. One
thing you should be watching out for (guarding against) is assginment of non-numeric
values to numeric data items as in:
MOVE "20++30" TO A
MOVE A TO AAAABB
This will "work" just fine until you try to do something like:
ADD +1 TO AAAA
If you are lucky it will blow up at this point (depending on your compiler and
the actual non-numerics). To guard against this type of error you should always
include logic along the lines of:
MOVE A TO AAAABB
IF (AAAA NOT NUMERIC) OR (BB NOT NUMERIC)
PERFORM BAD-DATA-ASSIGNMENT
END-IF
ADD 1 TO AAAA
You can do unions in COBOL with redefines. This is from memory but I think it should work:
01 YEARMONTH.
03 YM-FULL PIC 9(6).
03 FILLER REDEFINES YM-FULL.
05 YM-YEAR PIC 9(4).
05 YM-MONTH PIC 9(2).
01 JUST-YEAR PIC 9(4).
MOVE 200030 TO YM-FULL.
MOVE YM-YEAR TO JUST-YEAR.
Related
I have a 7-digit packed-decimal field on my file. How can I define data items that would extract/separate these 7 digits?
For example I want to have the first two digits in one data item and the other digits in another, so I can manipulate them later.
In some other languages one of the things which may be common would be to "divide by a multiple of 10", an appropriate multiple, of course.
However, don't ever consider that with COBOL. A "divide" is "expensive".
05 input-packed-decimal
PACKED-DECIMAL PIC 9(7).
Then:
05 FILLER
REDEFINES input-packed-decimal.
10 ipd-split-two-and-five
PACKED-DECIMAL PIC 99V9(5).
01 two-digits PIC 99.
01 five-digits PIC 9(5).
01 FILLER
REDEFINES five-digits.
05 five-digits-as-decimals PIC V9(5).
MOVE ipd-split-two-and-five TO two-digits
five-digits-as-decimals
Then you are able to use two-digits and five-digits for whatever you want.
Another way:
01 ws-input-seven PIC 9(7).
01 FILLER
REDEFINES ws-input-seven.
05 two-digits PIC 99.
05 five-digits PIC 9(5).
MOVE input-packed-decimal TO ws-input-seven
The first way will also work for signed source fields (just put an S in the appropriate place in each PICture clause).
The second will not work with signed fields, because the source sign will no propagate to the two-digits field because the MOVE is not even aware that there is such a field.
Take care when REDEFINESing PACKED-DECIMAL or BINARY fields (on an IBM Mainframe, these can also have USAGE COMP-3 and COMP/COMP-4/COMP-5). Always, when defining with the same, or similar, USAGE, define the same number of digits. For a REDEFINES field the compiler will always assume that you know what you are doing, so it will not do any "truncation of source" for you. So you have to ensure that you are not, explicitly or implicitly, expecting truncation of source when you use fields subordinate to a REDEFINES.
To get the second digit, don't ever do this:
05 FILLER
REDEFINES input-packed-decimal.
10 ignore-one-use-2nd-next-five
PACKED-DECIMAL PIC 9V9(5).
To get the second digit, use PACKED-DECIMAL PIC 99V9(5) as before, but define the receiving field with only one digit position. The compiler will happily then generate code to do the truncation you expect.
If you are "unable to use REDEFINES" you'll have to create a new field in the WORKING-STORAGE with the same characteristics as your input field, and use that.
The data-names I've used here are solely for this general explanation. Use good, descriptive, names to your task. If the first two digits are part-type, and the last five are part-number, make sure that is clear fro your naming.
Don't name them "Var(n)" or similar and don't give them names which are misleading.
01 the-array.
03 filler pic x(02) value '00'.
03 filler pic x(02) value '01'.
03 filler pic x(02) value '02'.
and so on, until
03 filler pic x(02) value 'FF'.
01 two-array redefines the-array.
03 harry occurs 256 pic x(02).
91 sub1.
03 filler pic x(01) value low-values.
93 sub1-byte2 pic x(01).
01 sub2 redefines sub1 comp.
01 pd pic x(04).
01 pub pic 9(04).
01 eggs.
03 eggs1 pic x(01).
03 eggs2 pic x(01).
perform varying pub
from 1 by 1
until pub > 4
move pd(pub:1) to sub1-byte2
move harry(sub2 + 1) to eggs
display eggs1 egg2
end-perform.
So an array of 256 2 byte fields with values of '00' thru 'FF'.
step thru the 4 byte field that holds your packed decimal field.
use each byte as a subscript into the array (add 1 to ensure '00' points to first field in array).
2 byte field pointed to has the values of the 2 nibbles that represent that byte from the packed decimal field.
the right hand nibble of the fourth byte in the packed decimal field is for the sign.
I am writing a program that changes the colour of a field if is it a duplicate record. To do this I am using a nested perform to compare each item to each other. When it finds a duplicate I would like to MOVE DFHRED to that specific field for example CRS1AC. My issue is that I don't know how to reference the field I am trying to change the colour of once I've found that is it a duplicate, how do I do this? Here are the fields which are in the MAP file that I am trying to move the colour to if a duplicate exists...
01 CRS1AC PIC X.
01 CRS1BC PIC X.
01 CRS2AC PIC X.
01 CRS2BC PIC X.
01 CRS3AC PIC X.
01 CRS3BC PIC X.
01 CRS4AC PIC X.
01 CRS4BC PIC X.
01 CRS5AC PIC X.
01 CRS5BC PIC X.
here is my table setup...
01 TABLES.
05 TBL-CRS-ENTRIES PIC S9(3) COMP-3 VALUE 5.
05 TBL-CRS-VALUES PIC X(4) OCCURS 10 TIMES.
05 CRS-TBL REDEFINES TBL-CRS-VALUES
PIC X(8) OCCURS 5 TIMES.
05 SUB-1 PIC S9(3) COMP-3 VALUE 1.
05 SUB-2 PIC S9(3) COMP-3 VALUE 1.
& here is the code that checks for duplicates
PERFORM VARYING SUB-1 FROM 1 BY 1 UNTIL SUB-1 > TBL-CRS-ENTRIES
PERFORM VARYING SUB-2 FROM 1 BY 1 UNTIL SUB-2 > SUB-1 - 1
IF CRS-TBL(SUB-1) = CRS-TBL(SUB-2)
*if there is a match it should change the colour to red.
* for example a match at CRS1AC & CRS1BC match CRS3AC & CRS3BC
*this is my attempt at trying make the variable name.
MOVE DFHRED TO CRS(SUB-1)AC
MOVE DFHRED TO CRS(SUB-1)BC
MOVE DFHRED TO CRS(SUB-2)AC
MOVE DFHRED TO CRS(SUB-2)BC
PERFORM 999-DUPLICATE-RECORD
END-IF
END-PERFORM
END-PERFORM.
GOBACK.
So, if 'PSYC 1000' = 'PSYC 1000' & the name of those fields are..
'CRS1AC+CRS1BC = CRS3AC+CRS3BC' <--- these are the fields I want to change the color of.
I've researched this heavily & still cannot find a solution.
Hope this makes sense I know its all over the place, for further clarification please ask & if complete program code is required I can provide it.
No, it is not possible to do what you want how you want.
COBOL is a compiled language. What is relevant about that is that you cannot make up the names of identifiers (variables) at run-time. Once a COBOL program is compiled, that is it, no more changes to the source for that executable version.
Where to go then?
You say this is part of your MAP.
01 CRS1AC PIC X.
01 CRS1BC PIC X.
01 CRS2AC PIC X.
01 CRS2BC PIC X.
01 CRS3AC PIC X.
01 CRS3BC PIC X.
01 CRS4AC PIC X.
01 CRS4BC PIC X.
01 CRS5AC PIC X.
01 CRS5BC PIC X.
But, because of those level-numbers of 01 those aren't part of anything, except the SECTION they belong to within the DATA DIVISION.
So you need to show your full, actual, MAP.
There is not an especially cute way, so what you have to do is REDEFINES the entire MAP, with an OCCURS which represents each screen-line for this portion of the screen (or entire screen, depends on the design) and define those attribute bytes within the OCCURS item.
What is really exciting about this is getting it all to line-up, by hand.
Now your program.
Your loops are wrong. You execute the inner-loop five times for each iteration of the outer-loop. Which means you are doing far more comparisons than necessary.
This is unwieldy:
SUB-2 > SUB-1 - 1
For that line of code, this would be better:
SUB-2 EQUAL TO SUB-1
The fifth outer-iteration is not required at all, because there are no values to compare to other than those which have already been compared (so the result will be the same, so why bother?).
Consider changing the definition of the identifiers (variables) you are using as subscripts and your total of entries to BINARY or COMP or COMP-4 (they all mean the same thing).
Consider giving them more meaningful names than SUB-1, SUB-2. It will make the code "read" better, which always helps.
Here's your data-defintion:
01 TABLES.
05 TBL-CRS-ENTRIES PIC S9(3) COMP-3 VALUE 5.
05 TBL-CRS-VALUES PIC X(4) OCCURS 10 TIMES.
05 CRS-TBL REDEFINES TBL-CRS-VALUES
PIC X(8) OCCURS 5 TIMES.
05 SUB-1 PIC S9(3) COMP-3 VALUE 1.
05 SUB-2 PIC S9(3) COMP-3 VALUE 1.
Some other things to make things easier for yourself:
Don't code identifiers (variables) after an OCCURS. It doesn't greatly matter in itself when there is no DEPENDING ON on the OCCURS, but since it does matter for that, why not be consistent (consistency is great, because when you are looking for a problem and you find inconsistency, it tells something about the writer of that particular bit of code).
Don't REDEFINES items which are defined with OCCURS. Even if you are using an old compiler (either you've put incorrect code here, or you are doing that) that gives you at least a Caution message. Try an experiment. Show that definition to a colleague, and ask them "what does this actually do?" Then show to another. And a third. If they all immediately reply, accurately, what it does, then you have a site with outstanding knowledge. You haven't, so don't do that.
Don't make identifiers signed, unless they can contain negative values. Then the reader can look at the definition and know it can't contain a negative value. Don't fall for "oh, we do it for performance". Name the compiler and show the compile options, and I'll show you what it is "gaining", or losing.
Don't use VALUE clauses for initial values of identifiers used as subscripts. Set them to their initial value before you use them. Unless you have tortuous code setting the value at the end of the current processing so it is ready for the next processing, all you are doing is confusing the human-reader. If there is a VALUE clause, it should be necessary.
Do give everything a good, descriptive, name, if it is being used. If something does not need a name, use FILLER to define it (often).
Your definition could be done like this:
01 some-meaningful-name
05 TBL-CRS-ENTRIES BINARY PIC 9(4) VALUE 5.
05 also-meaningful BINARY PIC 9(4).
05 meaningful-also BINARY PIC 9(4).
05 another-meaningful-name.
10 FILLER OCCURS 10 TIMES.
15 TBL-CRS-VALUES PIC X(4).
05 FILLER REDEFINES another-meaningful-name.
10 FILLER OCCURS 5 TIMES.
15 CRS-TBL PIC X(8).
Source code is for two things: for the compiler to convert into executable code; for the human reader to understand what has been coded. The compiler does not care about formatting the code. So format the code for the human reader. Even little things help:
IF CRS-TBL(SUB-1) = CRS-TBL(SUB-2)
Vs
IF CRS-TBL ( W-ORIGINAL-ITEM )
EQUAL TO CRS-TBL ( W-NEW-ITEM )
I need to make a table out of the data structure below because I am not certain how many records that are each one line long will be in my input file. If I can make a table then I will be able to loop through them at a later time which is what I need to be able to do.
**Question: How to make a table out of the data structure before?
Part B: An array in Cobol is an OCCURS 100 TIMES
01 PRECORD.
05 JE.
10 NE PIC X(6) VALUE SPACES.
10 NM PIC X(2) VALUE SPACES.
05 FILL1 PIC X(16) VALUE SPACES.
05 TM PIC X(7) VALUE SPACES.
05 FILL2 PIC X(6) VALUE SPACES.
05 TT PIC X(7) VALUE SPACES.
05 FILL3 PIC X(13) VALUE SPACES.
05 TTY PIC X(10) VALUE SPACES.
05 FILL4 PIC X(13) VALUE SPACES.
01 PRECORD.
02 table-counter <-- this is used to hold the number of records
02 tTable occurs 300 times. <-- creates a table with three hundred occurences
05 JE.
10 NE PIC X(6) VALUE SPACES.
10 NM PIC X(2) VALUE SPACES.
05 FILL1 PIC X(16) VALUE SPACES.
05 TM PIC X(7) VALUE SPACES.
05 FILL2 PIC X(6) VALUE SPACES.
05 TT PIC X(7) VALUE SPACES.
05 FILL3 PIC X(13) VALUE SPACES.
05 TTY PIC X(10) VALUE SPACES.
05 FILL4 PIC X(13) VALUE SPACES.
The code above is update with how I think that table should look. The table has to have a counter at the top and then under than it will have to have a occur and how many times the table should occur.
The question that I was asking was how do you make a table like above actually a table I did not know that you had to create an Occurs and then put everything below that level of the occurs.
01 mytable.
02 counter...
02 tablevar occures 200 times.
05 var...
05 var2..
I just was not sure of the structure of a Cobol table. My question is what was the format of a Cobol data structure?
Your table-counter will need a PICture.
What PICture? Opinions vary.
There are three numeric formats which are useful for this, binary, packed-decimal, and display-numeric.
nn table-counter COMP/COMP-4/BINARY/COMP-5 PIC 9(4).
nn table-counter COMP-3/PACKED-DECIMAL PIC 9(3).
nn table-counter PIC 9(3).
The most efficient definition will be a binary one. If you use packed-decimal, the compiler will generate code to convert it to binary when used in comparison with anything you use for subscripting (except literals). When using display-numeric, the compiler will generate code to first convert to packed-decimal, then to binary.
Do these things matter with the speed of machines these days? Well, if they don't matter, may as well be efficient, but opinions do vary.
What size for the PICture? 9(4) for binary allows up to 9999 as a maximum value. You can code 999, but it does not give you much advantage (can't limit it to 300), so I go for optimal for the size (for a packed-decimal (COMP-3) it would be 999, as you don't get a fourth digit for nothing). Same if using display-numeric. Again, opinions vary.
If those are records, as Magoo has pointed out, you can't just add the count to the beginning of the record. You can't keep your table in the FILE SECTION under and FD. It will need to go into the WORKING-STORAGE SECTION.
Then there is the problem of keeping two structures "in step" for where they should match each other.
You probably have a copybook for the record-layout. The best is if you can parameterise the names in the copybook, so that you can use REPLACING on the COPY statement, allowing you to use the same copybook for the two different purposes. It would then be important that the copybook does not contain an 01-level. Again opinions vary on the inclusion of 01s in copybooks, but you may get lucky.
Which, given all the opinion, gets us to "well, what do I do?". What you do is the way they do it at your site. There should be documentation of local standards. This may not cover everything, you may have to seek the opinions of colleagues. If you all code in about the same way, it makes the code easier to understand.
Personally, I'd declare table-counter as a 77-level with a PIC 9(03). And you really should remove the VALUE clauses. Of course, this would need to be a WORKING-STORAGE entry, not an FD since the table isn't on the file. Other than that, what you've dome appears valid - but it's difficult to see what question you are asking.
I'm editing some source code for my college Transaction Processing course. We're working with COBOL/CICS, and the program is a video tape rental system. We have a list of changes to make, and one item has me stuck (it's been since Fall semester of 2010 since I took the COBOL course, so unfortunately I'm far more rusty than I should be). There is a "customer maintenance" section, in which the user can add new customers. One of the items for a new customer is the zip code, and as it stands it will take any input as valid input, but we need to make it accept only numeric values (which I do know how to do) as well as a specific format: Either '12345', '123456789', or '12345-6789', and should only write to the record as '12345' or '12345-6789'. Anything else, such as '1234' or 12345-6' will result in an error. How do I check these fields for the proper format?
Since the valid data format is fixed, it is easy.
05 nice-name-for-zip-code pic x(10).
05 filler redefines nice-name-for-zip-code.
10 simple-zip-first-part pic x(5).
10 simple-zip-last-part pic x(5).
88 simple-zip-last-part-valid value space.
05 filler redefines nice-name-for-zip-code.
10 complex-zip-first-part pic x(5).
10 complex-zip-separator pic x.
88 complex-zip-separator value "-".
10 complex-zip-last-part pic x(4).
05 filler redefines nice-name-for-zip-code.
10 long-zip-first-part pic x(9).
10 long-zip-last-part pic x.
88 long-zip-last-part-valid value space.
if ( simple-zip-first-part numeric )
and ( simple-zip-last-part-valid )
....
if ( complex-zip-first-part numeric )
and ( complex-zip-separator-valid )
and ( complex-zip-last-part numeric )
....
if ( long-zip-first-part numeric )
and ( long-zip-last-part-valid )
....
If any of the IFs is true, you have a valid format. Otherwise, invalid.
A different approach might be to let CICS BMS support do most of the
validation and editing for you. This assumes you are using a 3270 type
terminal with CICS (which is probably the case)
Try setting the Zip Code up as a group field on the BMS map. This has the effect
of creating a single input field with multiple parts to it.
Your BMS Map definition would look something like:
ZIP1 DFHMDF POS=(2,1),LENGTH=5,GRPNAME=ZIP,ATTRB=(UNPROT,NUM)
SEP DFHMDF POS=(2,6),LENGTH=1,GRPNAME=ZIP,ATTRB=(ASKIP,NORM),INITIAL='-'
ZIP2 DFHMDF POS=(2,7),LENGTH=5,GRPNAME=ZIP,ATTRB=(UNPROT,NUM),JUSTIFY=(LEFT,BLANK)
The Zip code will appear at the beginning of line 2 (POS=(2..)). It will have a 5 digit input
field (ZIP1) for the first part of the Zip Code, followed by a hard coded input protected
dash (SEP) and another left justified 5
digit blank filled input field (ZIP2) for the last part of the Zip code.
From this point on, BMS will force the user to enter 5 digits into the first part of the Zip Code,
cannot touch the dash and optionally enter zero to 5 digits in the second part of
the input field. None of these fields will accept non-numeric data (except the SEP, which is input protected)
When you retrieve the data from the screen all you need to do is check to see
if ZIP2 is numeric to figure out if a long or short Zip code was entered. If
a long Zip, then store the whole thing, if short, only store ZIP1.
You could also use the CICS command BIF DEEDIT, which will remove non-numeric chars, the minus passes that test. After that, test for a length of 5 or 10.
Or, you could use an 88 like this:
01 Zip-Validation-Field.
02 filler pic x(5).
88 Zip-Valid value '00000' thru '99999'.
02 filler pic x(5).
88 Zip-plus-4-valid value '-0000' thru '-9999'.
And test with:
If Zip-Valid and Zip-plus-4-valid...
You can use MOVE CORR
01 TX-ZIPCODE PIC X(08) VALUE ' - '.
01 TX-ZIPCODE-R REDEFINES TX-ZIPCODE.
03 ZIPCODE-P1 PIC 9(04).
03 FILLER PIC X(01).
03 ZIPCODE-P2 PIC 9(03).
01 NUM-ZIPCODE PIC X(07).
01 NUM-ZIPCODE-R REDEFINES NUM-ZIPCODE.
03 ZIPCODE-P1 PIC 9(04).
03 ZIPCODE-P2 PIC 9(03).
MOVE CORR TX-ZIPCODE-R TO NUM-ZIPCODE-R.
IF NUM-ZIPCODE IS NOT NUMERIC
* ERRO
END-IF.
Hope I have help you! :)
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...