MACRO                                                                  
&N       HEXPRINT &R1,&R2                                                       
         LCLC  &REG1,&REG2                                                      
         GBLB  &HEXPRNT                                                         
         GBLC  &RENTGBL                                                         
         GBLA  &X                                                               
* ******************************************************************* *         
*                                                                     *         
*                         H E X P R I N T                             *         
*                                                                     *         
*        Convert Field from hex to printable hex equivalent           *         
*                                                                     *         
         AIF   ('&N' EQ '').GO                                                  
&N       DS    0H                                                               
.GO      ANOP                                                                   
         AIF   ('&X' GT '1').GO2                                                
&X       SETA  1                                                                
.GO2     AIF   (K'&R1 NE 0).REG1OK                                              
         MNOTE 8,'***** No registers specified ***********************'         
         AGO   .END                                                             
.REG1OK  ANOP                                                                   
         AIF   ('&R1'(1,1) NE 'R').NUMB                                         
&REG1    SETC  '&R1'(2,2)                                                       
         AGO   .COMP                                                            
.NUMB    ANOP                                                                   
&REG1    SETC  '&R1'                                                            
.COMP    ANOP                                                                   
         AIF   ('&REG1' GT '15').E1                                             
&REG1    SETC  '&R1'                                                            
         AIF   (K'&R2 NE 0).REG2OK                                              
         MNOTE 8,'***** No second register specified *****************'         
         AGO   .END                                                             
.REG2OK  ANOP                                                                   
         AIF   ('&R2'(1,1) NE 'R').NUMB2                                        
&REG2    SETC  '&R2'(2,2)                                                       
         AGO   .COMP2                                                           
.NUMB2   ANOP                                                                   
&REG2    SETC  '&R2'                                                            
.COMP2   ANOP                                                                   
         AIF   ('&REG2' GT '15').E1                                             
&REG2    SETC  '&R2'                                                            
         AIF   ('&REG1' EQ '&REG2').E2                                          
.CONT    ANOP                                                                   
         AIF   (&HEXPRNT).SKIPPY                                                
         B     ASLBR&X           Skip workarea                        *         
*        H E X P R I N T     W O R K A R E A                          *         
ASLSAV1  DS    F                 Save area for register with number   *         
ASLSAV2  DS    CL9               Temporary area for convert           *         
         DS    0H                                                     *         
&HEXPRNT SETB  1                 Set flag for one time defines                  
*                                                                     *         
.SKIPPY  ANOP                                                                   
ASLBR&X  ST    &REG1,ASLSAV1     Save number                          *         
         LA    &REG1,ASLSAV1     Get address of where it is           *         
         UNPK  ASLSAV2+0(9),0(5,&REG1)  Convert to printable          *         
         NC    ASLSAV2+0(8),=8X'0F'                                   *         
         TR    ASLSAV2+0(8),=CL16'0123456789ABCDEF'                   *         
         MVC   0(8,&REG2),ASLSAV2  Put answer into passed field       *         
         L     &REG1,ASLSAV1     Restore register                     *         
&X       SETA  &X+1                                                             
*                                                                     *         
*  Copyright - Abbydale Systems LLC.                                  *         
* ******************************************************************* *         
         MEXIT                                                                  
.E2      MNOTE 8,'Duplicate register specification'                             
         AGO   .END                                                             
.E1      MNOTE 8,'Improper register specified, No statements generated'         
.END     ANOP                                                                   
         MEND