Hex Values of a Character field

does anyone know of a better way to get the hexadecimal value of a
character 
field besides the following method: (which i was forced to come up with
for lack of knowing a better way.)  

thanks in advance

  *---------------------------------------------------------------------

 D TABNUM          S              2  0 DIM(15) CTDATA PERRCD(1)

 D  TABHEX         S              1    DIM(15) ALT(TABNUM)

  *---------------------------------------------------------------------

 C     GET_HEX_VALUE BEGSR

  *--------------------------------------------------------------------*

  * THIS SUBROUTINE WILL ACCEPT A 1 POSITION CHARACTER FLD ##CHARACTER *

  * AND RETURN A TWO CHARACTER FLD ##HEXNUM CONTAINING THE HEXADECIMAL *

  * REPRESENTATION OF ##CHARACTER                                      *

  *--------------------------------------------------------------------*

 C                   MOVE      ##CHARACTER   ##CHARACTER       1

 C                   Z-ADD     0             ##NUMBER1         2 0

 C                   Z-ADD     0             ##NUMBER2         2 0

 C                   MOVE      *BLANKS       ##HEXNUM          2

  *---------------------------------------------------------------------

 C                   TESTB     '0'           ##CHARACTER              99

 

 C                   IF        *IN99

 C                   ADD       8             ##NUMBER1

 C                   ENDIF

 C                   TESTB     '1'           ##CHARACTER              99

 C                   IF        *IN99

 C                   ADD       4             ##NUMBER1

 C                   ENDIF

 C                   TESTB     '2'           ##CHARACTER              99

 C                   IF        *IN99

 C                   ADD       2             ##NUMBER1

 C                   ENDIF

 C                   TESTB     '3'           ##CHARACTER              99

 C                   IF        *IN99

 C                   ADD       1             ##NUMBER1

 C                   ENDIF

 C                   TESTB     '4'           ##CHARACTER              99

 

 C                   IF        *IN99

 C                   ADD       8             ##NUMBER2

 C                   ENDIF

 C                   TESTB     '5'           ##CHARACTER              99

 C                   IF        *IN99

 C                   ADD       4             ##NUMBER2

 C                   ENDIF

 C                   TESTB     '6'           ##CHARACTER              99

 C                   IF        *IN99

 C                   ADD       2             ##NUMBER2

 C                   ENDIF

 C                   TESTB     '7'           ##CHARACTER              99

 C                   IF        *IN99

 C                   ADD       1             ##NUMBER2

 C                   ENDIF

  *---------------------------------------------------------------------

  *---------------------------------------------------------------------

 C     ##NUMBER1     LOOKUP    TABNUM        TABHEX                   99

 C                   MOVEL     TABHEX        ##HEXNUM          2

 C     ##NUMBER2     LOOKUP    TABNUM        TABHEX                   99

 C                   MOVE      TABHEX        ##HEXNUM          2

  *---------------------------------------------------------------------

 C                   ENDSR

** NUMBER TO HEX CONVERSION TABLE      
011                                    
022                                    
033                                    
044                                    
055                                    
066                                    
077                                    
088                                    
099                                    
10A                                    
11B                                    
12C                                    
13D                                    
14E                                    
15F                                    
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---