        CATALS   A.STS019
        TITLE 'STS019-CONVERSIO HEXA A CARACTER HEXA'
        PRINT GEN
***********************************************************************
*  S'INVOCA:
*        ASSEMBLER:
*               LOAD EP=STS019
*               L    R15,R0
*               CALL (15),(K019P1,K019P2,K019P3,K019P4),VL
*        PLI      :
*               %INCLUDE STSY019P;
*               PER A PROGRAMES BATCH: FETCH STS019;
*               . . .
*               . . .
*               . . .
*               CALL STS019(K019P1,K019P2,K019P3,K019P4),.
*  REB 4 PARAMETRES.
*  1ER.
*    K019P1   DS F
*             BIN FIXED(31)
*  2ON.
*    K019P2   DS   CL
*                  CHAR
*  3ER.
*    K019P3   DS   CL
*                  CHAR        HA D'ESSER K019P2 X 2
*  4AR.
*    K019P4   DS   CL80
*                  CHAR(80)
*  RETORNS
*               R15 O PLIRETV , 0 = OK
*                              16 = LONG. 1ER PARAMETRE = 0
*                              24 = 1ER PARAMETRE CONTE DADES NO HEXA
***********************************************************************
         EJECT
STS019   CSECT
STS019   AMODE 31
STS019   RMODE ANY
STS01900 HMINICI BASE=(8),AREA=12(1),TIPUS=L,                          C
               DESC='STS019-CONVERSIO HEXA A CAR.HEXA'
 USING PARAM,R1      PARAMETRES REBUTS.
 L     BASE_PARAMETRE_1,ADDR_PARAMETRE_1
 USING PARAMETRE_1,BASE_PARAMETRE_1
 L     BASE_PARAMETRE_2,ADDR_PARAMETRE_2
 L     BASE_PARAMETRE_3,ADDR_PARAMETRE_3
 USING PARAMETRE_4,BASE_PARAMETRE_4
       EJECT
 L R5,LONGITUT             CARREGA LONGITUT PARAMETRE REBUT.
 IF LTR,R5,R5,Z
    LA R15,16              LONGITUT REBUDA = 0.
 ELSE
    SLL R5,1               LONGITUT X 2.
    LR R3,R5               SALVA LONGITUT PARAMETRE REBUT.
    SR R11,R11             INDICADOR DRETA/ESQUERRA.
    LA R15,0               O.K.
    DO FROM=(R5)
       DOEXIT LTR,R15,R15,NZ
       LA R10,TAULA      ADRECA TAULA CONVERSIO.
       MVC WORK,0(R7)    1 CARACTER DEL ORIGEN.
       IF LTR,R11,R11,Z
          NI WORK,X'F0'   DESPRECIO MITAT DRETA.
          LA R1,0         COMPTADOR.
          DO WHILE=(CH,R1,LE,=H'16')
             DOEXIT CLC,WORK,EQ,0(R10)
             LA R1,1(R0,R1)    INCREMENTA COMPTADOR.
             LA R10,LTAULA(R0,R10) SEGUENT ELEMENT DE LA TAULA.
          ENDDO
          IF CH,R1,GT,=H'16'
             LA R15,24           CARACTERS NO HEXADECIMALS.
          ELSE
             MVC 0(1,R12),2(R10)  MOC A CAMP DESTI.
             LA  R11,1            FLAG DRETA.
             LA  R12,1(R0,R12)    SEGUENT POSICIO CAMP DESTI.
          ENDIF
       ELSE
          NI WORK,X'0F'       DESPRECIO MITAT ESQUERRA.
          LA R10,1(R0,R10)    POSICIO DRETA DE LA TAULA.
          LA R1,0             COMPTADOR.
          DO WHILE=(CH,R1,LE,=H'16')
             DOEXIT CLC,WORK,EQ,0(R10)
             LA R1,1(R0,R1)    INCREMENTA COMPTADOR.
             LA R10,LTAULA(R0,R10) SEGUENT ELEMENT DE LA TAULA.
          ENDDO
          IF CH,R1,GT,=H'16'
             LA R15,24           CARACTERS NO HEXADECIMALS.
          ELSE
             MVC 0(1,R12),1(R10)  MOC A CAMP DESTI.
             SR  R11,R11          FLAG ESQUERRA.
             LA  R12,1(R0,R12)    SEGUENT POSICIO CAMP DESTI.
             LA  R7,1(R0,R7)      SEGUENT POSICIO CAMP ORIGEN.
          ENDIF
       ENDIF
    ENDDO
    ST R3,LONGITUT                  MODIFICA LONGITUT PARAMETRE.
 ENDIF
 L  R13,4(R13)          RESTAURA ADRECA SAVE AREA INVOCANT.
 RETURN (14,12),RC=(15)
          EJECT
BASE_PARAMETRE_1 EQU   2
BASE_PARAMETRE_2 EQU   7
BASE_PARAMETRE_3 EQU   12
BASE_PARAMETRE_4 EQU   13
TAULA    HMNOM DESC='EQUIVALENCIES HEXA-CARACTERS HEXA'
 DC X'00',X'00',C'0'
LTAULA   EQU *-TAULA
 DC X'10',X'01',C'1'
 DC X'20',X'02',C'2'
 DC X'30',X'03',C'3'
 DC X'40',X'04',C'4'
 DC X'50',X'05',C'5'
 DC X'60',X'06',C'6'
 DC X'70',X'07',C'7'
 DC X'80',X'08',C'8'
 DC X'90',X'09',C'9'
 DC X'A0',X'0A',C'A'
 DC X'B0',X'0B',C'B'
 DC X'C0',X'0C',C'C'
 DC X'D0',X'0D',C'D'
 DC X'E0',X'0E',C'E'
 DC X'F0',X'0F',C'F'
         LTORG
PARAM    DSECT
ADDR_PARAMETRE_1 DS A
ADDR_PARAMETRE_2 DS A
ADDR_PARAMETRE_3 DS A
ADDR_PARAMETRE_4 DS A
PARAMETRE_1 DSECT
LONGITUT    DS F           LONGITUT ORIGEN/DESTI.
LONGITUT_PARAMETRE_4  EQU 80
PARAMETRE_4 DSECT
SAVE_AREA   DS 9D
WORK        DS CL1
FI_PARAMETRE_4 EQU *-SAVE_AREA
FILLER      DS CL(LONGITUT_PARAMETRE_4-FI_PARAMETRE_4)
          END
