        CATALS   A.STS006
        TITLE 'STS006-ASSIGNACIONS DINAMIQUES'
        PRINT GEN
***********************************************************************
*
*  AL.LOCACIONS , DESAL.LOCACIONS , CONCATENACIONS , DESCONCATENACIONS
*  CANVI D'ATRIBUTS I INFORMACIO D'UN O VARIS DATASETS O D'UNA DD.
*
*  AQUEST MODUL ES CARREGA VIA LOAD.
*
*  S'INVOCA:
*        ASSEMBLER:
*               LOAD EP=STS006
*               L    R15,R0
*               CALL (15),(K006P1,K006P2,K006P3,K006P4),VL
*
*        PLI      :
*               %INCLUDE STSY007P,.
*               . . .
*               CALL STS006(K006P1,K006P2,K006P3,K006P4),.
*
*
*  REB 4 PARAMETRES.
*
*  1ER.
*
*    K006P1   DS   A
*                  PTR
*
*             ADRECA D'UN CAMP DE 4 BYTES QUE CONTE:
*                      K006OP
*             BYTE 1 = CODI OPERACIO ES EL VERB CODE DE LA SVC99
*                      K006RT
*             BYTE 2 = CODI RETORN
*                      K006F1
*             BYTE 3 I 4 = FLAGS1 DE LA SVC99.
*  2ON.
*
*    K006P2   DS   A
*                  PTR
*
*             ADRECA D'UNA PARAULA QUE CONTE:
*                      K006EC
*             BYTE 1 I 2 = ERROR CODE DE LA SVC99.
*                      K006IC
*             BYTE 3 I 4 = INFO CODE DE LA SVC99.
*  3ER.
*
*    K006P3
*             K006NP   DS H
*                      BIN FIXED(15)
*
*                 CONTE EL NUM. DE PARAMETRES QUE VENEN A CONTINUACIO.
*
*             K006GA   DS   255CL4
*                      (255)PTR
*
*                 GRUP D'ADRECES:
*                 LES ADRECES CORRESPONEN DE LA 1A. A LA ULTIMA
*                 TEXT UNIT DE LA SVC99 COMPOSADES PER KEY, ,LEN,PARM
*                 COM A MAXIM 255 TEXT UNITS
*
*  4AR.
*
*    K006P4   DS   CL300
*                  CHAR(300)
*
*             AREA DE TREBALL DEL MODUL, NO HA DE SER MODIFICADA
*             PEL INVOCANT.
*
*    RETORNS
*           OK
*               R15 O PLIRETV = 00
*               R1 (ASSEMBLER)= 00
*               K006RT        = 00
*               K006EC        = 0000
*               K006IC        = 0000
*
*           KO
*               ERRORS DETECTATS PEL MODUL:
*
*               R15 O PLIRETV = FF O HIGH VALUES
*               R1 (ASSEMBLER)= ADRECA DEL PARAMETRE INVALID
*               K006RT        = FF
*               K006EC        = ADRECA PARAMETRE INVALID
*               K006IC        =   "        "        "
*
*               ERRORS RETORNATS PER LA SVC99
*
*               R15 O PLIRETV = CODI RETORN (0 A 12)
*               R1 (ASSEMBLER)= ADRECA CAMP ERROR INFO CODE
*               K006RT        = CODI RETORN
*               K006EC        = VEURE MANUAL
*               K006IC        =   "     "
*
***********************************************************************
         EJECT
STS006   CSECT
STS00600 HMINICI BASE=(10),AREA=12(1),TIPUS=L
*
*   PER SI NO VE L'AREA NETA , LA NETEJO AMB "MVCL".
*
 MVI 0(R13),X'00'    1ER.BYTE 4AR.PARAMETRE.
 MVC 1(3,R13),0(R13) NETEJA 1A. PARAULA SAVE-AREA.
 LA  R4,8(R13)       ZONA RECEPTORA, DESPRES DE SAVE-AREA ANTERIOR.
 LA  R5,LONGITUT_PARAMETRE_4-8     LONGITUT ZONA RECEPTORA.
 LA  R6,0(R13)       ZONA EMISSORA (FICTICIA).
 SR  R7,R7           LONG.EMISSORA = 0, UTILITZA FARCIDOR.
*                    EL CARACTER FARCIDOR ES X'00' (REG.7 = 0).
 MVCL R4,R6          NETEJA 4AR. PARAMETRE.
*
*
*
 USING PARAM,R3      PARAMETRES REBUTS.
 LR    R3,R1         SAVE ADDR LLISTA PARAMETRES.
 L     BASE_PARAMETRE_1,ADDR_PARAMETRE_1
 USING PARAMETRE_1,BASE_PARAMETRE_1
 L     BASE_PARAMETRE_2,ADDR_PARAMETRE_2
 USING PARAMETRE_2,BASE_PARAMETRE_2
 L     BASE_PARAMETRE_3,ADDR_PARAMETRE_3
 USING PARAMETRE_3,BASE_PARAMETRE_3
 USING PARAMETRE_4,BASE_PARAMETRE_4
STS06001  HMNOM DESC='RUTINA DE SAVE I COMPROVACIO DE PARAMETRES'
 IF TM,ADDR_PARAMETRE_4,ULTIM_PARAMETRE,O
    SR  R5,R5               NETEJA REGISTRE.
    IC  R5,K006OP           MOC 1ER CARACTER OPCIO.
    IF  LTR,R5,R5,Z         MIRO SI OPCIO ES ZERO.
        LA  R1,K006OP       CARREGO ADRECA DEL ERROR.
        PERFORM STS06ERR    ERROR
    ELSE
        IF  CH,R5,H,OPCIO_MAXIMA
            LA  R1,K006OP        CARREGO ADRECA DEL ERROR.
            PERFORM STS06ERR     ERROR
        ELSE
            IF  TM,K006F1,BITS5A7_OFF,NZ
                 LA  R1,K006F1        CARREGO ADRECA ERROR
                 PERFORM STS06ERR     ERROR
            ELSE
                 IF  TM,K006F1+1,BITS8A16_OFF,NZ
                     LA  R1,K006F1        CARREGO ADRECA ERROR
                     PERFORM STS06ERR     ERROR
                 ELSE
                     LH R5,K006GA         NUM. PARAMETRES.
                     IF  LTR,R5,R5,Z
                         LA  R1,K006GA      ADRECA DEL ERROR.
                         PERFORM STS06ERR   ERROR.
                     ELSE
                         IF  CH,R5,H,MAXIM_PARAMETRES
                             LA  R1,K006GA      ADRECA DEL ERROR.
                             PERFORM STS06ERR   ERROR.
                         ELSE
                             LA  R6,L'K006TU
                             SR  R4,R4             NETEJA REGISTRE.
                             MR  R4,R6             NUM.PARAM. X 4.
                             LA  R4,K006TU         ADDR. TEXT UNITS.
                             LA  R4,0(R5,R4)
                             SR  R4,R6             ULTIMA TEXT UNIT.
                             MVI 0(R4),ULTIM_PARAMETRE
                             ST  R4,ADDFIADD      SALVO ADDR.
                             PERFORM STS06GET     GETMAIN.
                             PERFORM STS06SVC     SVC99.
                         ENDIF
                     ENDIF
                 ENDIF
            ENDIF
        ENDIF
    ENDIF
 ELSE
    LA  R1,PARAMETRE_4  CARREGO ADRECA DEL ERROR.
    PERFORM STS06ERR    ERROR
 ENDIF
 IC RETORN_MODUL,K006RT   CODI RETORN.
 L  R13,4(R13)            RESTAURA ADRECA SAVE AREA INVOCANT.
 RETURN (14,12),RC=(15)
STS06GET HMENTRA DESC='OBTENCIO DE MEMORIA PER A LA SVC99'
 LA  R6,L'K006TU
 LA  R0,RBLEN             LONG REQUEST BLOC.
 AR  R0,R6                LONG.TOTAL = LONG RB + LONG RBPRT.
 STH R0,LONGET            AMAGATZEMO LONG.
 GETMAIN R,LV=(R0)
 ST  R1,INIGET            AMAGATZEMO ADRECA INICI GETMAIN.
 HMSURT
STS06SVC HMENTRA DESC='SVC 99'
 L   R12,INIGET            ADRECA GETMAIN.
 USING S99RBP,R12           REQUEST BLOC POINT.
 LA  R9,S99RBPTR+L'S99RBPTR 4 BYTES DESPRES.
 USING S99RB,R9             REQUEST BLOC.
 ST  R9,S99RBPTR
 OI  S99RBPTR,S99RBPND      BIT 0 ON.
 XC  S99RB(RBLEN),S99RB     NETEJO RB.
 MVI S99RBLN,RBLEN          LONG. DE RB.
 MVC S99VERB,K006OP         OPCIO.
 MVC S99FLAG1,K006F1        FLAG1
 LA  R4,K006TU              LLISTA DE TEXT UNITS.
 ST  R4,S99TXTPP            TEXT UNIT POINTER LIST.
 L   R1,INIGET              ADRECA GETMAIN.
 DYNALLOC
 SR  R1,R1
 STH R1,K006EC              NETEJA ERROR.
 IF  LTR,RETORN_SVC99,RETORN_SVC99,NZ
     MVC K006EC,S99ERROR
     MVC K006IC,S99INFO
 ENDIF
 STC RETORN_SVC99,K006RT        RETORN A PARAMETRES.
 LR  R11,R1            SALVA REG. 1
 L   R1,INIGET         ADRECA INICI GETMAIN.
 LH  R0,LONGET         LONG GETMAIN.
 FREEMAIN R,LV=(R0),A=(R1)
 LR  R1,R11            RESTAURA REG 1.
 L   R11,ADDFIADD
 MVI 0(R11),BIT0_OFF
 HMSURT
STS06ERR HMENTRA DESC='ERRORS USUARI'
 ST  R1,K006EC
 MVI K006RT,ERROR_USUARI
 HMSURT
          EJECT
RETORN_SVC99     EQU   15
RETORN_MODUL     EQU   15
BASE_PARAMETRE_1 EQU   2
BASE_PARAMETRE_2 EQU   7
BASE_PARAMETRE_3 EQU   8
BASE_PARAMETRE_4 EQU   13
ERROR_USUARI     EQU   X'FF'
BITS8A16_OFF     EQU   X'FF'
ULTIM_PARAMETRE  EQU   X'80'
BITS5A7_OFF      EQU   X'07'
BIT0_OFF         EQU   X'00'
MAXIM_PARAMETRES DC    H'255'
OPCIO_MAXIMA     DC    H'7'
         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
K006OP      DS CL1         OPCIO.
K006RT      DS CL1         RETORN.
K006F1      DS XL2         FLAGS1 DE LA SVC.
PARAMETRE_2 DSECT
K006EC      DS H           ERROR CODE SVC 99.
K006IC      DS H           INFO CODE SVC 99.
PARAMETRE_3 DSECT
K006GA      DS H           NUM. PARAMETRES.
K006TU      DS 255CL4     ADRECES DE LES TEXT UNITS.
PARAMETRE_4 DSECT
LONGITUT_PARAMETRE_4  EQU 300
SAVE_AREA   DS 9D
ADDFIADD    DS F
INIGET      DS F           ADRECA INICI GETMAIN.
LONGET      DS F           LONGITUT GETMAIN.
         HMSTACK
FI_PARAMETRE_4 EQU *-SAVE_AREA
FILLER      DS CL(LONGITUT_PARAMETRE_4-FI_PARAMETRE_4)
         IEFZB4D0              SVC 99 DSECT,S
RBLEN    EQU S99RBEND-S99RB
          END
