Joined: 31 Aug 2010 Posts: 4 Location: Buffalo, NY
Hi! I need help in converting HEX values which we receive in a file to text or numeric field.
I'm getting the file - where one of the fields is defined as an x(3) in the copybook, but when we open the file through FILEAID the value in the field looks like x'424244'.
I want to take values in quotes and move them to another field.
For example if the input value is X'847388' I want to get 847388 in the output.
01 WORK-FIELDS.
05 SUB1 PIC 999 COMP.
05 SOURCE-LENGTH PIC 99 COMP.
05 TARGET-LENGTH PIC 99 COMP.
01 SOURCE-STRING.
05 SOURCE-CHAR PIC X
OCCURS 32
INDEXED BY SIDX.
01 TARGET-STRING.
05 TARGET-CHAR PIC XX
OCCURS 32
INDEXED BY TIDX.
01 ALL-256-VALUES.
05 PIC X(32) VALUE '000102030405060708090A0B0C0D0E0F'.
05 PIC X(32) VALUE '101112131415161718191A1B1C1D1E1F'.
05 PIC X(32) VALUE '202122232425262728292A2B2C2D2E2F'.
05 PIC X(32) VALUE '303132333435363738393A3B3C3D3E3F'.
05 PIC X(32) VALUE '404142434445464748494A4B4C4D4E4F'.
05 PIC X(32) VALUE '505152535455565758595A5B5C5D5E5F'.
05 PIC X(32) VALUE '606162636465666768696A6B6C6D6E6F'.
05 PIC X(32) VALUE '707172737475767778797A7B7C7D7E7F'.
05 PIC X(32) VALUE '808182838485868788898A8B8C8D8E8F'.
05 PIC X(32) VALUE '909192939495969798999A9B9C9D9E9F'.
05 PIC X(32) VALUE 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'.
05 PIC X(32) VALUE 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'.
05 PIC X(32) VALUE 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'.
05 PIC X(32) VALUE 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'.
05 PIC X(32) VALUE 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'.
05 PIC X(32) VALUE 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'.
01 ALL-256 REDEFINES ALL-256-VALUES.
05 HEX-CHARS PIC XX OCCURS 256 INDEXED BY HIDX.
MOVE SPACES TO TARGET-STRING.
MOVE ?? TO SOURCE-LENGTH.
SET SIDX TO 1.
SET TIDX TO 1.
PERFORM
UNTIL SIDX > SOURCE-LENGTH
COMPUTE SUB1 = FUNCTION ORD (SOURCE-CHAR (SIDX))
SET HIDX TO SUB1
MOVE HEX-CHARS (HIDX) TO TARGET-CHAR (TIDX)
SET SIDX UP BY 1
SET TIDX UP BY 1
END-PERFORM.
COMPUTE TARGET-LENGTH = SOURCE-LENGTH * 2.
Joined: 31 Aug 2010 Posts: 4 Location: Buffalo, NY
Thank you for posting suggestions so quickly.
Bill - please check if this is what I should do.
I also have a question about WS-HEX-BYTE .
Should the length of it be changed if I want to process up to 8 hex bytes at a time ? Should I make it x(08) as well. When MOVE WS-HEX-BYTE TO WS-PACKED-X (1:1) also should be changed to (1:8) ?
MOVE X'FF' TO WS-HEX-BYTE.
MOVE ZERO TO WS-PACKED.
MOVE WS-HEX-BYTE TO WS-PACKED-X (1:1).
MOVE WS-PACKED-V9 TO WS-DISPLAY-V9.
INSPECT WS-DISPLAY-X CONVERTING X'FAFBFCFDFEFF' TO 'ABCDEF'.
Joined: 14 Jan 2008 Posts: 2501 Location: Atlanta, Georgia, USA
Yes, change WS-HEX-BYTE to WS-HEX-VALUE PIC X(08). Move X'0123456789ABCDEF' to WS-HEX-VALUE. After it completes the logic, WS-DISPLAY-X (1:16) will equal C'0123456789ABCDEF'.
Click below so you can format the code for readability using the BB code.
Joined: 31 Aug 2010 Posts: 4 Location: Buffalo, NY
Ronald - I implemented your code and it works perfectly. The only thing which I added there is the move of the field to be converted to your source-string. Thank you very very much.
Joined: 14 Jan 2008 Posts: 2501 Location: Atlanta, Georgia, USA
Reentrant Called Assembler Sub-Program HEX2CHAR, which converts up to 8-bytes HEX into 16-Bytes CHARACTER -
Code:
*PROCESS RENT
********
******** EXAMPLE SYNTAX FROM COBOL -
********
******** 01 WS-HEX2CHAR-REC.
******** 03 WS-HEX2CHAR-PARMIN PIC X(09).
******** 03 WS-HEX2CHAR-PARMOUT PIC X(16).
******** 03 WS-HEX2CHAR-RSA PIC X(72).
********
******** 01 WS-HEX2CHAR PIC X(08) VALUE 'HEX2CHAR'.
********
******** MOVE X'0123456789ABCDEF' TO WS-HEX2CHAR-PARMIN.
********
******** CALL WS-HEX2CHAR USING WS-HEX2CHAR-REC.
********
******** AFTER RETURNING, WS-HEX2CHAR-PARMOUT = '0123456789ABCDEF'
********
YREGS , MVS REGISTER-EQUATES
HEX2CHAR AMODE 31
HEX2CHAR RMODE ANY
PARMAREA DSECT PARM-DSECT (R7)
USING *,R7 INFORM ASSEMBLER
PARMIN DS XL9 HEX-PARMIN
PARMOUT DS CL16 CHARACTER-PARMOUT
PARMRGSA DS XL72 REGISTER-SAVEAREA
HEX2CHAR CSECT BEGIN CSECT
USING *,R3 INFORM ASSEMBLER
SAVE (14,12) SAVE REGISTERS
LA R3,0(,R15) R3 IS CSECT-BASE
L R7,0(,R1) R7 IS PARM-BASE
LA R7,0(,R7) CLEAR TOP-BIT
XC PARMRGSA,PARMRGSA ENSURE X'00'S
LA R15,PARMRGSA POINT TO OUR RSA
ST R13,4(,R15) BACKWARD CHAIN
ST R15,8(,R13) FORWARD CHAIN
LR R13,R15 POINT TO OUR RSA
MVI PARMIN+L'PARMIN-1,X'0F'
MVO PARMIN,PARMIN(L'PARMIN-1)
UNPK PARMOUT,PARMIN UNPACK AS A CL16
NI PARMOUT,X'0F' CLEAR ALL ZONES
MVZ PARMOUT+1(L'PARMOUT-1),PARMOUT
TR PARMOUT,=CL16'0123456789ABCDEF'
XR R15,R15 ALL IS WELL
RTN2CLLR EQU *
L R13,4(,R13) RESTORE CALLER'S R13
XC PARMRGSA,PARMRGSA ENSURE X'00'S
RETURN (14,12),RC=(15) RESTORE AND RETURN
LTORG , LITERAL-ORG
END , END 'HEX2CHAR'
