Problem with COBOL move to comp-3 variable - cobol

I'm having the following problem in a COBOL program running on OpenVMS.
I have the following variable declaration:
01 STRUCT-1.
02 FIELD-A PIC S9(6) COMP-3.
02 FIELD-B PIC S9(8) COMP-3.
01 STRUCT-2.
03 SUB-STRUCT-1.
05 FIELD-A PIC 9(2).
05 FIELD-B PIC 9(4).
03 SUB-STRUCT-2.
05 FIELD-A PIC 9(4).
05 FIELD-B PIC 9(2).
05 FIELD-C PIC 9(2).
And the following code:
* 1st Test:
MOVE 112011 TO FIELD-A OF STRUCT-1
MOVE 20100113 TO FIELD-B OF STRUCT-1
DISPLAY "FIELD-A : " FIELD-A OF STRUCT-1 CONVERSION
DISPLAY "FIELD-B : " FIELD-B OF STRUCT-1 CONVERSION
* 2nd Test:
MOVE 112011 TO SUB-STRUCT-1.
MOVE 20100113 TO SUB-STRUCT-2.
MOVE SUB-STRUCT-1 TO FIELD-A OF STRUCT-1
MOVE SUB-STRUCT-2 TO FIELD-B OF STRUCT-1
DISPLAY "SUB-STRUCT-1 : " SUB-STRUCT-1
DISPLAY "SUB-STRUCT-2 : " SUB-STRUCT-2
DISPLAY "FIELD-A : " FIELD-A OF STRUCT-1 CONVERSION
DISPLAY "FIELD-B : " FIELD-B OF STRUCT-1 CONVERSION
Which outputs:
FIELD-A : 112011
FIELD-B : 20100113
SUB-STRUCT-1 : 112011
SUB-STRUCT-2 : 20100113
FIELD-A : 131323
FIELD-B : 23031303
Why FIELD-A and FIELD-B hold values different from what I move into them in the second test?
I've other moves from DISPLAY to COMP-3 variables in my program where I don't get this behavior.

In COBOL, Group level data are typeless and are moved without casting.
Element level data always have an associated data type. Typed
data are cast to match the type
of the receiving element during a MOVE.
In the first instance you MOVE a literal numeric value (112011) to a packed decimal field and the compiler converts it to the correct data type in the process. Just as you would expect in any programming language.
In the second instance you MOVE a literal value to a group item. Since this is a group item the compiler cannot 'know' the intended data type so it always does group moves as character data (no numeric conversions). This is fine when the receiving item has a PICTURE clause that is compatible with character data - which FIELD-A and FIELD-B
of SUB-STRUCT-1 are. There is no difference in the internal representation of a 9 when stored as PIC X and when stored as PIC 9. Both are assumed USAGE DISPLAY.
Now when you do a group level move from SUB-STRUCT-1 to a COMP-3 (Packed Decimal) you effectively tell the compiler not to convert from DISPLAY to COMP-3 format. And that is what you get.
Try the following modifications to your code. Using REDEFINES creates
a numeric elementary item for the move. COBOL will do the appropriate
data conversions when moving elementary data.
01 STRUCT-2.
03 SUB-STRUCT-1.
05 FIELD-A PIC 9(2).
05 FIELD-B PIC 9(4).
03 SUB-STRUCT-1N REDEFINES
SUB-STRUCT-1 PIC 9(6).
03 SUB-STRUCT-2.
05 FIELD-A PIC 9(4).
05 FIELD-B PIC 9(2).
05 FIELD-C PIC 9(2).
03 SUB-STRUCT-2N REDEFINES
SUB-STRUCT-2 PIC 9(8).
And the following code:
* 3RD TEST:
MOVE 112011 TO SUB-STRUCT-1.
MOVE 20100113 TO SUB-STRUCT-2.
MOVE SUB-STRUCT-1N TO FIELD-A OF STRUCT-1
MOVE SUB-STRUCT-2N TO FIELD-B OF STRUCT-1
DISPLAY "SUB-STRUCT-1 : " SUB-STRUCT-1
DISPLAY "SUB-STRUCT-2 : " SUB-STRUCT-2
DISPLAY "FIELD-A : " FIELD-A OF STRUCT-1
DISPLAY "FIELD-B : " FIELD-B OF STRUCT-1
Beware: Moving character data into a COMP-3 field may give you the dreaded SOC7 data exception abend when the receiving item is referenced. This is because not all bit patterns are valid COMP-3 numbers.

You have 2 Issues.
COBOL has several Numeric Data Structures. Each has its own set of rules.
For PACKED DECIMAL ( COMP-3 )
• The numeric components of the PIC clause should ALWAYS add up to an ODD number.
• The decimal marker “V” determines the placement of the decimal point.
• The individual element MOVE and math functions will maintain the decimal value alignment – both high and low level truncation is possible
• Numeric data type conversion (zone decimal to packed & binary to packed) is handled for you.
e.g. S9(5)V9(2) COMP-3.
including the 2 decimal positions>
Length is calculated as ROUND UP[ (7 + 1) / 2] = 4 bytes
S9(6)V9(2) COMP-3.
including the 2 decimal positions >
Length is calculated as ROUND UP[(8 + 1) / 2] = 5 bytes
But the 1st ½ byte is un-addressable
The last ½ byte of the COMP-3 fields is the HEXIDECIMAL representation of the sign.
The sign ½ byte values are C = signed positive D = signed negative F = unsigned (non COBOL).
S9(6)V9(3) COMP-3 VALUE 123.45.
Length is calculated as ROUND UP[(9 + 1) / 2] = 5 bytes
Contains X’00 01 23 45 0C’
Note the decimal alignment & zero padding.
Group Level MOVE rules
COBOL Data field structures are define as hierarchical structures.
The 01 H-L group field – & any sub-group level field –
Is almost always an implied CHARACTER string value
If an individual element field is a 01 or 77 level – then it can be numeric.
Individual element fields defined as a numeric under a group or sub-group level will be treated as numeric if referenced as an Individual element field.
Numeric rules apply.
o Right justify
o decimal place alignment
o pad H-L (½ bytes) with zeros
o Numeric data type conversion
The receiving field of a MOVE or math calculation determines if a numeric data conversion will occur.
Numeric Data Conversion
If you MOVE or perform a math calculation using any sending field type (group or element) to any receiving individual element field defined using a numeric PIC clause --- then numeric data conversion will occur for the receiving field. S0C7 abends occur when non-numeric data is MOVE ‘d to a receiving numerically defined field OR when math calculations are attempted using non-numeric data.
No Numeric Data Conversion
If you move any field type (group or element) to any group or sub-group level field then there will be NO numeric data conversion.
• Character MOVE rules apply.
• Left Justify & pad with spaces.
This is one of the primary causes of non-numeric data in a numerically defined field.
One of the primary uses of a sending group level MOVE containing numeric element fields to a receiving group level containing numeric element fields (mapped identically) is for re-initializing numeric element fields using 1 MOVE instruction.
A Clear Mask – or – a data propagation MOVE is also possible for table clears - where the table group level is greater than 255 bytes.

Related

convert alphanumeric PIC X(02) to hex value 9(01) COMP-3 in cobol

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.

COBOL supress last number while summing two decimal numbers

According to the COBOL code below when I try to sum WS-NUM1 with WS-NUM2, COBOL seems to supress the last number. For example: variable WS-NUM1 and WS-NUM2 are 10.15, I get 20.20 as result but expected 20.30. What's wrong?
WS-NUM1 PIC 9(2)V99.
WS-NUM2 PIC 9(2)V99.
WS-RESULTADO PIC 9(2)V99.
DISPLAY "Enter the first number:"
ACCEPT WS-NUM1.
DISPLAY "Enter the second number:"
ACCEPT WS-NUM2.
COMPUTE WS-RESULTADO = WS-NUM1 + WS-NUM2.
Thanks in advance.
PIC 9(2)v99 defines a variable with an implied decimal place not a real one. You're trying to enter data containing a decimal point and it's not working because you have to strip out the '.' to get the numeric part of your data to properly fit in the 4 bytes that your working storage area occupies.
PROGRAM-ID. ADD2.
data division.
working-storage section.
01 ws-num-input pic x(5).
01 WS-NUM1 PIC 9(2)V99 value 0.
01 redefines ws-num1.
05 ws-high-num pic 99.
05 ws-low-num pic 99.
01 WS-NUM2 PIC 9(2)V99 value 0.
01 redefines ws-num2.
05 ws-high-num2 pic 99.
05 ws-low-num2 pic 99.
01 WS-RESULTADO PIC 9(2)V99.
PROCEDURE DIVISION.
DISPLAY "Enter the first number:"
*
accept ws-num-input
unstring ws-num-input delimited by '.'
into ws-high-num, ws-low-num
DISPLAY "Enter the second number:"
accept ws-num-input
unstring ws-num-input delimited by '.'
into ws-high-num2, ws-low-num2
*
COMPUTE WS-RESULTADO = WS-NUM1 + WS-NUM2.
DISPLAY WS-RESULTADO
STOP RUN
.
This is just a simple demonstration. In a real world application you would have to insure much more robust edits to ensure that valid numeric data was entered.
If I declare it like this
01 WS-NUM1 PIC 9(2)V99.
01 WS-NUM2 PIC 9(2)V99.
01 WS-RESULTADO PIC 9(2)V99.
and define and sum them up like this
SET WS-NUM1 TO 10.15.
SET WS-NUM2 TO 10.15.
COMPUTE WS-RESULTADO = WS-NUM1 + WS-NUM2.
DISPLAY WS-RESULTADO.
I get the expected result of 20.30.
This looks like a job for a special type of PICture : Edited picture
Indeed you seem to know about the vanilla PICture clause (I'm writing PICture because as you may know it you can either write PIC or PICTURE).
A vanilla number PIC contains only 4 different symbols (and the parentheses and numbers in order to repeat some of the symbols)
9 : Represents a digit. You can repeat by using a number between parentheses like said before.
S : Means that the number is signed
V : Show the position of the implicit decimal point
P : I've been told that it exists but I honestly never found it in the codebase of my workplace. Its another kind of decimal point used for scaling factors but I don't know much about it.
But there are other symbols.
If you use theses other mysterious symbols the numeric PIC becomes an edited numeric PIC. As its name says, an edited PICture is made to be shown. It will allow you to format your numbers for better presentation or to receive number formatted for human reading.
Once edited, you cannot use it to make computations so you will have to transfer from edited to vanilla to perform computations on the latter. And you move from vanilla to edited in order to display your results.
So now I shall reveal some of these mysterious symbols :
B : Insert a blank at the place it is put
0 : Insert a zero at the place it is put
. : Insert the decimal point at the place it is put
: Insert a + if the number is positive and a - if the number is negative
Z : Acts like a 9 if the digits it represents has a value different than 0. Acts like a blank if the digits has the value of 0.
To my knowledge there are also : / , CR DB * $ -
You can look up for it on the internet. They really show the accountant essence of cobol.
For your problems we are really interested by the "." which will allow us to take into account the decimal point you have the write when you type down your input.
For a bonus I will also use Z which will make your result looks like 2.37 instead of 02.37 if the number is less than ten.
Note that you cannot use the repeating pattern with parenthesis ( 9(03) for instance) when describing an edited picture ! Each digits has to represented explicitly
IDENTIFICATION DIVISION.
PROGRAM-ID. EDITCOMP.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-NUM1-EDITED PIC 99.99.
01 WS-NUM2-EDITED PIC 99.99.
01 WS-NUM1-CALC PIC 9(2)V99.
01 WS-NUM2-CALC PIC 9(2)V99.
01 WS-RESULTADO-EDITED PIC Z9.99.
PROCEDURE DIVISION.
ACCEPT WS-NUM1-EDITED.
ACCEPT WS-NUM2-EDITED.
MOVE WS-NUM1-EDITED TO WS-NUM1-CALC.
MOVE WS-NUM2-EDITED TO WS-NUM2-CALC.
COMPUTE WS-RESULTADO-EDITED = WS-NUM1-CALC + WS-NUM2-CALC.
DISPLAY WS-RESULTADO-EDITED.
STOP RUN.
You should note that there also exist edited alphanumeric picture. You can insert Blank (B), zeroes (0) or / (/) in it.

How used DIVIDE with a CONDENSED NUMERIC Varibale in COBOL

My problem is: I have data in a database table. The column is: Z-ZYTL-RTPDHR defined as NOT NULL NUMBER(5,2) .
So I have a program that I need to move my data in one variable "H-ZYTL-RTPDHR" and after I will move this value divide by 100 in one column Z8 when i compile i obtained Excel with data in the different column.
My data:
Z8
------
34,28
70
97
8,57
21,43
94,28
94,28
100
40
40
what I should get:
Z8
-------
0,3428
0,7
0,97
0,0857
0,2143
0,9428
0,9428
0,100
0,40
0,40
my question how to declare the variable to obtain the good result?
Variables that I declared:
01 FILLER.
05 H-ZYTL-RTPDHR.
10 PIC S9(5)V9(2) comp-3 VALUE.
05 FILLER REDEFINES H-ZYTL-RTPDHR.
10 H-ZYTL-RTPDHR comp-3 pic s9(5)v99.
Equivalent Temps Plein
05 W-Z8 PIC -(5),99.
05 FILLER PIC X(001) VALUE ';'.
ALIM-WZ8 SECTION.
IF Z-ZYTL-NOMBRE > ZERO
IF TLCODTRA(Z-ZYTL-NOMBRE) NOT = SPACES
MOVE Z-ZYTL-RTPDHR(Z-ZYTL-NOMBRE) TO
H-ZYTL-RTPDHR
DISPLAY 'H-ZYTL-RTPDHR:' H-ZYTL-RTPDHR
DIVIDE H-ZYTL-RTPDHR BY 100 GIVING W-Z8
DISPLAY 'W-Z8 : ' W-Z8
END-IF
END-IF.
You have defined the name H-ZYTL-RTPDHR twice: that will confuse you and and the compiler as well.
Your second definition of H-ZYTL-RTPDHR is good for doing arithmetic. All you need is
01 FILLER.
10 H-ZYTL-RTPDHR comp-3 pic s9(5)v99.
Your first definition of H-ZYTL-RTPDHR defines a group level item, and you can't do arithmetic with it.
However, your question doesn't show the definition of Z-ZYTL-RTPDHR. If it's not numeric, then you won't get the results you expect.

COBOL- Add number of characters to a string based on variable

How would I add characters to the beginning of a string based on a variable? For example a vendor we use for telephone numbers converts out string to a numeric which drops the leading 0's off of the phone number. When they send us the report back we convert the number back into a string but now it doesn't have the correct amount of numbers. I'm trying the following:
IF LENGTH(TO-NUM) < 10
SUBTRACT LENGTH(TO-NUM) FROM 10 GIVING ADD-NUM-ZERO
Now I need to figure out how to add ADD-NUM-ZERO number of 0's to the beginning of the string TO-NUM without overwriting the characters already at the beginning.
Assuming that TO-NUM contains only digits followed by spaces (or spaces followed by digits), then
1 TO-NUM PIC X(10).
1 temp-x.
5 temp-9 pic 9(10).
if to-num not numeric
compute temp-9 = function numval (to-num)
move temp-x to to-num
end-if
will, if necessary, replace the previous content with the same value but with leading zeros.
The IF TO-NUM NOT NUMERIC statement is equivalent to asking if the number of digits in TO-NUM is less than 10.
For example, if to-num was '5551212 ' before, then to-num will be '0005551212' after.
If to-num contains non-digits, then it would be necessary to extract the digits by parsing to-num into temp-9.
Working-storage section.
01 NUM PIC 9(10) COMP-5.
01 TELNUM-G.
03 TELNUM PIC 9(10).
03 TELNUM-S REDEFINES TELNUM.
05 AREACODE PIC 999.
05 THREEDIGIT PIC 999.
05 FOURDIGIT PIC 9999.
01 TELOUTPUT PIC X(13) VALUE '(AAA)TTT-NNNN'.
Procedure division.
Move 31234 to NUM.
MOVE NUM TO TELNUM.
INSPECT TELOUTPUT
REPLACING ALL 'AAA' BY AREACODE
ALL 'TTT' BY THREEDIGIT
ALL 'NNNN' BY FOURDIGIT
This code assume the number is in "NUM", and it can be in any of ZONE/PACK/BINARY/COMP-3/COMP-5 formats. I've used COMP-5 in this example code.

Field validation in COBOL/CICS

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! :)

Resources