        CATALS   H.STS008
         TITLE 'STS008-TRACTAMENT PARTICIONATS.'
***********************************************************************
*  S'INVOCA:
*        ASSEMBLER:
*               LOAD EP=STS008
*               L    R15,R0
*               CALL (15),(K008P1,K008P2,K008P3),VL
*        PLI      :
*               %INCLUDE HISTS008;
*               . . .
*               . . .
*               . . .
*               CALL STS008(K008P1,K008P2,K008P3),.
*  REB 3 PARAMETRES.
*  1ER.
*    K008P1   IDENTIC PER A TOTS ELS MEMBRES I/O PDS A TRACTAR.
*
*             H              ERROR MACROS.
*             BIN FIXED(15)
*                            0XX = OPEN.
*                            1XX = FIND.
*                            2XX = STOW.
*                            300 = SYNAD (VEURE DESCRIPCIO DEL ERROR).
*                            400 = EXLST (VEURE DESCRIPCIO DEL ERROR),
*                            5XX = BLDL
*                                  504 = MEMBRE INEXISTENT.
*                            6XX = FREEMAIN.
*                            7XX = GETMAIN.
*                            8XX = ENQUEUE/DEQUEUE (XX).
*                            9XX = ERRORS RUTINA STSR06 (9XX - 800).
*
*                            XX = VEURE EN MANUAL CODIS RETORNS MACROS.
*
*             CL22           DESCRIPCI DE L'ERROR.
*             CHAR(22)
*
*
*             H              LONGITUT USER-DATA (MAX. 62).
*             BIN FIXED(15)
*
*             CL62           USER-DATA.
*             CHAR(62)
*
*             H              CODI RETORN MODUL (IDENTIC AL R15 O
*             BIN FIXED(15)  AL PLIRETV DEL PL/I).
*                            0 = OK.
*                            4 = OPCI INVLIDA O COMBINACI
*                                CODI COMUNICACI-OPCI INCORRECTA.
*                            8 = MES INFORMACIO A ALTRES CAMPS ERROR.
*                           12 = NUM. PARAMETRES ERRONI.
*
*             CL1            CODI COMUNICACIO.
*             CHAR(1)
*                            0 = INICI O CONTINUA TRACTAMENT.
*                            1 = GRAVA MEMBRE, FA EL 'CLOSE' I
*                                ALLIBERA MEMORIA,
*                                (SORTIDA O REEMPLAAR).
*                       =====>   EL MDUL HI TORNA A DEIXAR 0 SI OK.
*                            1 = FI MEMBRE,
*                                (ENTRADA).
*                            2 = S'IGNOREN LES DADES PENDENTS, I ES
*                                DEMANA UN NOU MEMBRE DE LA MATEIXA DD,
*                                (ENTRADA).
*                                NECESSITA UNA LTIMA CRIDA AMB OPCI F
*                            3 = IGUAL QUE 1 PER NO FA EL 'CLOSE' NI
*                                ALLIBERA MEMORIA JA QUE ES GRAVEN
*                                MS MEMBRES DE LA MATEIXA 'DD',
*                                (SORTIDA O REEMPLAAR).
*                                NECESSITA UNA LTIMA CRIDA AMB OPCI F
*                            4 = IGUAL QUE 0 PER NO FA EL 'CLOSE' NI
*                                ALLIBERA MEMORIA JA QUE ES DEMANEN
*                                MS MEMBRES DE LA MATEIXA 'DD',
*                                (ENTRADA).
*                                NECESSITA UNA LTIMA CRIDA AMB OPCI F
*
*   LA SEQNCIA DE VALORS DEL CAMP DE COMUNICACI PODRIA SER:
*   LECTURA
*           >0>0>0<1>0...   INDICA FI DE MEMBRE, HA FET EL 'CLOSE' I HA
*                           ALLIBERAT MEMRIA.
*           >0>0>0>2>0...OPCI = F
*                           S'IGNOREN LES DADES PENDENTS I ES DEMANA UN
*                           NOU MEMBRE.
*           >4>4>4<1>4...OPCI = F
*                           INDICA FI DE MEMBRE NO FA NI EL 'CLOSE' NI
*                           ALLIBERA MEMRIA.
*   ESCRIPTURA
*           >0>0>0>1<0...>1 INDICA FI DE MEMBRE, FA EL 'CLOSE' I
*                           ALLIBERA MEMRIA.
*           >0>0>0>3<0...OPCI = F
*                           INDICA FI DE MEMBRE, NO FA EL 'CLOSE' NI
*                           ALLIBERA MEMRIA.
*
*   '>' VOL DIR DE INVOCANT A MDUL.
*   '<' VOL DIR DE MDUL A INVOCANT.
*       LA LTIMA INVOCACI AMB OPCI = F, S IMPRESCINDIBLE PER A
*       ALLIBERAR RECURSOS UTILITZATS QUAN ELS CODIS DE COMUNICACI
*       HAN ESTAT 2, 3 O 4.
*
*             CL256          I/O AREA.
*             CHAR(256)
*  2ON.
*    K008P2   DIFERENT PER A CADA MEMBRE I/O PDS A TRACTAR.
*
*             CL8            NOM DE LA DD.
*             CHAR(8)
*
*             CL8            NOM MEMBRE.
*             CHAR(8)
*
*             F              ADRECA DELS BUFFERS (RESERVAT PEL MODUL).
*             BIN FIXED(31)
*
*             CL1            OPCI DE PROCES.
*             CHAR(1)
*                            E = ENTRADA (LECTURA).
*                            S = SORTIDA (ESCRIPTURA)
*                                EL MEMBRE NO EXISTEIX.
*                            R = REEMPLACAR (ESCRIPTURA)
*                                EL MEMBRE EXISTEIX.
*                            D = ESBORRAR (ESCRIPTURA).
*                            C = CONSULTA (LECTURA).
*                            X = C + S O C + R.
*                                AQUESTA OPCI HA D'ANAR COMBINADA AMB
*                                CODI DE COMUNICACI 2 O 4.
*                            F = FI, ALLIBERAR RECURSOS PENDENTS AMB
*                                CODI DE COMUNICACI 2, 3 O 4.
*
*  3ER.
*    K008P3   IDENTIC PER A TOTS ELS MEMBRES I/O PDS A TRACTAR.
*
*             CL250          TREBALL MODUL.
*             CHAR(250)
***********************************************************************
         EJECT
STS008   CSECT
         HMINICI BASE=(10),AREA=8(0,1),TIPUS=L
         USING SAVEA,R13
         HMCONTR
         ST    R1,ADDRPARM             SALVA ADRECA PARAMETRES.
         TM    8(R1),X'80'             NUM. PARAMETRES CORRECTES ?
         BZ    STS08812                NO, ERROR 12.
         L     R2,4(R1)                2ON. PARAMETRE.
         CLI   16(R2),X'FF'
         BE    STS08001                NO ES EL 1ER. COP.
         LA    R0,LONGDECB             LONG. PER A LA GETMAIN.
         BAL   R14,STS08230            GETMAIN.
         ST    R1,16(R2)               ADRECA GETMAIN.
         LTR   R15,R15
         BNZ   STS08808                ERROR MACRO.
*
* ATENCI, EN AQUEST ERROR NO CAL FER CAP FREEMAIN, NI TE RES
*          ADREAT.   !!!!!!   28/2/98 FAURA
*          CAL REVISSAR-HO.
*
STS08001 EQU   *
         L     R11,16(R2)              ADRECA 1ER. GETMAIN.
         LA    R11,0(R11)              EL 1ER. BYTE = X'00'.
         USING IHADCB,R11              ADRECA DCB.
         L     R8,SAVER8               RESTAURA REG. 8.
         L     R9,SAVER9               RESTAURA REG. 9.
         ST    R2,ADDR2PAR             SALVA ADRECA 2ON. PARAMETRE.
         NI    FLAGEODA,X'00'
         NI    FLAGERRO,X'00'
         BAL   R14,STS08006            TRACTA 1ER. PARMETRE.
         L     R2,ADDR2PAR             RESTAURA ADREA 2ON. PARMETRE.
         LR    R3,R2                   PER SI VA A FINAL.
         TM    16(R2),X'FF'
         BO    STS08007                NO ES EL 1ER. COP.
         MVC   KNMDDR06,=CL8'@@@@@@@@' INICIALITZA CAMP.
         NI    FLAGINIC,X'00'          INICIALITZA CAMPS DSECT.
         XC    BLOKSI,BLOKSI
         XC    BLKSIMAX,BLKSIMAX
         XC    COUNT,COUNT
         BAL   R14,STS08260            OPEN.
         TM    FLAGERRO,X'FF'
         BO    STS08004
         LH    R0,BLKSIMAX             BLOCKSIZE.
         SLL   R0,1                    X 2.
         BAL   R14,STS08230            GETMAIN.
         LTR   R15,R15
         BZ    STS08005                OK.
STS08004 EQU   *
         LR    R4,R15                  SALVA CODI ERROR.
         L     R3,ADDR2PAR             RESTAURA ADRECA 2 PARAMETRE.
         B     STS08FI3                ERROR, NOMS 1 FREEMAIN.
STS08005 EQU   *
         ST    R1,ADDRBUF1             ADRECA BUFFER.
         LR    R8,R1                   ADRECA 1ER. BUFFER.
         LH    R3,BLKSIMAX             LONG. BUFFER 2ON. GETMAIN.
         LA    R1,0(R3,R1)             INICI 2ON. BUFFER.
         LR    R9,R1                   ADRECA 2ON. BUFFER.
         MVI   16(R2),X'FF'            INDICA DCB OBERTA.
         B     STS08007                <================== ULL.
STS08006 HMENTRAC DESC='TRACTAMENT 1ER. PARMETRE.'
         L     R1,ADDRPARM             RESTAURA ADRECA PARAMETRES.
         L     R2,0(R1)                1ER. PARAMETRE.
         USING PAR1,R2
         LA    R3,IOAREA
         ST    R3,ADDRIOAR             ADRECA I/O AREA.
         LA    R3,COMUNICA
         ST    R3,ADDRSITU             ADRECA SITUACIO.
         LA    R3,LONGUD
         ST    R3,ADDRLONG             ADRECA LONG. USER-DATA.
         LA    R3,USERD
         ST    R3,ADDRUSER             ADRECA USER-DATA.
         LA    R3,ERRCOM
         XC    0(2,R3),0(R3)           NETEJA ERROR COMPL. ANTERIOR.
         ST    R3,ADDRERRO             ADRECA CODI ERROR COMPLEMENTARI.
         LA    R3,DESCERR
         ST    R3,ADDRMISS             ADRECA MISSATGE.
         MVC   SITUACIO,COMUNICA       SITUACIO.
         LA    R3,CODRET
         ST    R3,ADDRCODR             ADRECA CODI RETORN.
         DROP  R2
STS080X6 HMSURTC
STS08007 HMNOM DESC='TRACTAMENT 2ON. PARAMETRE.'
         L     R1,ADDRPARM             RESTAURA ADRECA PARAMETRES.
         L     R2,4(R1)                2ON. PARAMETRE.
         MVC   OPCIO,20(R2)            OPCI.
         MVC   MEMBRE,8(R2)            NOM MEMBRE PDS.
         CLI   OPCIO,C'E'
         BE    STS08100                ENTRADA.
         CLI   OPCIO,C'S'
         BE    STS08150                SORTIDA (AFEGIR).
         CLI   OPCIO,C'R'
         BE    STS08150                SORTIDA (REEMPLACAR).
         CLI   OPCIO,C'D'
         BE    STS08200                ESBORRAR.
         CLI   OPCIO,C'C'
         BE    STS08210                CONSULTAR.
         CLI   OPCIO,C'X'
         BE    STS08210                CONSULTAR + ESCRIPTURA.
         CLI   OPCIO,C'F'
         BE    STS08FI2                ALLIBERAR RECURSOS.
STS08010 EQU   *
         OI    FLAGERRO,X'FF'
         B     STS08804                OPCI ERRONIA.
STS08100 HMNOM DESC='LECTURA (OPCIO = E).'
         CLI   SITUACIO,C'3'
         BE    STS08010                OPCI KO EN LECTURA.
         CLI   SITUACIO,C'1'
         BE    STS08FI                 FI TRACTAMENT.
         CLI   SITUACIO,C'2'
         BNE   STS08101                NO S EL MATEIX MEMBRE.
         TM    FLAGINIC,X'FF'
         BZ    STS0810B                ES LA 1A. VEGADA.
         NI    FLAGINIC,X'00'          INICIALITZA CAMPS DSECT.
         CHECK DECB
         TM    FLAGERRO,X'FF'
         LA    R15,8
         BO    STS08FI                 CLOSE I ALLIBERAR MEMORIA.
STS0810B EQU   *
         NI    FLAGEODA,X'00'
         NI    FLAGERRO,X'00'
         XC    BLOKSI,BLOKSI
         XC    COUNT,COUNT
         L     R8,ADDRBUF1             ADRECA 1R. BUFFER.
         LH    R3,BLKSIMAX             LONG. BUFFER 2ON. GETMAIN.
         LA    R9,0(R3,R8)             ADREA 2N. BUFFER.
STS08101 EQU   *
         TM    FLAGINIC,X'FF'
         BO    STS08104                NO ES EL 1ER. COP.
         BAL   R14,STS08320            BLDL - TRACTA DIRECTORI.
         TM    FLAGERRO,X'FF'
         BO    STS08FI                 ERROR.
         LTR   R15,R15                 CODI RETORN MACRO.
         BZ    STS08102
         LA    R2,500(0,R15)           ERROR MACRO BLDL.
         L     R1,ADDRERRO
         STH   R2,0(R1)                CODI ERROR COMPLEMENTARI.
         OI    FLAGERRO,X'FF'
         B     STS08808                MEMBRE INEXISTENT.
STS08102 EQU   *
         NI    DIRECTCC,X'1F'          LONG. MAX. MITGES PARAULES.
         SR    R0,R0
         IC    R0,DIRECTCC
         SLL   R0,1                    LONG. EN BYTES.
         L     R1,ADDRLONG
         STH   R0,0(R1)                LONG. USER-DATA.
         L     R1,ADDRUSER
         MVC   0(L'USDATA,R1),DIRECTUD USER-DATA.
         BAL   R14,STS08300            FIND.
         TM    FLAGERRO,X'FF'
         BO    STS08FI                 ERROR.
STS08104 EQU   *
         CLC   BLOKSI,COUNT
         BNE   STS08108                NO HA ACABAT EL BLOC.
         TM    FLAGINIC,X'FF'
         BZ    STS08105                ES LA 1A. VEGADA.
         XR    R8,R9                   BESCANVI DE CONTINGUT.
         XR    R9,R8
         XR    R8,R9
         B     STS08106
STS08105 EQU   *
         OI    FLAGINIC,X'FF'
         BAL   R14,STS08330            READ.
STS08106 EQU   *
         CHECK DECB
         TM    FLAGERRO,X'FF'          ACTIVAT PER LA SYNAD.
         LA    R15,8
         BO    STS08FI                 CLOSE I ALLIBERAR MEMORIA.
         XC    BLOKSI,BLOKSI           NETEJA COMPTADOR.
         LH    R6,BLKSIMAX             LONGITUD BLOC.
         L     R3,DECB+16              COUNT.
         SH    R6,14(R3)               DIFERENCIA DEL BLOC.
         STH   R6,COUNT
         XR    R8,R9                   BESCANVI DE CONTINGUT.
         XR    R9,R8
         XR    R8,R9
         BAL   R14,STS08330            READ.
         XR    R8,R9                   BESCANVI DE CONTINGUT.
         XR    R9,R8
         XR    R8,R9
STS08108 EQU   *
         LH    R1,BLOKSI               ESTAT ACTUAL COMPTADOR.
         LA    R2,0(R1,R8)             INICI SEGUENT REGISTRE.
         LH    R3,DCBLRECL             LONGITUD REGISTRE.
         L     R4,ADDRIOAR             ADRECA I/O AREA.
         LR    R5,R3
         MVCL  R4,R2                   MOU DADES A I/O AREA.
         LH    R3,DCBLRECL
         LA    R1,0(R3,R1)             SUMO EL LRECL AL COMPTADOR.
         STH   R1,BLOKSI               RESTAURO LONG. BUF. UTILITZADA.
         L     R1,ADDRSITU
         MVI   0(R1),C'0'
         ST    R8,SAVER8
         ST    R9,SAVER9
         B     STS08800
STS08150 HMNOM DESC='ESCRIPTURA (OPCI = S O R).'
         CLI   SITUACIO,C'0'
         BE    STS08153                NO ES FI DE MEMBRE.
         CLI   SITUACIO,C'2'
         BE    STS08010                OPCI KO EN ESCRIPTURA.
         CLI   SITUACIO,C'4'
         BE    STS08010                OPCI KO EN ESCRIPTURA.
         TM    FLAGINIC,X'FF'
         BNO   STS08151                ES EL 1ER. COP.
         CHECK DECB
         TM    FLAGERRO,X'FF'
         LA    R15,8
         BO    STS08FI                 ERROR INTERCEPTAT SYNAD O EXLST.
STS08151 EQU   *
         LH    R3,BLOKSI
         LTR   R3,R3                   TE QUELCOM PER A GRAVAR ?
         BZ    STS08152                NO.
         STH   R3,DCBBLKSI             NOVA LONGITUD DEL BLOC.
         BAL   R14,STS08340            WRITE.
         CHECK DECB
         MVC   DCBBLKSI,BLKSIMAX       RESTAURA LONGITUT BLOC.
         TM    FLAGERRO,X'FF'
         LA    R15,8
         BO    STS08FI                 ERROR INTERCEPTAT SYNAD O EXLST.
STS08152 EQU   *
         NOTE  ((11))
         ST    R1,MEMBREST+8           TTR DEL MEMBRE.
         L     R1,ADDRLONG             ADRECA LONG. USER-DATA.
         LH    R1,0(R1)                LONGITUD USER-DATA.
         SRL   R1,1                    DIVIDEIXO PER 2.
         STC   R1,LUD                  LONGITUD USER-DATA.
         L     R1,ADDRUSER             ADRECA USER-DATA.
         MVC   USDATA,0(R1)            USER-DATA.
         BAL   R14,STS08305            STOW.
         B     STS08FI
STS08153 EQU   *
         TM    FLAGINIC,X'F0'
         BO    STS08154                NO ES EL 1ER. COP.
         OI    FLAGINIC,X'F0'
STS08154 EQU   *
         LH    R1,BLOKSI               ESTAT ACTUAL DEL COMPTADOR.
         LA    R2,0(R1,R8)             INICI SEGUENT REGISTRE.
         LH    R3,DCBLRECL             LONGITUD REGISTRE.
         L     R4,ADDRIOAR             I/O AREA.
         LR    R5,R3
         MVCL  R2,R4                   MOC A BUFFER.
         LH    R3,DCBLRECL
         LA    R1,0(R3,R1)             SUMO EL LRECL AL COMPTADOR.
         CH    R1,BLKSIMAX             MIRO SI ESTA PLE.
         BE    STS08155
         STH   R1,BLOKSI               RESTAURO LONG. BUF. UTILITZAT.
         L     R1,ADDRSITU
         MVI   0(R1),C'0'              SITUACIO=0.
         B     STS08159
STS08155 EQU   *
         TM    FLAGINIC,X'FF'
         BNO   STS08156                ES EL 1ER. WRITE.
         CHECK DECB
         TM    FLAGERRO,X'FF'
         LA    R15,8
         BO    STS08FI                 ERROR INTERCEPTAT SYNAD O EXLST.
STS08156 EQU   *
         OI    FLAGINIC,X'FF'
         BAL   R14,STS08340            WRITE.
         XR    R8,R9                   BESCANVI DE CONTINGUT.
         XR    R9,R8
         XR    R8,R9
         XC    BLOKSI,BLOKSI           NETEJA COMPTADOR.
STS08159 EQU  *
         ST    R8,SAVER8
         ST    R9,SAVER9
         B     STS08800
STS08200 HMNOM DESC='ESBORRA (OPCI D).'
         BAL   R14,STS08305            STOW.
         B     STS08FI
STS08210 HMNOM DESC='CONSULTA (OPCI C).'
         CLI   OPCIO,C'X'
         BNE   STS08212
         ST    R8,SAVER8
         ST    R9,SAVER9
         NI    FLAGINIC,X'00'          1A. VEGADA.
         XC    BLOKSI,BLOKSI
STS08212 EQU   *
         BAL   R14,STS08320            BLDL.
         TM    FLAGERRO,X'FF'
         BO    STS08FI                 ERROR.
         LTR   R15,R15
         BNZ   STS08213                KO.
         NI    DIRECTCC,X'1F'          LONG. MAXIMA (MITGES PARAULES).
         SR    R0,R0
         IC    R0,DIRECTCC
         SLL   R0,1                    LONG. EN BYTES.
         L     R1,ADDRLONG
         STH   R0,0(R1)
         L     R1,ADDRUSER
         MVC   0(L'USDATA,R1),DIRECTUD USER-DATA.
         B     STS08FI
STS08213 EQU   *
         LA    R15,500(R0,R15)         EL MEMBRE NO HI ES.
         L     R1,ADDRERRO
         STH   R15,0(R1)               CODI ERROR COMPLEMENTARI.
         OI    FLAGERRO,X'FF'          ERROR.
         B     STS08808
STS08230 HMENTRAC DESC='GETMAIN'
         GETMAIN RC,LV=(R0)
         LTR   R15,R15
         BZ    STS08231                OK.
         L     R1,ADDRERRO
         LA    R15,700(R0,R15)         ERROR GETMAIN.
         STH   R15,0(R1)               A ERROR COMPLEMENTARI.
STS08231 HMSURTC
STS08255 HMENTRAC DESC='FREEMAIN'
         L     R14,ADDRERRO            28/2/98  FAURA
         FREEMAIN RC,LV=(R0),A=(R1)
         LTR   R15,R15
         BZ    STS08256                OK.
         LA    R15,600(R0,R15)         ERROR FREEMAIN.
         STH   R15,0(R14)              A ERROR COMPLEMENTARI.
         LA    R15,8                   ERROR.
STS08256 HMSURTC
STS08260 HMENTRAC DESC='OPEN'
         OI    LISTOPEN,X'80'          INICIALITZA LLISTA OPEN.
         MVC   IHADCB(LONGDCB),PODCB   INICIALITZO DCB-DSECT.
         MVC   DCBDDNAM,0(R2)          NOM DD.
         CLI   20(R2),C'D'
         BE    STS08263                OPEN OUTPUT.
         CLI   20(R2),C'S'
         BE    STS08263                OPEN OUTPUT.
         CLI   20(R2),C'R'
         BE    STS08263                OPEN OUTPUT.
         CLI   20(R2),C'E'
         BE    STS08262                OPEN INPUT.
         CLI   20(R2),C'C'
         BE    STS08262
         CLI   20(R2),C'X'
         BE    STS08263                OPEN OUTPUT.
         LA    R15,4                   OPCI ERRONIA.
         OI    FLAGERRO,X'FF'          ERROR.
         B     STS08266
STS08262 EQU   *
         OPEN  (IHADCB,(INPUT)),MF=(E,LISTOPEN)
         B     STS08264                TRACTA ERRORS.
STS08263 EQU   *
         BAL   R14,XENCUA
         TM    FLAGERRO,X'FF'
         BO    STS08266                ERROR STSR06, ACABA.
         OPEN  (IHADCB,(OUTPUT)),MF=(E,LISTOPEN)
STS08264 EQU   *
         TM    DCBOFLGS,X'10'
         BO    STS08265                OK.
         L     R1,ADDRERRO
         OI    FLAGERRO,X'FF'          ERROR.
         STH   R15,0(R1)               A ERROR COMPLEMENTARI.
STS08265 EQU   *
         MVC   BLKSIMAX,DCBBLKSI       SALVO BLOKSIZE.
STS08266 HMSURTC
STS08300 HMENTRAC DESC='FIND'
         LA    R0,DIRECTN1             TTRKZ DE LA LLISTA DE BLDL.
         FIND  (11),(0),C              EN EL REG.11 HI HA LA DCB.
         LTR   R15,R15
         BZ    STS08302                OK.
         L     R1,ADDRERRO
         LA    R15,100(R0,R15)         ERROR FIND.
         STH   R15,0(R1)               A ERROR COMPLEMENTARI.
         OI    FLAGERRO,X'FF'          ERROR.
STS08302 HMSURTC
STS08305 HMENTRAC DESC='STOW'
         MVC   MEMBREST(L'MEMBRE),MEMBRE
         CLI   OPCIO,C'D'
         BNE   STS08306                NO ES ESBORRAR.
         STOW  (11),MEMBREST,D ESBORRAR.
         B     STS08308                TRACTA ERRORS.
STS08306 EQU   *
         CLI   OPCIO,C'S'
         BNE   STS08307                ES REEMPLACAR.
         STOW  (11),MEMBREST,A         AFEGIR.
         B     STS08308                TRACTA ERRORS.
STS08307 EQU   *
         STOW  (11),MEMBREST,R REEMPLACAR.
STS08308 EQU   *
         LTR   R15,R15
         BZ    STS08309                OK.
         L     R1,ADDRERRO
         LA    R15,200(R0,R15)         ERROR STOW.
         STH   R15,0(R1)               A ERROR COMPLEMENTARI.
         OI    FLAGERRO,X'FF'          ERROR.
         LA    R15,8
STS08309 HMSURTC
STS08320 HMENTRAC DESC='BLDL'
         MVC   DIRECTFF,=H'1'          NUM. D'ENTRIES DE LA LLISTA.
         MVC   DIRECTLL,=H'76'         LONG. DE CADA ENTRY.
         MVC   DIRECTNM,MEMBRE         NOM MEMBRE.
         BLDL  (11),DIRECT             A REG.11 LA DCB.
         LTR   R15,R15
         BZ    STS08322                OK.
         C     R15,=F'4'               ES ERROR MACRO BLDL ?
         BNH   STS08322                NO ES ERROR.
         L     R1,ADDRERRO
         LA    R15,500(R0,R15)         ERROR BLDL.
         STH   R15,0(R1)               A ERROR COMPLEMENTARI.
         OI    FLAGERRO,X'FF'          ERROR.
         LA    R15,8
STS08322 HMSURTC
STS08330 HMENTRAC DESC='READ'
         READ  DECB,SF,(11),(8),'S',,,MF=E
         HMSURTC
STS08340 HMENTRAC DESC='WRITE'
         WRITE DECB,SF,(11),(8),'S',,,MF=E
         HMSURTC
XENCUA   HMENTRAC DESC='ENCUAMENT DDNAME'
         MVC   KNMDDR06,DCBDDNAM
         XC    KRETR06,KRETR06
         MVI   KOPER06,C'E'
         MVI   KTIPR06,C'E'
         LA    R1,L'KPAR2_STSR06
         LA    R14,KPAR2_STSR06
XENCUA01 EQU   *
         MVI   0(R14),X'00'
         LA    R14,1(0,R14)
         BCT   R1,XENCUA01
         LA    R1,STSR06LS
         LA    R14,KPAR1_STSR06
         ST    R14,0(R1)
         LA    R14,KPAR2_STSR06
         ST    R14,4(R1)
         OI    4(R1),X'80'
         L     R15,=V(STSR06)
         BASSM R14,R15
*        CALL STSR06,(KPAR1_STSR06,KPAR2_STSR06),VL,MF=(E,STSR06LS)
         LTR   R15,R15
         BZ    XENCUAFI                OK.
         L     R1,ADDRERRO
         LA    R15,800(R0,R15)         ERROR BLDL.
         STH   R15,0(R1)               A ERROR COMPLEMENTARI.
         OI    FLAGERRO,X'FF'          ERROR.
         LA    R15,8
XENCUAFI HMSURTC
XALLIBERA HMENTRAC DESC='ALLIBERA DDNAME'
         XC    KRETR06,KRETR06
         MVI   KOPER06,C'D'
         LA    R1,STSR06LS
*        L     R15,ADR_STSR06
         L     R15,=V(STSR06)
         BASSM R14,R15
         LTR   R15,R15
         BZ    XALLIBERAFI             OK.
         L     R1,ADDRERRO
         LA    R15,800(R0,R15)         ERROR BLDL.
         STH   R15,0(R1)               A ERROR COMPLEMENTARI.
         OI    FLAGERRO,X'FF'          ERROR.
         LA    R15,8
XALLIBERAFI HMSURTC
STS08400 HMNOM DESC='EODAD.'
         L     R1,ADDRSITU             ADRECA SITUACIO.
         MVI   0(R1),C'1'              FI DE MEMBRE.
         OI    FLAGEODA,X'FF'
         B     STS08FI                 OK.
STS08410 HMNOM DESC='SYNAD.'
         SYNADAF ACSMETH=BPAM
         L     R2,ADDRMISS             ADRECA CAMP DESCRIPTOR ERROR.
         MVC   0(22,R2),84(R1)         DESCRIPTOR DEL ERROR.
         L     R1,ADDRERRO             ADRECA CAMP ERROR COMPLEMENTARI.
         LA    R2,300                  CODI ERROR SYNAD.
         STH   R2,0(R1)
         OI    FLAGERRO,X'FF'          ERROR.
         SYNADRLS
STS08800 HMNOM DESC='FI CORRECTE.'
         L     R1,ADDRPARM             RESTAURA ADRECA PARAMETRES.
         LA    R15,0                   FI CORRECTE.
         B     STS08FI4
STS08804 HMNOM DESC='ERROR=4, OPCI ERRONIA.'
         L     R1,ADDRPARM             RESTAURA ADRECA PARAMETRES.
         LA    R15,4
         B     STS08FI
STS08808 HMNOM DESC='ERROR=8, ERROR A CAMP COMPLEMENTARI.'
         L     R1,ADDRPARM             RESTAURA ADRECA PARAMETRES.
         LA    R15,8
         B     STS08FI
STS08812 HMNOM DESC='ERROR=12, NUM. PARAM. ERRONI'
         L     R1,ADDRPARM             RESTAURA ADRECA PARAMETRES.
         LA    R15,12                  NUM. PARAMETRES ERRONI.
         B     STS08FI4
STS08FI  HMNOM DESC='FI DE TRACTAMENT.'
         SR    R4,R4
         TM    FLAGERRO,X'FF'
         BZ    STS08FI1                NO VE D'ERROR.
         C     R2,=F'300'              ERROR SYNAD ?
         BNE   STS08FI0                NO.
         LA    R15,8
STS08FI0 EQU   *
         LR    R4,R15                  SALVA CODI ERROR.
STS08FI1 EQU   *
         L     R3,ADDR2PAR
         CLI   SITUACIO,C'2'
         BL    STS08FI2                S '0' O '1'.
         BH    STS08FIX                S '3' O '4'.
         TM    FLAGERRO,X'FF'          S SITUACI = 2, I
         BO    STS08FIX                VE D'ERROR, ACABA.
         NI    FLAGINIC,X'00'          S SITUACI = 2 OK,
         B     STS0810B                IGNORA DADES PENDENTS.
STS08FI2 EQU   *
         OI    LISTOPEN,X'80'
         CLOSE ((11)),MF=(E,LISTOPEN)  DCB A REG.11.
         CLC   KNMDDR06,=CL8'@@@@@@@@'  HA FET ENCUAMENT ?
         BE    STS08FIA                NO.
         BAL   R14,XALLIBERA
*        TM    FLAGERRO,X'FF'
*        BO    STS08???                ERROR STSR06, ?????.
STS08FIA EQU   *
         NI    16(R3),X'00'            RESET FLAG 1ER. COP.
         LH    R0,BLKSIMAX             LONGITUD 2ON. GETMAIN.
         SLL   R0,1                    X 2.
         L     R1,ADDRBUF1             ADRECA 2ON. GETMAIN.
         BAL   R14,STS08255            FREEMAIN.
STS08FIX EQU   *
         TM    FLAGEODA,X'FF'
         BO    STS08FI3                VE DE FI DADES (SITUACIO=1).
         L     R1,ADDRSITU
         MVI   0(R1),C'0'              SITUACIO=0.
STS08FI3 EQU   *
         CLI   OPCIO,C'F'
         BE    STS08FIY                ALLIBERAR RECURSOS.
         CLI   SITUACIO,C'2'
         BNL   STS08FIZ
STS08FIY EQU   *                       S '0' O '1'.
         LA    R0,LONGDECB             LONGITUD 1ER. GETMAIN.
         L     R1,16(R3)               ADRECA 1ER. GETMAIN.
         BAL   R14,STS08255            FREEMAIN.
         B     STS08FIW
STS08FIZ EQU   *                       S '2', '3' O '4'.
         NI    FLAGEODA,X'00'          NETEJA BUFFERS I PUNTERS.
         NI    FLAGERRO,X'00'
         XC    BLOKSI,BLOKSI
         XC    COUNT,COUNT
         L     R8,ADDRBUF1             ADRECA 1R. BUFFER.
         LH    R3,BLKSIMAX             LONG. BUFFER 2ON. GETMAIN.
         LA    R9,0(R3,R8)             ADREA 2N. BUFFER.
STS08FIW EQU   *
         LR    R15,R4                  RESTAURA CODI RETORN MODUL.
         L     R1,ADDRPARM             RESTAURA ADRECA PARAMETRES.
STS08FI4 EQU   *
         L     R1,0(R1)                1ER. PARAMETRE.
         USING PAR1,R1
GENDESC  HMNOM DESC='GENERAR LA DESCRIPCI DELS ERRORS.'
         CH    R15,=H'0'
         BNE   NO0
         MVC   DESCERR,=C'OK                    '
         B     STS08FI5
NO0      CH    R15,=H'4'
         BNE   NO4
         MVC   DESCERR,=C'OPCI ERRNIA         '
         B     STS08FI5
NO4      CH    R15,=H'8'
         BNE   NO8
         CLC   ERRCOM,=H'4'
         BNE   NO8004
         MVC   DESCERR,=C'OPEN-ERROR LLEU       '
         B     STS08FI5
NO8004   CLC   ERRCOM,=H'8'
         BNE   NO8008
         MVC   DESCERR,=C'OPEN-ERROR GREU       '
         B     STS08FI5
NO8008   CLC   ERRCOM,=H'99'
         BH    NOENOPEN
         MVC   DESCERR,=C'OPEN-                 '
         B     STS08FI5
NOENOPEN CLC   ERRCOM,=H'104'
         BNE   NO8104
         MVC   DESCERR,=C'FIND-MEMBRE INEXISTENT'
         B     STS08FI5
NO8104   CLC   ERRCOM,=H'108'
         BNE   NO8108
         MVC   DESCERR,=C'FIND-ERROR I/O EN DIR.'
         B     STS08FI5
NO8108   CLC   ERRCOM,=H'199'
         BH    NOENFIND
         MVC   DESCERR,=C'FIND-                 '
         B     STS08FI5
NOENFIND CLC   ERRCOM,=H'204'
         BNE   NO8204
         MVC   DESCERR,=C'FIND-MEMBRE DUPLICAT  '
         B     STS08FI5
NO8204   CLC   ERRCOM,=H'208'
         BNE   NO8208
         MVC   DESCERR,=C'STOW-MEMBRE INEXISTENT'
         B     STS08FI5
NO8208   CLC   ERRCOM,=H'212'
         BNE   NO8212
         MVC   DESCERR,=C'STOW-DIRECTORI PLE    '
         B     STS08FI5
NO8212   CLC   ERRCOM,=H'216'
         BNE   NO8216
         MVC   DESCERR,=C'STOW-ERROR I/O        '
         B     STS08FI5
NO8216   CLC   ERRCOM,=H'220'
         BNE   NO8220
         MVC   DESCERR,=C'STOW-LLIB.OBERTA LECT.'
         B     STS08FI5
NO8220   CLC   ERRCOM,=H'224'
         BNE   NO8224
         MVC   DESCERR,=C'STOW-MEMRIA INSUFIC. '
         B     STS08FI5
NO8224   CLC   ERRCOM,=H'299'
         BH    NOENSTOW
         MVC   DESCERR,=C'STOW-                 '
         B     STS08FI5
NOENSTOW CLC   ERRCOM,=H'399'
         BH    NOENSYNA
         B     STS08FI5
NOENSYNA CLC   ERRCOM,=H'499'
         BH    NOENEXLS
         B     STS08FI5
NOENEXLS CLC   ERRCOM,=H'504'
         BNE   NO8504
         MVC   DESCERR,=C'BLDL-MEMBRE INEXISTENT'
         B     STS08FI5
NO8504   CLC   ERRCOM,=H'508'
         BNE   NO8508
         MVC   DESCERR,=C'BLDL-ERROR I/O EN DIR.'
         B     STS08FI5
NO8508   CLC   ERRCOM,=H'599'
         BH    NOENBLDL
         MVC   DESCERR,=C'BLDL-                 '
         B     STS08FI5
NOENBLDL CLC   ERRCOM,=H'699'
         BH    NOENFREE
         MVC   DESCERR,=C'FREEMAIN-             '
         B     STS08FI5
NOENFREE CLC   ERRCOM,=H'799'
         BH    NOENGET
         MVC   DESCERR,=C'GETMAIN-              '
         B     STS08FI5
NOENGET  EQU   *
         B     STS08FI5
NO8      CH    R15,=H'12'
         BNE   NO12
         MVC   DESCERR,=C'NOMBRE PARMS. ERRONI '
         B     STS08FI5
NO12     EQU   *
STS08FI5 EQU   *
         STH   R15,CODRET              CODI RETORN.
         L     R13,4(R13)
         RETURN (14,12),RC=(15)
         EJECT
PODCB    DCB   DSORG=PO,MACRF=(R,W),SYNAD=STS08410,EXLST=EXLST,        X
               EODAD=STS08400
LONGDCB  EQU   *-PODCB
EXLST    HMNOM DESC='EXIT LIST.'
         DC    AL1(145)                DCB ABEND EXIT ACTIVA(X'11+80').
         DC    AL3(STS08500)           ADRECA RUTINA TRACTA ABEND.
         EJECT
         DCBD  DSORG=(PO)
         EJECT
LISTREAD READ  DECB,SF,PODCB,ADDRBUF1,'S',,,MF=L
LISTOPEN OPEN  (PODCB,(INPUT)),MF=L
STS19LST CALL ,(STS19PA1,STS19PA2,STS19PA3,STS19PA4),VL,MF=L
STS19PA1 DS    F                       LONGITUD EN BYTES A CONVERTIR.
STS19PA2 DS    CL3                     CAMP A CONVERTIR.
STS19PA3 DS    CL6                     CAMP CONVERTIT.
STS19PA4 DS    CL80                    TREBALL MODUL.
STSR06LS CALL ,(KPAR1_STSR06,KPAR2_STSR06),VL,MF=L
         EJECT
         DS    0F
ADDRIOAR DS    F                       ADRECA I/O AREA.
ADDRERRO DS    F                       ADRECA ERROR COMPLEMENTARI.
ADDRMISS DS    F                       ADRECA DESCRIPTOR ERROR.
ADDRLONG DS    F                       ADRECA LONG. USER DATA.
ADDRUSER DS    F                       ADRECA USER DATA.
ADDRCODR DS    F                       ADRECA CODI RETORN.
ADDRSITU DS    F                       ADRECA SITUACIO.
ADDR2PAR DS    F                       ADRECA 2ON. PARAMETRE REBUT.
ADDRBUF1 DS    F                       ADRECA BUFFERS.
SAVER8   DS    F
SAVER9   DS    F
MEMBRE   DS    CL8                     NOM MEMBRE A TRACTAR.
SITUACIO DS    CL1                     SITUACIO MEMBRE.
OPCIO    DS    CL1                     OPCI PROCES.
         DS    0H
DIRECT   DS    0CL80                   DIRECTORI PARTICIONAT.
DIRECTFF DS    H                       NUM.ENTRIES DE LA LLISTA (BLDL).
DIRECTLL DS    H                       LONG. DE CADA ENTRY EN BYTES.
DIRECTNM DS    CL8                     NOM MEMBRE.
DIRECTN1 DS    CL5                     TTRKZ.
DIRECTCC DS    BL1                     LONG. USER-DATA EN H-WORDS.
DIRECTUD DS    CL62                    USER DATA.
         DS    0H
DIRECTOU DS    0CL74                   MACRO STOW.
MEMBREST DS    0CL12
MEMBREN  DS    CL8                     MEMBRE.
DOUTTR   DS    CL3
LUD      DS    CL1                     LONG. USER-DATA.
USDATA   DS    CL62                    USER-DATA.
         SPACE 2
FLAGERRO DS    XL1                     INDICADOR ERROR=X'FF'.
FLAGINIC DS    XL1                     INDICADOR 1ER.COP=X'FF'.
FLAGEODA DS    XL1                     INDICADOR FI DADES=X'FF'.
BLKSIMAX DS    H                       BLOCKSIZE DCB ACTUAL.
BLOKSI   DS    H                       ESTAT ACTUAL BLOC.
COUNT    DS    H                       NUM. REGISTRES PER A FI DE BLOC.
         SPACE 2
         HMSTS054
LONGDECB EQU   *-IHADCB
         EJECT
SAVEA    DSECT
         DS   9D                       SAVE-AREA STANDARD.
         HMSTACK
ADDRPARM DS    F                       ADRECA PARAMETRES.
LSS      EQU   *-SAVEA                 MX. X'FA' (250).
         EJECT
PAR1     DSECT
ERRCOM   DS    H                       CODI ERROR.
DESCERR  DS    CL22                    DESCRIPCIO DEL ERROR.
LONGUD   DS    H                       LONG. USER-DATA.
USERD    DS    CL62                    USER-DATA.
DESPCOD  EQU   *-ERRCOM
CODRET   DS    H                       CODI RETORN.
COMUNICA DS    CL1                     SITUACIO.
IOAREA   DS    CL256
         EJECT
STS08500 CSECT
         USING STS08500,R7
         LR    R7,R15
         TM    3(R1),X'04'             INSPECCIO BIT.5, OPION-MASK.
         BO    STS08501
         NI    3(R1),X'00'             RESET OPTION-MASK, ABEND.
         B     STS08502                A FI.
STS08501 EQU   *
         MVI   3(R1),X'04'             IGNORA ABEND.
         MVC   STS19PA2,0(R1)          CODI ABEND.
         MVC   STS19PA1,=F'3'          LONGITUD CODI A CONVERTIR.
         L     R4,ADDRMISS
         LR    R3,R14                  SALVO ADRECA RETORN.
         LA    R0,72                   LONGITUD SAVE.
         GETMAIN R,LV=(0)
         LR    R13,R1                  ADRECA SAVE-EXLST.
 CALL STS019,(STS19PA1,STS19PA2,STS19PA3,STS19PA4),VL,MF=(E,STS19LST)
         LR    R14,R3                  RESTAURA ADRECA RETORN.
         MVC   0(L'STS19PA3,R4),STS19PA3
         MVI   3(R4),C'-'
         L     R1,ADDRERRO             ADRECA CAMP ERROR COMPLEMENTARI.
         LA    R2,400                  ERROR EXLST.
         STH   R2,0(R1)
STS08502 EQU   *
         OI    FLAGERRO,X'FF'
         BR    R14
         END
