I will read a sequential file which include some string such as "79.85", "1000", "212.34".
I want to convert the alphanumeric into number in this format 00000.00 ?
I will need to add up these numbers and move it to a field in the format 0000000.00 .
I tried:
01 WS_AMOUNT_TXT PIC X(8).
01 WS_AMOUNT PIC 9(5).9(2).
MOVE WS_AMOUNT_TXT(1:8) TO WS_AMOUNT(1:8).
What I got is unexpected, the string is just as same. It is left align and no leading zero display.
How can I made it right align and have leading zero?
EDIT: I tried the suggestion by NealB, and it sadly failed:
01 WS_AMOUNT_NUM PIC 9(5)V9(2).
01 WS_AMOUNT_DISPLAY PIC 9(5).9(2).
01 WS_AMOUNT_TXT PIC X(8).
DISPLAY WS_AMOUNT_TXT
COMPUTE WS_AMOUNT_NUM = FUNCTION NUMVAL (WS_AMOUNT_TXT)
MOVE WS_AMOUNT_NUM TO WS_AMOUNT_DISPLAY
79.85 << this is what was displayed when I called DISPLAY WS_AMOUNT_TXT
AND THEN IT CRASHED.
%COB-F-NUMVALARGINV, NUMVAL or NUMVAL-C argument invalid
%TRACE-F-TRACEBACK, symbolic stack dump follows
image module routine line rel PC abs PC
DEC$COBRTL 0 000000000001F2B8 000000007C2F72B8
DEC$COBRTL 0 0000000000014764 000000007C2EC764
DEC$COBRTL 0 0000000000014C44 000000007C2ECC44
DAILY_SPLIT_REFUND_ADJ DAILY_SPLIT_REFUND_ADJ DAILY_SPLIT_REFUND_ADJ
121 00000000000003C4 00000000000303C4
DAILY_SPLIT_REFUND_ADJ 0 00000000000313A0 00000000000313A0
0 FFFFFFFF80271EF4 FFFFFFFF80271EF4
Try using the intrinsic function NUMVAL
to do the conversion. Something like...
01 WS-AMOUNT-TEXT PIC X(8).
01 WS-AMOUNT-NUM PIC 9(5)V9(2).
01 WS-AMOUNT-DISPLAY PIC 9(5).9(2).
COMPUTE WS-AMOUNT-NUM = FUNCTION NUMVAL (WS-AMOUNT-TEXT)
MOVE WS-AMOUNT-NUM TO WS-AMOUNT-DISPLAY
NUMVAL converts the text representation of a number into a numeric type. Use the numeric data type: PIC 9(5)V9(2) in your calculations. Then use MOVE
to convert the numeric result into a displayable amount with explicit decimal point.
Note: If you have a lot of calculations to perform, it might be best to use a PACKED-DECIMAL data type to improve efficiency.
Use redefine.
01 WS-AMOUNT-TXT-GRP.
03 WS-AMOUNT PIC X(4).
01 WS-AMOUNT-NUM REDEFINES WS-AMOUNT-TXT-GRP PIC 9(4).
After re=licating value in WS-AMOUNT-TXT-GRP or in WS-AMOUNT, automatically value will replicate in WS-AMOUNT-NUM
Related
I have Alphanumeric value = '86' and its length is defined as PIC x(02). I need to convert it into hex x'86' and its length is defined as PIC 9(01) comp-3.
example:
01 WS-ALPHANUMERIC PIC X(02) VALUE '86'.
01 WS-HEX PIC 9(01) COMP-3.
PROCEDURE DIVISION.
MOVE WS-ALPHANUMERIC TO WS-HEX.
DISPLAY WS-HEX.
STOP RUN
I am getting x'FF' in my spool. But I am expecting x'86'.
Why your code doesn't produce the output you're expecting
It is just guessing from my part for on my computer it doesn't work that way.
When you MOVE from WS-ALPHANUMERIC to WS-HEX, the string '86' in transformed in the decimal number 86.
However WS-HEX is only one byte long and in the COMP-3 format. This format can only store one decimal digit and the sign.
I'm guessing that on your environment when you move a bigger number than the capacity to a COMP-3 it take the biggest hexadecimal value it can hold : 0xF.
In my environment it would just take the digit 6 of the number 86.
So when you display, it is converted to a usage display so you have your firt 0xF for the usage formatting and then your 0xF for the "overflow" I guess.
On my computer you would just get a 0xF6.
A solution to produce the expected output
Disclaimer : I originally thought that your input would only be decimals, like '87596', '12' or '88'. This solution does not work for hexadecimals input like 'F1' ou '99F'. I built more complete solutions below in items 3 and 4 by improving this one
The solution I propose can take up to 16 digits in the input string if your system is 64bit because it takes 4 bits to store a hexadecimal digit.
Therefore if you want a larger input you'll have to use more than one result variable.
If you want to have it in only one byte, you just have to make Result a PIC 9(1) instead of PIC 9(18)
IDENTIFICATION DIVISION.
PROGRAM-ID. CNVRSN.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 RawInput PIC X(02) VALUE '86'.
01 FormattedInput PIC 9(16).
01 FractionedInput REDEFINES FormattedInput
05 Digit PIC 9 OCCURS 16.
01 Shifting PIC 9(18) COMP-5 VALUE 1.
01 I PIC 99 COMP-5.
01 Result PIC 9(18) COMP-5 VALUE 0.
01 DisplayResult REDEFINES Result PIC X(8).
PROCEDURE DIVISION.
MOVE RawInput TO FormattedInput.
PERFORM VARYING I FROM LENGTH OF FractionedInput
BY -1 UNTIL I < 1
COMPUTE Result = Result + Digit(I)*Shifting
MULTIPLY 16 BY Shifting
END-PERFORM
DISPLAY 'DisplayResult : ' DisplayResult
.
END PROGRAM CNVRSN.
The code works by transforming the string in a number of USAGE DISPLAY with the first move MOVE RawInput to FormattedInput.
We use the fact that each digit has the same format as a number of just one digit (PIC 9). This allows us to split the number in elements of an array with the REDEFINES of FomattedInput inFractionedInput
As you can see I traverse the array from the end to start because the least significant byte is at the end of the array (highest address in memory), not at the start (lowest address in memory).
Then we place each the hexadecimal digit in the correct place by shifting them to the left by 2^4 (a nibble, which is the size of a hexadecimal digit) as many times as required.
A solution that accepts the full hexadecimal input range (memory intensive)
Here is the code :
IDENTIFICATION DIVISION.
PROGRAM-ID. CNVRSN.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 RawInput PIC X(02) VALUE '86'.
01 FormattedInput PIC X(16).
01 FractionedInput REDEFINES FormattedInput
05 Digit PIC X OCCURS 16.
01 I PIC 99 COMP-5.
01 ConversionTableInitializer.
05 FILLER PIC X(192).
05 TenToFifteen PIC X(06) VALUE X'0A0B0C0D0E0F'.
05 FILLER PIC X(41).
05 ZeroToNine PIC X(10) VALUE X'00010203040506070809'.
01 ConversionTable Redefines ConversionTableInitializer.
05 DigitConverter PIC 99 COMP-5 OCCURS 249.
01 Result PIC 9(18) COMP-5 VALUE 0.
01 DisplayResult REDEFINES Result PIC X(8).
PROCEDURE DIVISION.
MOVE RawInput TO FormattedInput.
PERFORM VARYING I FROM 1 BY 1
UNTIL I > LENGTH OF FractionedInput
OR Digit(I) = SPACE
COMPUTE Result = Result*16 + DigitConverter(Digit(I))
END-PERFORM
DISPLAY 'DisplayResult : ' DisplayResult
.
END PROGRAM CNVRSN.
The idea in this solution is to convert each character (0,1...,E,F) to its value in hexadecimal. For this we use the value of their encoding as a string (0xC1 = 0d193 for A for instance) as the index of an array.
This is very wasteful of memory for we allocate 249 bytes to store only 16 nibbles of information. However to access the element of an array is a very fast operation: We are trading the memory usage for cpu efficiency.
The underlying idea in this solution is a hashtable. This solution is nothing but a very primitive hash table where the hash function is the identity function (A very, very bad hash function).
Another solution that accepts the full hexadecimal input range (CPU intensive)
Disclaimer : This solution was proposed by #Jim Castro in the comments.
IDENTIFICATION DIVISION.
PROGRAM-ID. CNVRSN.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 RawInput PIC X(02) VALUE '86'.
01 FormattedInput PIC X(16).
01 FractionedInput REDEFINES FormattedInput
05 Digit PIC 9 OCCURS 16.
01 ConversionString PIC X(16) VALUE '0123456789ABCDEF'.
01 ConversionTable REDEFINES ConversionString.
05 ConversionEntry OCCURS 16 INDEXED BY Idx.
10 HexDigit PIC X.
01 I PIC 99 COMP-5.
01 Result PIC 9(18) COMP-5 VALUE 0.
01 DisplayResult REDEFINES Result PIC X(8).
PROCEDURE DIVISION.
MOVE RawInput TO FormattedInput.
PERFORM VARYING I FROM 1 BY 1
UNTIL I > LENGTH OF FractionedInput
OR Digit(I) = SPACE
SET Idx To 1
SEARCH ConversionEntry
WHEN HexDigit(Idx) = Digit(I)
COMPUTE Result = Result*16 + Idx - 1
END-SEARCH
END-PERFORM
DISPLAY 'DisplayResult : ' DisplayResult
.
END PROGRAM CNVRSN.
Here the idea is still to convert the string digit to its value. However instead of trading off memory efficiency for cpu efficiency we are doing the converse.
We have a ConversionTable where each character string is located at the index that convey the value they are supposed to convey + 1 (because in COBOL arrays are 0 based). We juste have to find the matching character and then the index of the matching character is equal to the value in hexadecimal.
Conclusion
There are several ways to do what you want. The fundamental idea is to :
Implement a way to convert a character to its hexadecimal value
Traverse all the characters of the input string and use their position to give them the correct weight.
Your solution will always be a trade off between memory efficiency and time efficiency. Sometimes you want to preserve your memory, sometimes you want the execution to be real fast. Sometimes you wand to find a middle ground.
To go in this direction we could improve the solution of the item 3 in terms of memory at the expense of the cpu. This would be a compromise between item 3 and 4.
To do it we could use a modulo operation to restrict the number of possibilities to store. Going this way would mean implementing a real hashtable.
I don't have access to an IBM mainframe to test this code.
When I run the code on an online GnuCOBOL v2.2 compiler, I'm stuck with ASCII instead of EBCDIC.
I've posted the code. Here's what you have to do.
Make sure the top byte comes out to 8 and the bottom byte comes out to 6. You're converting the EBCDIC values to intager values. Values A - F hex will have different EBCDIC values than values 0 - 9.
Make sure the multiply and add are correct
Here's the code. You'll have to fix it to work with EBCDIC.
IDENTIFICATION DIVISION.
PROGRAM-ID. CONVERSION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-ALPHANUMERIC PIC X(02) VALUE '86'.
01 WS-WORK-FIELDS.
05 WS-INPUT.
10 WS-ONE.
15 WS-TOP-BYTE PIC 99 COMP.
10 WS-TWO.
15 WS-BOTTOM-BYTE PIC 99 COMP.
05 WS-ACCUMULATOR PIC S9(4) COMP.
05 FILLER REDEFINES WS-ACCUMULATOR.
10 FILLER PIC X.
10 WS-HEX PIC X.
PROCEDURE DIVISION.
0000-BEGIN.
MOVE WS-ALPHANUMERIC TO WS-INPUT
DISPLAY WS-INPUT
COMPUTE WS-TOP-BYTE = WS-TOP-BYTE - 183
COMPUTE WS-BOTTOM-BYTE = WS-BOTTOM-BYTE - 183
IF WS-TOP-BYTE NOT LESS THAN 16
COMPUTE WS-TOP-BYTE = WS-TOP-BYTE - 57
END-IF
IF WS-BOTTOM-BYTE NOT LESS THAN 16
COMPUTE WS-BOTTOM-BYTE = WS-BOTTOM-BYTE - 57
END-IF
DISPLAY WS-TOP-BYTE
DISPLAY WS-BOTTOM-BYTE
MOVE WS-TOP-BYTE TO WS-ACCUMULATOR
MULTIPLY 16 BY WS-ACUMULATOR
ADD WS-BOTTOM-BYTE TO WS-ACCUMULATOR
DISPLAY WS-ACCUMULATOR
DISPLAY WS-HEX
GOBACK.
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.
This is a homework assignment that involves reading in an input file, doing some processing, and printing the processed data to an output file in a neat and readable format.
The first record prints to the output file perfectly. Every record after that, it seems like when the record was read-in from the input file, it was read in with an added space; shifting the position of all of my input data and making it useless. Every line it seems like another space is being added.
I suspect that
A.) Despite my best efforts I do not fully understand the READ verb
and/or B.) There may be a problem with my compiler.
Any help is appreciated.
IDENTIFICATION DIVISION.
PROGRAM-ID.
payroll.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT payroll-in-file ASSIGN TO 'input.txt'.
SELECT payroll-out-file ASSIGN TO 'output.txt'.
DATA DIVISION.
FILE SECTION.
FD payroll-in-file
LABEL RECORDS ARE STANDARD.
01 payroll-in-record.
05 i-unused-01 PIC X.
05 i-emp-num PIC X(5).
05 i-dpt-num PIC X(5).
05 1-unused-02 PIC X(6).
05 i-hrs-wkd PIC 9(4).
05 i-base-pay-rt PIC 9(2)v99.
05 i-mncpl-code PIC X(2).
FD payroll-out-file
LABEL RECORDS ARE STANDARD.
01 payroll-out-record.
05 o-emp-num PIC X(5).
05 FILLER PIC XX.
05 o-hrs-wkd PIC 9(5).
05 FILLER PIC XX.
05 o-base-pay-rt PIC 9(3).99.
05 FILLER PIC XX.
05 o-grs-pay PIC 9(5).99.
05 FILLER PIC XX.
05 o-fed-tax PIC 9(5).99.
05 FILLER PIC XX.
05 o-state-tax PIC 9(4).99.
05 FILLER PIC XX.
05 o-city-tax PIC 9(4).99.
05 FILLER PIC XX.
05 o-net-pay PIC 9(5).99.
WORKING-STORAGE SECTION.
01 w-out-of-data-flag PIC X.
01 w-grs-pay PIC 99999V99.
01 w-fed-tax PIC 99999V99.
01 w-state-tax PIC 9999V99.
01 w-city-tax PIC 9999V99.
PROCEDURE DIVISION.
A000-main-line-routine.
OPEN INPUT payroll-in-file
OUTPUT payroll-out-file.
MOVE 'N' TO w-out-of-data-flag.
READ payroll-in-file
AT END MOVE 'Y' TO w-out-of-data-flag.
PERFORM B010-process-payroll
UNTIL w-out-of-data-flag = 'Y'.
CLOSE payroll-in-file
payroll-out-file.
STOP RUN.
B010-process-payroll.
MOVE SPACES TO payroll-out-record.
IF i-hrs-wkd IS NOT GREATER THAN 37.5
MULTIPLY i-hrs-wkd BY i-base-pay-rt GIVING w-grs-pay ROUNDED
ELSE
COMPUTE w-grs-pay ROUNDED =
(i-base-pay-rt * 37.5) + (1.5 * (i-base-pay-rt) * (i-hrs-wkd - 37.5))
END-IF.
MULTIPLY w-grs-pay BY 0.25
GIVING w-fed-tax ROUNDED.
MULTIPLY w-grs-pay BY 0.05
GIVING w-state-tax ROUNDED.
IF i-mncpl-code = 03
MULTIPLY w-grs-pay BY 0.015 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 07
MULTIPLY w-grs-pay BY 0.02 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 15
MULTIPLY w-grs-pay BY 0.0525 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 23
MULTIPLY w-grs-pay BY 0.0375 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 77
MULTIPLY w-grs-pay BY 0.025 GIVING w-city-tax ROUNDED
END-IF.
input file:
AA34511ASD 0037115003
AA45611WER 0055120007
BB98722TYU 0025075015
BB15933HUJ 0080200023
FF35799CGB 0040145077
(each line begins with 1 space, which corresponds to "i-unused-01" in the code)
output file (so far):
AA345 00037 011.50 00425.50 00106.38 0021.28 0006.38 00291.46 AA45 0 005 051.20 00425.50 00106.38 0021.28 0006.38 00291.46
BB9 0 00 025.07 00425.50 00106.38 0021.28 0006.38 00291.465
BB 0 0 008.02 00425.50 00106.38 0021.28 0006.38 00291.4623
F 0 000.40 10673.10 02668.28 0533.66 0006.38 07464.78
^it prints just like that!
Using OpenCOBOL compiler in Linux.
I didn't look at the code in detail, but two things are worth looking at.
Firstly, the output file should probably be "line sequential", as this will insert a delimiter (carraige return/newline), which means that the output file will print as one record per line.
Also, there may be a difference of one character, between the number of characters in your input record, i.e. your actual data, and the the number of characters defined in your input FD.
As colemanj said, you need to change the output file to line sequential
But you also need to change the input file / input file definition.
The 2 options are
1) change the Input file to line sequential (bring the definition into line with the file
2) Remove carraige returns from the input file to (all on one line):
AA34511ASD 0037115003 AA45611WER 0055120007 BB98722TYU 0025075015 BB15933HUJ 0080200023 FF35799CGB 0040145077
The current input file definition indicates there is no carriage returns in the file.
--------------------------------------------------
This might be due to the Mingw Open COBOL version you use. As it is documented here
ORGANIZATION IS LINE SEQUENTIAL
These are files with the simplest of all internal structures. Their contents are structured simply as a series of data records, each terminated by a special end-of-record delimiter character. An ASCII line-feed character (hexadecimal 0A) is the end-of-record delimiter character used by any UNIX or pseudo-UNIX (MinGW, Cygwin, MacOS) OpenCOBOL build. A truly native Windows build would use a carriage-return, line-feed (hexadecimal 0D0A) sequence.
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...
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.