*PROCESS OF,M,MAP,MAR(2,72),SYN,RULES(LAXCTL),FLAG(I),NNUM,OP,S,EXIT;
*PROCESS LIMITS(FIXEDDEC(15,31));
*PROCESS DFT(REORDER OVERLAP LINKAGE(SYSTEM)),NOREDUCE,NOWRITABLE;
*PROCESS OPT(0),PREFIX(SIZE,STRINGRANGE SUBSCRIPTRANGE),MAXMSG(W 250);
*PROCESS A(F),X(F),STG,NEST,SYSTEM(CICS),DEFAULT(NONASGN);
*PROCESS A(F),X(F),EXTRN(FULL),STG,NEST,SYSTEM(CICS);
*PROCESS MAXMSG(250);
 ARQ991  : /* INTERFASE PER TRANSACCIONS ARQUITECTURA  */
         PROCEDURE OPTIONS(MAIN);
 /* VSI CATALS = U, PROG. O RUTINA CICS, PL/I */
 DCL 1 @CTL ABNORMAL STATIC,
     2 @CTL1 CHAR(31) INIT('*VSI*VSTSJOS*18/05/15*18.41.31*'),
     2 @CTL2 CHAR(70) INIT(
 'SYS3.VEXG.SOURLIB(CPARQ991)                                          '
 );
 DCL 1 @CTLC ABNORMAL STATIC,
     2 @CTL1C CHAR(31) INIT(''),
     2 @CTL2C CHAR(70) INIT('');
 /* VSI * MODULO PRIVILEGIADO */
 %DCL @PARMVSI_ESPC CHAR;
 %DCL @PARMVSI_CHECK CHAR;
 %DCL @PARMVSI_NIVELL CHAR;
 %DCL @PARMVSI_LINK CHAR;
 %DCL @PARMVSI_CLASS CHAR;
 %DCL @PARMVSI_YTMOD CHAR;
 %DCL @PARMVSI_YESBO CHAR;
 %DCL @PARMVSI_YENTR CHAR;
 %DCL @PARMVSI_YCLI CHAR;
 %DCL @PARMVSI_ACCPROJ CHAR;
 %DCL @PARMVSI_ACCUSER CHAR;
 %DCL @PARMVSI_ACCOPER CHAR;
 %DCL @CATALS_OPCIO CHAR;
 %DCL @CATALS_NOMPGM CHAR;
 %DCL @CATALS_NPARAM CHAR;
 %DCL @FCATALS_LANG CHAR;
 %DCL @FCATALS_CICS CHAR;
 %DCL @FCATALS_DATES CHAR;
 %DCL @FCATALS_DB2 CHAR;
 %DCL @FCATALS_IMS CHAR;
 %DCL @FCATALS_INTERFACE CHAR;
 %DCL @FCATALS_COMU CHAR;
 %DCL @FCATALS_COMMANDS CHAR;
 %DCL @FCATALS_COMMITS CHAR;
 %DCL @FCATALS_FETCH CHAR;
 %DCL @FCATALS_TIPUS CHAR;
 %DCL @FCATALS_PROC CHAR;
 %DCL @FCATALS_PROC_D CHAR;
 %DCL @VSIVRM CHAR;
 %@FCATALS_LANG   = 'PLI';
 %@FCATALS_CICS   = 'S';
 %@FCATALS_DATES  = 'S';
 %@FCATALS_DB2    = 'N';
 %@FCATALS_IMS    = 'N';
 %@FCATALS_COMU   = 'N';
 %@FCATALS_TIPUS  = 'X';
 %@FCATALS_FETCH  = 'N';
 %@FCATALS_PROC   = 'HOSTS082';
 %@VSIVRM         = 'P15MAR30';
 %@FCATALS_COMMANDS  = 'S';
 %@FCATALS_COMMITS  = 'N';
 %@FCATALS_PROC_D    = 'HOSTS083';
 %@FCATALS_INTERFACE = 'N';
 %@PARMVSI_ESPC   = 'R';
 %@PARMVSI_CHECK  = 'C';
 %@PARMVSI_NIVELL = '4';
 %@PARMVSI_LINK   = '9';
 %@PARMVSI_CLASS  = 'W';
 %@PARMVSI_YTMOD  = 'P';
 %@PARMVSI_YESBO  = 'E';
 %@PARMVSI_YENTR  = 'C';
 %@PARMVSI_YCLI   = 'V';
 %@PARMVSI_ACCUSER= '4V602030';
 %@PARMVSI_ACCOPER= 'WSVB06C0';
 %@PARMVSI_ACCPROJ= 'CPARQ991';
 %@CATALS_OPCIO   = 'U';
 %@CATALS_NOMPGM  = 'ARQ991';
 %@CATALS_NPARAM  = '  ';
 /* MODEL TRANSACCIONAL = REDUIDA */
 DCL 1 KR4609 UNAL,                                       /************/
         2 WEBADR         PTR              ,              /*ADRECA CAM*/
                                                          /*P SENYALAT*/
         2 ATTCMP         CHAR(1)          INIT(''),      /*ATRIBUT DE*/
                                                          /*L CAMP    */
         2 FILL01         CHAR(192)        INIT('');      /*RESTO REGI*/
                                                          /*STRO      */
 DCL 1 @@WEBVIEW,                                                       0001000
     2 @@PROTEGIT   CHAR(1) INIT('P'), /* PROTEGIT      */              0002000
     2 @@NOPROTEGIT CHAR(1) INIT('E'), /* ENTRADA       */              0002010
     2 @@AMAGAT     CHAR(1) INIT('A'), /* AMAGAT        */              0002100
     2 @@NOAMAGAT   CHAR(1) INIT('V'); /* VISIBLE       */              0002110
 DCL @@PTRWEB PTR BASED(ADDR(KR1540.ADRCHR));                           0002300
 DCL 1 WW0001 UNAL,                                       /************/
         2 OPCIO1         CHAR(1)          INIT(' '),     /*OPCIO1    */
         2 OPCIO2         CHAR(1)          INIT(' '),     /*OPCIO2    */
         2 RESPOS         CHAR(8)          INIT(' ');     /*TEXTMSG   */
 DCL 1 WW0001@@ UNAL,                                     /************/
         2 OPCIO1@@       CHAR(080),                      /*OPCIO1    */
         2 OPCIO2@@       CHAR(080),                      /*OPCIO2    */
         2 RESPOS@@       CHAR(080);                      /*TEXTMSG   */
 WW0001@@.OPCIO1@@='WW0001.opcio1';
 WW0001@@.OPCIO2@@='WW0001.opcio2';
 WW0001@@.RESPOS@@='WW0001.respos';
 DCL 1 WW0011 UNAL,                                       /************/
         2 OPCIO1         CHAR(1)          INIT(' '),     /*OPCIO1    */
         2 OPCIO2         CHAR(1)          INIT(' '),     /*OPCIO2    */
         2 RESPOS         CHAR(8)          INIT(' ');     /*TEXTMSG   */
 DCL 1 WW0011@@ UNAL,                                     /************/
         2 OPCIO1@@       CHAR(080),                      /*OPCIO1    */
         2 OPCIO2@@       CHAR(080),                      /*OPCIO2    */
         2 RESPOS@@       CHAR(080);                      /*TEXTMSG   */
 WW0011@@.OPCIO1@@='WW0011.opcio1';
 WW0011@@.OPCIO2@@='WW0011.opcio2';
 WW0011@@.RESPOS@@='WW0011.respos';
 DCL 1 KR1540 UNAL,                                       /************/
         2 SAREA          CHAR(3)          INIT(''),      /*AREA V.S.I*/
         2 PGMERR         PIC'(3)9'        INIT(0),       /*CODIGO ERR*/
                                                          /*OR DEL PRO*/
                                                          /*GRAMA     */
         2 PGMORG         CHAR(8)          INIT(''),      /*NOMBRE DEL*/
                                                          /* PROGRAMA */
         2 PGMACC         CHAR(8)          INIT(''),      /*ACCION DEL*/
                                                          /* ERROR    */
         2 NUMMSG         PIC'(4)9'        INIT(0),       /*CODIGO MEN*/
                                                          /*SAGE EN F0*/
                                                          /*145       */
         2 OPCERR         CHAR(1)          INIT(''),      /*OPCION    */
         2 PGMVAL         CHAR(15)         INIT(''),      /*VALOR QUE */
                                                          /*PRODUCE EL*/
                                                          /* MSG      */
         2 ENTINF,                                        /*          */
           3 CIA          CHAR(1)          INIT(''),      /*COMPAIA  */
           3 YRAMEX       CHAR(2)          INIT(''),      /*RAMO      */
           3 POLIZA       PIC'(9)9'        INIT(0),       /*POLIZA    */
           3 NUMREC       PIC'(9)9'        INIT(0),       /*NUMERO DE */
                                                          /*RECIBO    */
           3 NUMRIN       CHAR(1)          INIT(''),      /*NUMERO DE */
                                                          /*RECIBO    */
           3 NUMSIN       PIC'(9)9'        INIT(0),       /*NUMERO DE */
                                                          /*SINIESTRO */
           3 CLIDPD       PIC'(9)9'        INIT(0),       /*CODIGO TOM*/
                                                          /*ADOR      */
           3 DNICLI       CHAR(9)          INIT(''),      /*DNI O NIF */
                                                          /*TOMADOR   */
           3 YASEG        PIC'(9)9'        INIT(0),       /*CODIGO ASE*/
                                                          /*GURADO    */
           3 DNI          CHAR(9)          INIT(''),      /*DNI O NIF */
                                                          /*TOMADOR   */
           3 NUMIAG       PIC'(5)9'        INIT(0),       /*NUMERO AGE*/
                                                          /*NTE INTERN*/
                                                          /*O         */
           3 NUMAG        PIC'(5)9'        INIT(0),       /*NUMERO AGE*/
                                                          /*NTE EXTERN*/
                                                          /*O         */
           3 NUMTAR       PIC'(8)9'        INIT(0),       /*NUMERO TAR*/
                                                          /*GETA SALUD*/
           3 CHEDIG       PIC'9'           INIT(0),       /*DIGIT CONT*/
                                                          /*ROL TARGET*/
                                                          /*A         */
           3 NUMPRO       PIC'(9)9'        INIT(0),       /*NUMERO PRO*/
                                                          /*FESIONAL  */
           3 YPROCL       PIC'(2)9'        INIT(0),       /*CODI DE PR*/
                                                          /*OVINCIA   */
           3 YDISCL       PIC'(3)9'        INIT(0),       /*DISTRICTE */
                                                          /*POSTAL    */
           3 YPOBCL       CHAR(7)          INIT(''),      /*NOM REDUIT*/
                                                          /* POBLACIO */
         2 RETLIT         PIC'(2)9'        INIT(0),       /*CODI DE RE*/
                                                          /*TORN      */
         2 APLIC          PIC'(6)9'        INIT(0),       /*APLICACION*/
                                                          /* DE LA POL*/
                                                          /*IZA       */
         2 WEBCAL         CHAR(1)          INIT(''),      /*INDICADOR */
                                                          /*TRACTAMENT*/
                                                          /* WEB      */
         2 ADRCHR         CHAR(4)          INIT(''),      /*ADREA NOM*/
                                                          /* CAMP EN J*/
                                                          /*AVA       */
         2 PESMSG         CHAR(1)          INIT(''),      /*INDICADOR */
                                                          /*MSG/CONSUL*/
                                                          /*TES       */
         2 ADRMSG         CHAR(4)          INIT(''),      /*ADREA ERR*/
                                                          /*ORS E,W,A,*/
                                                          /*I,C       */
         2 ADRVAL         CHAR(4)          INIT(''),      /*ADREA CAM*/
                                                          /*P VALOR   */
         2 FILL13         CHAR(9)          INIT('');      /*RESTO REGI*/
                                                          /*STRO      */
         %SKIP(3);
 /********************************************************************
 *     INCLUDE  STSTWA                                               *
 *     INTERFASE DE PASO DE DATOS ENTRE PROGRAMAS.                   *
 *********************************************************************/
 DCL PTRTWA PTR;
 DCL PTRWEBTWA PTR BASED(ADDR(PTRAITWA));
 DCL 1 TWA BASED(PTRTWA),
       2 TWA_ESTRELLA,                   /* CAMPOS DE ESTRELLA       */
         3 TWA_ERR_ESTRELLA CHAR(1),     /* CAMPO DE ERROR ESTRELLA  */
         3 TWA_RES_ESTRELLA CHAR(9),     /* RESTO CAMPOS   ESTRELLA  */
       2 TWAERROR       CHAR(70),        /* CAMPO DE ERROR           */
       2 LONGME         BIN FIXED(15),   /* LONG. MENSAJE DE ENTRADA */
       2 LONGMS         BIN FIXED(15),   /* LONG. MENSAJE DE SALIDA  */
       2 LONGPARE       BIN FIXED(15),   /* LONG. PARCIAL DE ENTRADA */
       2 LONGPARS       BIN FIXED(15),   /* LONG. PARCIAL DE SALIDA  */
       2 PTR022         PTR,             /* ADDR. REGISTRO 022       */
       2 PTR023         PTR,             /* ADDR. REGISTRO 023       */
       2 PTRSAL         PTR,             /* ADDR. MENSAJE DE SALIDA  */
       2 PTRDSAL        PTR,             /* ADDR. COMIENZO REG SALID */
       2 PTRENT         PTR,             /* ADDR. MENSAJE DE ENTRADA */
       2 PTRDENT        PTR,             /* ADDR. COMIENZO REG ENTRA */
       2 PTRATTWA       PTR,             /* ADDR. ATRIBUTS CAMPS WAS */
       2 PTRCWA         PTR,             /* ADDR. CWA                */
       2 PTRDTWA        PTR,             /* ADDR. AREA DATOS TWA     */
       2 PTRNOM         PTR,             /* ADDR. AREA NOMXXXX TWA   */
       2 LONGCS         BIN FIXED(15),   /* LONG. CABECERA SALIDA    */
       2 LONGCE         BIN FIXED(15),   /* LONG. CABECERA ENTRADA   */
       2 OENQCWA        BIN FIXED(31),   /* OFFSET AREA ENQUEUE CWA  */
       2 CROH           CHAR(2),         /* CODIGO REPUESTA FUNCION  */
       2 CTOSCBOS,                       /* COLA DE CTOS Y CBOS      */
                                         /* PRINCIPAL Y SECUNDARIOS  */
         3 ICTOSCBOS    BIN FIXED(15),   /* NUMERO DE CTOS Y CBOS    */
                                         /* ENCOLADOS                */
         3 MATCTOSCBOS(20),              /* MATRIZ PARA GUARDARLOS   */
           4 CTOS       CHAR(3),         /* CTOS EN COLA             */
           4 CBOS       CHAR(2),         /* CBOS EN COLA             */
           4 VEZ        CHAR(1),         /* VEZ  EN COLA             */
       2 TWACODI,                        /* CODIGOS PASO ENTRE PGMS  */
                                         /* DE NIVEL 2               */
                                         /* '0'B=NO, '1'B=SI         */
         3 DTB          BIT(1),          /* NECESITA DTB             */
         3 PSBPLANIYANO BIT(1),          /* PSB PLANIFICADA          */
         3 RBOSPTE      BIT(1),          /* RECIBOS PTES.            */
         3 RBOSPTEA     BIT(1),          /* RECIBOS PTES. ANTERIORES */
         3 RBOSPTEP     BIT(1),          /* RECIBOS PTES. POSTERIORES*/
         3 RBOSPTEV     BIT(1),          /* RECIBOS PTES. VENCIMIENTO*/
         3 RBOSCOB      BIT(1),          /* RECIBOS COBRADOS         */
         3 RBOSCOBA     BIT(1),          /* RECIBOS COBR. ANTERIORES */
         3 RBOSCOBP     BIT(1),          /* RECIBOS COBR. POSTERIORES*/
         3 STOSPTE      BIT(1),          /* SINIESTROS PTES.         */
         3 STOSPTEA     BIT(1),          /* SNTROS. PTES. ANTERIORES */
         3 STOSPTEP     BIT(1),          /* SNTROS. PTES. POSTERIORES*/
         3 STOSEOM      BIT(1),          /* SNTROS. =  |  >  EFECTOS */
         3 TROFFLIN     BIT(1),          /* T.R. OFFLINE. 1 SI, 0 NO */
         3 TROFFERR     BIT(1),          /* T.R. OFFLINE ERROR. 0S,1N*/
         3 ERRENVIA     BIT(1),          /* ERROR GRAVE YA ENVIADO,1S*/
         3 D3270        BIT(1),          /* DEVICE 3270              */
         3 DDIGITAL     BIT(1),          /* DEVICE DIGITAL (VAX)     */
         3 D36AS        BIT(1),          /* DEVICE 36/AS             */
         3 DAGENTS      BIT(1),          /* DEVICE PC DE AGENTS      */
         3 DAPPN        BIT(1),          /* DEVICE CONECTION LUTYPE6 */
         3 ID_TS_NUEVA  BIT(1),          /* NUEVO NOMBRE COLAS TS    */
         3 ID_MS_NUEVO  BIT(1),          /* MSG VARIABLE             */
         3 DINFOVIA     BIT(1),          /* DEVICE INFOVIA           */
         3 READONLY_TWA BIT(1),          /* CICS SOLO LECTURA        */
         3 DMQS         BIT(1),          /* DEVICE DE MQSERIES       */
         3 DIMS         BIT(1),          /* DEVICE DE IMS            */
         3 DESTRELLA    BIT(1),          /* DEVICE DE ESTRELLA       */
         3 MARCA_SINTWA BIT(1),          /* MARCA DE SINIESTROS      */
         3 DTCPIP       BIT(1),          /* DEVICE TCPIP             */
         3 DWEB         BIT(1),          /* DEVICE WEB               */
         3 DHTTP        BIT(1),          /* DEVICE HTTP              */
         3 PPIMI        BIT(1),          /* PROTOCOLO PIMI           */
         3 INFO_GENER   BIT(1),          /* HAY INFORMACION GENERNET */
         3 CICSSRV      BIT(1),          /* ES CICS DE SERVICIO      */
         3 DCTG         BIT(1),          /* CICS TRANSACTION GATEWAY */
         3 IMPRESINPAN  BIT(1),          /* IMPRESION SIN PANTALLAS  */
         3 INTERACTWA   BIT(1),          /* HAY USUARIO PERSONA      */
         3 CAMCLITWA    BIT(1),          /* CAMBIO CLIENTE           */
         3 YASTS016     BIT(1),          /* YA PASO POR  STS016      */
         3 IMPRMASSTWA  BIT(1),          /* IMPRESION MASIVA         */
         3 DCANCLITWA   BIT(1),          /* CANAL CLIENTE            */
         3 STSPCEF      BIT(1),          /* TRACE VSI                */
         3 FILLCODI     BIT(21),         /* FILLER PARA FUTURAS      */
                                         /* AMPLIACIONES             */
       2 FECHATWA       CHAR(6),         /* FECHA PARA PASAR ENTRE   */
                                         /* SUBFUNCIONES.            */
       2 TWAZZZ         CHAR(3),         /* FILLER                   */
       2 TOKENTWA       CHAR(24),        /* TOKEN                    */
       2 YORIG          CHAR(1),         /* ORIGEN DE TRANSACCIO     */
       2 YRCVY          CHAR(1),         /* RECOVERY SI O NO         */
       2 WUSER          CHAR(4),         /* USUARI PC O              */
                                         /* CODI TRANSACCIO O        */
                                         /* X'FFFF' SI ES 'UT30A'    */
       2 YGRDO          CHAR(1),         /* GRAVACIO DO-S, N=NO      */
       2 YTRNO          CHAR(4),         /* TRANSACCIO ORIGEN        */
       2 PTRPANTWA      PTR,             /* PTR TWA B.F.             */
       2 PTRSTA         PTR,             /* PTR ESTADISTICAS ALERTAS */
       2 CURPOSTWA      BIN FIXED(15),   /* CURSOR POSITION          */
       2 FILLETU        CHAR(2),         /* FILLER                   */
       2 TWATABPTR      PTR,             /* PUNTER TABLAS ACCES      */
       2 IMPCTR         PIC'999',        /* CONTADOR CRIDES STS201   */
       2 IDENTIF_TS     CHAR(7),         /*IDENTIFICACION COLAS TS   */
       2 TOKENUSRTWA    CHAR(24),        /* TOKEN DE SESION CTG      */
       2 ID_USER_TWA    CHAR(8),         /* USUARIO REAL             */
       2 ITITWA         BIN FIXED(15),   /* ITEM INICIO IMPRESION    */
       2 ITCTWA         BIN FIXED(15),   /* ITEM ACTUAL IMPRESION    */
       2 WPUTWA         CHAR(1),         /*                          */
       2 PROTOCOLO_TWA  CHAR(1),         /*                          */
       2 PRESENTA_TWA   CHAR(1),         /*                          */
       2 ACCESO_TWA     CHAR(1),         /*                          */
       2 SESION_TWA     CHAR(1),         /*                          */
       2 CLI_NT_TWA     CHAR(1),         /* CLIENTE NUEVA TRANSACCION*/
       2 IMPR_TWA       CHAR(4),         /* MI IMPRESION GENERNET V5 */
       2 PTR_DSI600_TWA PTR,             /* PUNTERO CACHE DSI600     */
       2 PTRINFTWA      PTR,             /* PTR INFORMACION GENERNET */
       2 PTRAITWA       PTR,             /* AREA INTERMEDIA TS (3270)*/
       2 REGENTSAL(1000: 1999),          /* MATRIZ DE REGISTROS      */
          3 NOM        CHAR(4),          /* NOMBRE REG. XXXX         */
          3 PTRE       PTR,              /* ADDR. REG XXXX DE ENTRADA*/
          3 PTRS       PTR,              /* ADDR. REG XXXX DE SALIDA */
       2 NOM9999        CHAR(4),         /* NOMBRE REG. 9999         */
       2 PTRE9999       PTR,             /* ADDR. REG 9999 DE ENTRADA*/
       2 PTRS9999       PTR,             /* ADDR. REG 9999 DE SALIDA */
       2 FINTWA         CHAR(4);         /* FIN TWA. ESTARA A FFFFFFF*/
 /********************************************************************
 *     FI INCLUDE  STSTWA                                            *
 *********************************************************************/
         %SKIP(3);
 /********************************************************************
 *     INCLUDE ISTS011                    ESTA OK                    *
 *     TWA TRANSACCIO REDUIDA                                        *
 *********************************************************************/
 DCL PTREPITWA       PTR;

 DCL 1 KEPITWA BASED(PTRTWA),
       2 OLDTWA     CHAR(12412), /* TWA SISTEMA ANTERIOR   */
       2 NEWTWA     CHAR(2269); /* TWA DE TRANSACCION RED */

 DCL 1 EPITWA         BASED(PTREPITWA) UNALIGNED,
       2 KEYTWA,
         3 MATTWA          CHAR(3),  /*MATRICULA PC/36              */
         3 FILL1           CHAR(1),  /*BLANCOS PARA S36             */
         3 NPPTWA          PIC'99',  /*DE 00 A 40 NUM PANT PART     */
         3 WSTWA           CHAR(2),  /* WS DEL 36                   */
       2 EREPITWA         CHAR(1),   /* 9=ERROR LEVE,8=GRAVE        */
       2 IDIOMATTWA       CHAR(1),   /* IDIOMA DE TRABAJO           */
       2 IDIOMACTWA       CHAR(1),   /* IDIOMA PARA CONTRATO        */
       2 CICLOTWA         CHAR(1),
       2 AUSTWA           PTR,       /*APUNTA A LA TWA DE USUARIO   */
       2 TUTWA            CHAR(8),   /* TRANSACCION USUARIO      */
       2 ENTORNTWA        CHAR(1),   /* 3=REAL,6=USUARI,4=DESENVOLU */
       2 CLIENTWA         CHAR(1),   /* G=GRUP,P=PORTUGAL           */
       2 DISPTWA          CHAR(1),   /* DISPOSITIVO SALIDA          */
                                     /* I=IMPRESORA,F=FAX           */
       2 OPCLSTTWA        CHAR(1),   /* I=INMEDIATA,D=DIFERIDO      */
                                     /* F=FAX DIURNO,N=FAX NOCTURNO */
       2 ENDB2TWA         CHAR(1),   /* YA CARGADO EN DB2 S/N       */
       2 ORITRATWA        CHAR(1),   /* ORIGEN TRANSACCION EN EPI   */
                                     /* 0=NO HAY,1=GED,2=CALL CENTER*/
       2 OPCGEDTWA        CHAR(1),   /* HAY DOCMTO. GED S/N         */
       2 NUMGEDTWA   BIN FIXED(15),  /* NUM.ITEMS COLA TS GED       */
       2 POSGEDTWA   BIN FIXED(15),  /* POS.ITEMS COLA TS GED       */
       2 TSGEDTWA         CHAR(1),   /* HAY COLA TS GED A ENVIAR S/N*/
       2 TENVMODTWA       CHAR(1),   /* TIPO DE ENVIO CAMBIO MODULO */
       2 TRAMITWA         CHAR(20),  /* NUMERO EXPEDIENTE GED       */
       2 CIATWA           CHAR(1),   /* COMPAIA                    */
       2 REGIONTWA        CHAR(2),   /* REGION                      */
       2 SUCPROTWA        CHAR(3),   /* SUCURSAL PRODUCTORA         */
       2 AGENTWA          CHAR(5),   /* AGENTE                      */
       2 RAMOTWA          CHAR(2),   /* RAMO                        */
       2 GENMDTOTWA       CHAR(4),   /* GENERICO DE MANDATOS        */
       2 PPMDL2           PTR,       /* PTR PARAM CAMBIO MODULO 2   */
       2 PDMDL2           PTR,       /* PTR DATOS CAMBIO MODULO 2   */
       2 NAVMDL2          CHAR(1),   /* MODULOS2:1/ACT. 2/NO ACT.   */
       2 EUROPTTWA        CHAR(1),   /* S=PANTALLA EUROTRATABLE     */
       2 DISPOSTWA        CHAR(1),   /* DISPOSITIVO (3270,MQS,36,PC)*/
       2 TRANSPORTWA      CHAR(1),   /* TRANSPORTE(TCP,BMS,WEB,)    */
       2 PROTOTWA         CHAR(1),   /* PROTOCOLO (PEPE,APPC)       */
       2 UBICACIOTWA      CHAR(1),   /* C=CENTRO OPERATIVO          */
       2 OPERPRTTWA       CHAR(8),   /* USUARIO DESTINO IMPRESION   */
       2 MATPRTTWA        CHAR(3),   /* MATRICULA DESTINO IMPRESION */
       2 INDORITWA        CHAR(1),   /* 0=GENERNET V4               */
                                     /* 1=SIGVIEW,2=PERSIS,3=NOPERSI*/
       2 IDIOMAT2TWA      CHAR(2),   /* IDIOMA DE TRABAJO           */
       2 IDIOMAC2TWA      CHAR(2),   /* IDIOMA PARA CONTRATO        */
       2 TRATALITWA       BIT(1),    /* NUEVO PROCESO LITERALES     */
       2 TRATAPANTWA      BIT(1),    /* SI TRATA PANTALLAS          */
       2 AUTOPRTTWA       BIT(1),    /* AUTOMATA IMPRESION C.O.     */
       2 FICHAPOLI        BIT(1),    /* IMPRESION FICHA Y POLIZA */
       2 IRAGV5TWA        BIT(1),    /* IR A GENERNET V5            */
       2 FILBITWA         BIT(3),    /* LIBRE                       */
       2 AREATUTWA        CHAR(2),   /* AREA ASIGNADA POR TRANSACC  */
       2 UNITTUTWA        CHAR(2),   /* UNIT ASIGNADA POR TRANSACC  */
       2 FILLERX          CHAR(27),  /* LIBRE                       */
       2 Y2MXTWA          CHAR(1),   /* CIA DE 2MX                  */
       2 IDPRTTWA         CHAR(8),   /* ID DESTINO IMPRESION        */
       2 IPPRTTWA         CHAR(4),   /* DIRECCION IP IMPRESORA      */
       2 MQAREATWA        CHAR(8),   /* AREA MQSERIES               */
       2 MQAPLITWA        CHAR(8),   /* APLICACION MQSERIES         */
       2 MQCOLATWA        CHAR(8),   /* COLA MQSERIES               */
       2 EUROMCC          CHAR(01),  /* INDICADOR EURO PARA MCC 0,1 */
       2 TDOCTWA          CHAR(1),   /* TIPO DCMTO.P/POL.S/SIN.ETC. */
       2 EUROTUTWA        BIT(1),    /* 1=PANTALLA EN EUROS         */
       2 EUROBSTWA        BIT(1),    /* 1=APLICACION EN EUROS       */
       2 EUROPRTWA        BIT(1),    /* 1=PROCEDE DEL STS016        */
       2 MDT3MDL2         BIT(1),    /* 1=DESACTIVA MDTO-3 MODULO 2 */
       2 EUROVISION       BIT(1),    /* 1=VISION EN EUROS           */
       2 ERR3270          BIT(1),    /* NO TRADUCE                  */
       2 BIGFUS           BIT(1),    /* IMPRESION GENERNET 2000 V3  */
       2 CTGTIPOTWA       BIT(1),    /* TIPO COMUNICACION CTG       */
       2 PMODTWA          CHAR(1),   /* 0=NO MODIF,1=SI MODIF       */
       2 PATRASTWA        CHAR(1),   /* 0=ADELANTE,1=ATRAS          */
       2 OPCIOTWA         CHAR(1),   /* A=ALTA,B=BAJA,M=MODIF,C=CON */
       2 ENTLOGICTWA      CHAR(8),   /* PUNTO ENT. MODUL.LOGICA     */
       2 MODULOTWA        CHAR(8),   /* MODULO LOGICA A EJECUTAR    */
       2 TIPUSRTWA        CHAR(1),   /* TIPO USUARIO 0 SUCURSAL     */
                                     /*              1 AGENTE       */
                                     /*              2 VSI          */
                                     /*              3 PROFESIONAL  */
                                     /*              4 MQS          */
                                     /*              5 MCC          */
       2 PORIGIN          PTR,       /* DIRECCION A IMAGVCOM        */
       2 PACTUAL          PTR,       /* DIRECCION A IMAGNCOM        */
       2 ITEM99TWA        PIC'(5)9', /* VAX RETURN CODE NATIU       */
       2 PTRPRR           PTR,       /* PTR A REGISTRE REPRESENTACIO*/
       2 ITEMETWA          PIC'99',  /*INDICE ERROR TWA             */
       2 FUNCIOTWA        CHAR(1),   /*FUNCIO ERROR TWA             */
       2 PRTEPI           CHAR(2),   /*IMPRESORA SESION EPI         */
       2 NEXPTWA          PIC'9999', /*SIGUIENTE PANTALLA A PROY    */
       2 NEXPGMTWA        CHAR(8),   /*SIGUIENTE PGM PARA LINK      */
       2 NEXTRANTWA       CHAR(4),   /*SIGUIENTE TRANS              */
       2 CTOSTWA          CHAR(3),   /*CTOS                         */
       2 CBOSTWA          CHAR(2),   /*CBOS                         */
       2 CROHTWA          CHAR(3),   /*CROH PERO DE 3 POSICIONES    */
       2 PVACIATWA        CHAR(1),   /* 0 PANT LLENA,1 PANT VACIA   */
                                     /* 2 PANT NO MODIFICADA        */
       2 NTCICSTWA        PIC'(6)9', /*NUMERO TAREA DE CICS         */
       2 CPROYTWA         CHAR (1),  /*0 NO PROYECTAR 1 SI          */
       2 CFINTWA          CHAR (1),  /*0 NO FIN TRANSAC. 1 SI       */
       2 CLITTWA          CHAR (1),  /*0 NO LITERAL                 */
                                     /*1 SI LITERAL PRIMERA PROYEC  */
                                     /*2 SI LITERAL SEGUNDA PROYEC  */
       2 LITOBTWA         PIC '99',  /*NUMERO LITERALES OBLIGATOR.  */
       2 CGRABTWA         CHAR (1),  /*0 NO GRABAR F.APOYO. 1 SI    */
       2 ENTPGMTWA        CHAR(6),   /* PUNTO DE VUELTA A PGM USER  */
       2 OPERTWA          CHAR(8),   /* NOMBRE DEL OPERADOR DEL EPI */
       2 USERTWA          CHAR(2000); /*PARA DATOS USUARIO          */

 /*   VALORES DEL CAMPO TIPUSRTWA   */

 DCL USRTWASUC CHAR(1) INIT('0');         /* TIPUSRTWA = SUCURSAL */
 DCL USRTWAMED CHAR(1) INIT('1');         /* TIPUSRTWA = MEDIADOR */
 DCL USRTWAVSI CHAR(1) INIT('2');         /* TIPUSRTWA = INFORMAT.*/
 DCL USRTWAPRO CHAR(1) INIT('3');         /* TIPUSRTWA = PROFESIO.*/
 DCL USRTWAMQS CHAR(1) INIT('4');         /* TIPUSRTWA = MQSERIES */
 DCL USRTWAMCC CHAR(1) INIT('5');         /* TIPUSRTWA = MCC      */

 /******************************************************************
 *    IDENTIFICACION COLAS TS CON NUEVA NOMENCLATURA               *
 *******************************************************************/
 DCL 1 $IDENT_COLA,
       2 $CUA_B    CHAR(3) INIT('B  '),
       2 $CUA_E    CHAR(3) INIT('E  '),
       2 $CUA_S    CHAR(3) INIT('S  '),
       2 $IMPRES   CHAR(3) INIT('I  '),
       2 $3270     CHAR(3) INIT('3  '),
       2 $TWA      CHAR(3) INIT('   '),
       2 $COM      CHAR(3) INIT(' 00'),
       2 $CLAUS_99 CHAR(3) INIT(' TT'),
       2 $ESTADIST CHAR(3) INIT('TTT'),
       2 $ERROR    CHAR(3) INIT('EC '),
       2 $GED      CHAR(3) INIT('GED'),
       2 $GRD      CHAR(3) INIT('GRD'),
       2 $MOD      CHAR(3) INIT('MOD'),
       2 $MENU     CHAR(3) INIT('M  '),
       2 $DSI600   CHAR(3) INIT('D  ');
 IDENT_COLA_TS:PROC(A) RETURNS (CHAR(8));
   DCL A CHAR(3);
   DCL B CHAR(8);
   IF   ID_TS_NUEVA
   THEN DO;
        SELECT (A);
          WHEN ($MENU)     B = IDENTIF_TS || 'M';
          WHEN ($CUA_B)    B = IDENTIF_TS || 'B';
          WHEN ($CUA_E)    B = IDENTIF_TS || 'E';
          WHEN ($CUA_S)    B = IDENTIF_TS || 'S';
          WHEN ($TWA)      B = IDENTIF_TS || 'W';
          WHEN ($COM)      B = IDENTIF_TS || '0';
          WHEN ($CLAUS_99) B = IDENTIF_TS || 'T';
          WHEN ($ESTADIST) B = IDENTIF_TS || 'X';
          WHEN ($IMPRES)   B = IDENTIF_TS || 'I';
          WHEN ($3270)     B = IDENTIF_TS || '3';
          WHEN ($GED)      B = IDENTIF_TS || 'G';
          WHEN ($GRD)      B = IDENTIF_TS || 'R';
          WHEN ($MOD)      B = IDENTIF_TS || 'N';
          WHEN ($ERROR)    B = IDENTIF_TS || '9';
          WHEN ($DSI600)   B = IDENTIF_TS || 'D';
          OTHER            B = IDENTIF_TS || '?';
        END;
        END;
   ELSE B = MATTWA || A || WSTWA;
   RETURN (B);
 END IDENT_COLA_TS;
 /********************************************************************
 *     FI INCLUDE ISTS011                                            *
 *********************************************************************/
         %SKIP(3);
 /********************************************************************
 *     INCLUDE ISTS012                                               *
 *     TRANSACCIO REDUIDA                                            *
 *********************************************************************/
 DCL 1 REG_COMMON    BASED(PTRPANTWA),
       2 KEYCOM,
         3 MATCOM         CHAR(3),    /*MATRICULA PC/36            */
         3 FILLE2         CHAR(1),    /*BLANCOS PARA 36            */
         3 NPPCOM         PIC'99',    /*NUM. PANT. PART.           */
         3 WSCOM          CHAR(2),    /*WS S36                     */
       2 NPPACOM          PIC'99',    /*NUM. PANT. PART. ANTERIOR  */
       2 INDCOM  (99)     PIC'9',     /*INDICADORES PARA S36       */
       2 BLOQCOM          CHAR(1),    /*PANTALLA BLOQUEADA         */
       2 YAPCOM           CHAR(3),    /*APLICACION PARA LITERALES  */
       2 RAMOCOM          CHAR(2),    /*RAMO PARA LITERALES        */
       2 NTCICSCOM        PIC '(6)9', /*NUMERO TAREA               */
       2 AIDCOM           CHAR(2),    /*AID (TECLA DE FUNCION      */
       2 IMAGVCOM         CHAR(1000), /*IMAGEN PANTALLA VIEJA      */
       2 IMAGNCOM         CHAR(1000);/*IMAGEN PANTALLA NUEVA       */
 /******************************************************************
 *    CAMPOS PARA RUTINA STS700 DE CAMBIO DE BLANCOS POR CEROS     *
 *******************************************************************/
 DCL  $1         BIN FIXED(15)    INIT( 1);
 DCL  $2         BIN FIXED(15)    INIT( 2);
 DCL  $3         BIN FIXED(15)    INIT( 3);
 DCL  $4         BIN FIXED(15)    INIT( 4);
 DCL  $5         BIN FIXED(15)    INIT( 5);
 DCL  $6         BIN FIXED(15)    INIT( 6);
 DCL  $7         BIN FIXED(15)    INIT( 7);
 DCL  $8         BIN FIXED(15)    INIT( 8);
 DCL  $9         BIN FIXED(15)    INIT( 9);
 DCL  $10        BIN FIXED(15)    INIT(10);
 DCL  $11        BIN FIXED(15)    INIT(11);
 DCL  $12        BIN FIXED(15)    INIT(12);
 DCL  $13        BIN FIXED(15)    INIT(13);
 DCL  $14        BIN FIXED(15)    INIT(14);
 DCL  $15        BIN FIXED(15)    INIT(15);
 DCL  $16        BIN FIXED(15)    INIT(16);
 DCL  $17        BIN FIXED(15)    INIT(17);
 DCL  $18        BIN FIXED(15)    INIT(18);
 DCL STS700COD   CHAR (1)         INIT('0');
 /********************************************************************
 *     FI INCLUDE ISTS012                                            *
 *********************************************************************/
 %PAGE;                                                                 0000004
 /********************************************************************
 *     INCLUDE ISTS003                                               *
 *                     ERRORS SISTEMA 36.                            *
 *********************************************************************/
 %SKIP(2);
 DCL ERROR_PENDENT UNALIGNED BIT(1) INIT ('0'B);
 /* L'ACTIVA LA RUTINA 'STANDARD'  XERROR                             */
 %SKIP(2);
 DCL OK                   CHAR (2) INIT ('00'); /* OPERACIO CORRECTE */
 DCL NO_EXISTEIX          CHAR (2) INIT ('01'); /* REG. INEXISTENT    */
 DCL USUARI_INEXISTENT    CHAR (2) INIT ('01'); /* APLICACIO AGENTS   */
 DCL JA_EXISTEIX          CHAR (2) INIT ('02'); /* REG. DUPLICAT      */
 DCL ERROR_ASSIGNACIO     CHAR (2) INIT ('02'); /* APLICACIO AGENTS   */
 DCL CTOS_ERRONIA         CHAR (2) INIT ('03');
 DCL TRANSACCIO_INVALIDA  CHAR (2) INIT ('03'); /* APLICACIO AGENTS */
 DCL CBOS_ERRONIA         CHAR (2) INIT ('04');
 DCL FUNCIO_INVALIDA      CHAR (2) INIT ('05');
 DCL MANCAN_DADES         CHAR (2) INIT ('06');
 DCL MISSATGES_PENDENTS   CHAR (2) INIT ('06'); /* APLICACIO AGENTS */
 DCL SOBREN_DADES         CHAR (2) INIT ('07');
 DCL MISSATGE_INEXISTENT  CHAR (2) INIT ('07'); /* APLICACIO AGENTS */
 DCL FI_INFORMACIO        CHAR (2) INIT ('08'); /* HISTORICA         */
 DCL FUNCIO_INACTIVA      CHAR (2) INIT ('08'); /* CTOS DESACTIVAT   */
 DCL ERROR_SINCRONISME    CHAR (2) INIT ('08'); /* APLICACIO AGENTS */
 DCL REGISTRE_BLOQUEJAT   CHAR (2) INIT ('09'); /* ESPERA            */
 DCL ERROR_USUARI         CHAR (2) INIT ('09'); /* APLICACIO AGENTS */
 /*
       A PARTIR D'AQUEST CODI HI HA CANCEL.LACIO AUTOMATICA
       ENTRE 70 I 79 ADEMES S'ENVIA UN MISSATJE
                                                                     */
 DCL ERROR_ABEND          CHAR (2) INIT ('70');
 DCL VSAM                 CHAR (2) INIT ('70'); /* OPERACIONES VSAM */
 DCL PLANIFICA            CHAR (2) INIT ('71'); /* PSB               */
 DCL DESPLANIFICA         CHAR (2) INIT ('72'); /* PSB               */
 DCL CICS_ATURAT          CHAR (2) INIT ('72'); /* APLICACIO AGENTS */
 DCL DADAS_ERRONEAS       CHAR (2) INIT ('72'); /* APLICACIO AGENTS */
 DCL MODUL11              CHAR (2) INIT ('73'); /* CALCUL MODUL 11   */
 DCL SOFT_INVALID         CHAR (2) INIT ('73'); /* APLICACIO AGENTS */
 DCL SIGNON_INVALID       CHAR (2) INIT ('73'); /* APLICACIO AGENTS */
 DCL LONGITUT_INVALIDA    CHAR (2) INIT ('74'); /* APLICACIO AGENTS */
 DCL DO_ERROR             CHAR (2) INIT ('75'); /* APLICACIO AGENTS */
 DCL DATA_INVALIDA        CHAR (2) INIT ('76'); /* APLICACIO AGENTS */
 DCL ERROR_PASSWORD       CHAR (2) INIT ('77'); /* APLICACIO AGENTS */
 DCL ERROR_ABEND_GREU     CHAR (2) INIT ('80');
 DCL DATES                CHAR (2) INIT ('90'); /* 'FECHAS'          */
 DCL DESCOMPRIMEIX_POC    CHAR (2) INIT ('95'); /* AREA > DADES      */
 DCL DESCOMPRIMEIX_MASSA  CHAR (2) INIT ('96'); /* DADES > AREA      */
 DCL CA_INEXISTENT        CHAR (2) INIT ('98'); /* COMMON AREA       */
 DCL EPI_INEXISTENT       CHAR (2) INIT ('98'); /* APLICACIO AGENTS */
 DCL ERROR_SEVER          CHAR (2) INIT ('99'); /* DL/1 O INESPERAT,*/
                                                 /* MIREU TWA.       */
 %SKIP(2);
 /*********************************************************************
 *********                                                  ***********
 *********             ADRECAMENT TWA                       ***********
 *********                                                  ***********
 *********************************************************************/
 %SKIP(2);
 EXEC CICS ADDRESS TWA (PTRTWA);
 %SKIP(2);
 /********************************************************************
 *     FI INCLUDE ISTS003                                            *
 *********************************************************************/
 PTREPITWA = ADDR(NEWTWA);
 /********************************************************************
 *     INCLUDE ISTS016  !!!!!!!!!!!!!! COMENTAT !!!!!!!!!!!! ARA, JOS*
 *********************************************************************
 IF FINTWA = LOW (4) &
    EIBTRNID = 'UT20'
    THEN EXEC CICS LINK PROGRAM('STS015  ');
  ********************************************************************
 *     FI INCLUDE ISTS016                                            *
 *********************************************************************/
 DCL 1 SSAREAS UNAL,
       2 SSFUNCION     CHAR(2),
       2 SSNITEM      BIN FIXED(15),
       2 SSPTRTWA     PTR,
       2 SSPTRCOMMON  PTR;
 XLEERTS: PROC (KITEM,KPTRCOMMON,KPTRTWA);
 DCL KITEM       BIN FIXED(15);
 DCL KPTRTWA     PTR;
 DCL KPTRCOMMON  PTR;
 SSFUNCION    = 'L ';
 SSNITEM      = KITEM;
 SSPTRTWA     = KPTRTWA;
 SSPTRCOMMON  = KPTRCOMMON;
 CALL UTNTTS;
 END XLEERTS;
 XLEERTSNEXT: PROC (KPTRCOMMON,KPTRTWA);
 DCL KPTRTWA     PTR;
 DCL KPTRCOMMON  PTR;
 SSFUNCION    = 'LN';
 SSPTRTWA     = KPTRTWA;
 SSPTRCOMMON  = KPTRCOMMON;
 CALL UTNTTS;
 END XLEERTSNEXT;
 XGRABARTS: PROC (KITEM,KPTRCOMMON,KPTRTWA);
 DCL KITEM       BIN FIXED(15);
 DCL KPTRTWA     PTR;
 DCL KPTRCOMMON  PTR;
 SSFUNCION    = 'W ';
 SSNITEM      = KITEM;
 SSPTRTWA     = KPTRTWA;
 SSPTRCOMMON  = KPTRCOMMON;
 CALL UTNTTS;
 END XGRABARTS;
 UTNTTS: PROC;
 DCL COND        BIN FIXED(15);
   EXEC CICS LINK PROGRAM('STS650') COMMAREA(SSAREAS) RESP(COND);
   IF   COND = DFHRESP(NORMAL)
   THEN CROHTWA = '999';
 END UTNTTS;
            /*   */
 DCL 1 KR2079@@ BASED (PTRCWAS ) UNAL,                    /************/
         2 YAPPLC@@       CHAR(8),                        /*APLICACIO */
                                                          /*VTAM      */
         2 YALERT@@       CHAR(2),                        /*ALERTES AC*/
                                                          /*TIVES ?   */
         2 YSYSID@@       CHAR(4),                        /*SYSID CICS*/
                                                          /*DATA  PROC*/
                                                          /*ES  ANY DE*/
                                                          /* 4        */
         2 FFPRO4@@,                                      /*          */
           3 AAPRO4@@     PIC'(4)9',                      /*ANY       */
           3 MMPRO4@@     PIC'(2)9',                      /*MES       */
           3 DDPRO4@@     PIC'(2)9',                      /*DIA       */
                                                          /*DATA CONTA*/
                                                          /*BLE ANY DE*/
                                                          /* 4        */
         2 FFCON4@@,                                      /*          */
           3 AACON4@@     PIC'(4)9',                      /*ANY       */
           3 MMCON4@@     PIC'(2)9',                      /*MES       */
           3 DDCON4@@     PIC'(2)9',                      /*DIA       */
         2 YEUROB@@       CHAR(1),                        /*EUROBASE  */
         2 YBLAN2@@       CHAR(1),                        /*BLANCOS   */
         2 YBLAN3@@       CHAR(1),                        /*BLANCOS   */
         2 YBLAN4@@       CHAR(61),                       /*BLANCOS   */
         2 YOPID@@        CHAR(3),                        /*OPID CICS */
         2 TTYNET@@(10),                                  /*          */
           3 YNETN@@      CHAR(4),                        /*MASCARA 'N*/
                                                          /*ETNAME' CI*/
                                                          /*CS        */
         2 YOPEEM@@       CHAR(2),                        /*TIPUS OPER*/
                                                          /*ACIO EMISI*/
                                                          /*O         */
         2 TTMASC@@(10),                                  /*          */
           3 MASCAR@@,                                    /*          */
             4 YCTOS@@    CHAR(3),                        /*CTOS      */
             4 YCBOS@@    CHAR(2),                        /*CBOS      */
             4 YVEZ@@     CHAR(1),                        /*VEZ       */
         2 TMAXRS@@       PIC'(2)9',                      /*TEMPS MAX.*/
                                                          /* RESPOSTA */
         2 TMAXPR@@       PIC'(2)9',                      /*TEMPS MAX.*/
                                                          /* PROCES   */
         2 TMAXRE@@       PIC'(2)9',                      /*TEMPS MAX.*/
                                                          /* RECEPCIO */
         2 TMAXEN@@       PIC'(2)9',                      /*TEMPS MAX.*/
         2 LMAXCP@@       PIC'(5)9',                      /*LONG.MAX.M*/
                                                          /*ISSATGE CO*/
                                                          /*MPRIMI    */
         2 RF0582@@       PIC'(2)9',                      /*NUM.REG EN*/
                                                          /* 1 BLOC F0*/
                                                          /*582       */
         2 YCCRPR@@       CHAR(1),                        /*TIPUS DE P*/
                                                          /*ROCES DATA*/
                                                          /*FONS      */
         2 YTERME@@       CHAR(4),                        /*TERMINAL E*/
                                                          /*SPIA      */
                                                          /*DATA  PROC*/
                                                          /*ES        */
         2 FFPRO@@,                                       /*          */
           3 AAPRO@@      PIC'(2)9',                      /*ANY       */
           3 MMPRO@@      PIC'(2)9',                      /*MES       */
           3 DDPRO@@      PIC'(2)9',                      /*DIA       */
                                                          /*DATA  CONT*/
                                                          /*ABLE      */
         2 FFCON@@,                                       /*          */
           3 AACON@@      PIC'(2)9',                      /*ANY       */
           3 MMCON@@      PIC'(2)9',                      /*MES       */
           3 DDCON@@      PIC'(2)9',                      /*DIA       */
         2 FILLER@@       CHAR(3),                        /*FILLER    */
         2 NF0582@@       PIC'(2)9',                      /*NUMERO DE */
                                                          /*REG. ACTUA*/
                                                          /*L         */
         2 NALERT@@       PIC'(2)9',                      /*NUMERO DE */
                                                          /*ACTIVACION*/
                                                          /*S         */
                                                          /*HORA 1A. A*/
                                                          /*CTIVACIO A*/
                                                          /*LERTES    */
         2 TTPSTR@@,                                      /*          */
           3 HHPSTR@@     PIC'(2)9',                      /*HORA      */
           3 NNPSTR@@     PIC'(2)9',                      /*MINUT     */
           3 SSPSTR@@     PIC'(2)9',                      /*SEGON     */
           3 XXPSTR@@     PIC'(3)9',                      /*MIL.LESIME*/
                                                          /*S DE SEGON*/
                                                          /*HORA 1A DE*/
                                                          /*SACT. ALER*/
                                                          /*TES       */
         2 TTPSTP@@,                                      /*          */
           3 HHPSTP@@     PIC'(2)9',                      /*HORA      */
           3 NNPSTP@@     PIC'(2)9',                      /*MINUT     */
           3 SSPSTP@@     PIC'(2)9',                      /*SEGON     */
           3 XXPSTP@@     PIC'(3)9',                      /*MIL.LESIME*/
                                                          /*S DE SEGON*/
                                                          /*HORA ULTIM*/
                                                          /*A ACTIV. A*/
                                                          /*LERTES    */
         2 TTUSTR@@,                                      /*          */
           3 HHUSTR@@     PIC'(2)9',                      /*HORA      */
           3 NNUSTR@@     PIC'(2)9',                      /*MINUT     */
           3 SSUSTR@@     PIC'(2)9',                      /*SEGON     */
           3 XXUSTR@@     PIC'(3)9',                      /*MIL.LESIME*/
                                                          /*S DE SEGON*/
                                                          /*HORA ULT. */
                                                          /*ACTIV. ALE*/
                                                          /*RTES      */
         2 TTUSTP@@,                                      /*          */
           3 HHUSTP@@     PIC'(2)9',                      /*HORA      */
           3 NNUSTP@@     PIC'(2)9',                      /*MINUT     */
           3 SSUSTP@@     PIC'(2)9',                      /*SEGON     */
           3 XXUSTP@@     PIC'(3)9',                      /*MIL.LESIME*/
                                                          /*S DE SEGON*/
         2 PTRT00@@       PTR,                            /*PTRSTST00 */
         2 PTR379@@       PTR,                            /*PTRSTS379 */
         2 PTR512@@       PTR,                            /*PTRSTS512 */
         2 FILL01@@       CHAR(465),                      /*FILLER    */
         2 TT2077@@(20),                                  /*          */
           3 R2077@@      CHAR(128),                      /*REGISTRE 2*/
                                                          /*077       */
         2 FFPRJ@@        DEC FIXED (7),                  /*ANY-DIA JU*/
                                                          /*LIA DE PRO*/
                                                          /*CES       */
                                                          /*DATA  SIST*/
                                                          /*EMA       */
         2 FFSYS@@,                                       /*          */
           3 AASYS@@      PIC'(2)9',                      /*ANY       */
           3 MMSYS@@      PIC'(2)9',                      /*MES       */
           3 DDSYS@@      PIC'(2)9',                      /*DIA       */
         2 FFSYJ@@        DEC FIXED (7),                  /*ANY-DIA JU*/
                                                          /*LIA DEL SI*/
                                                          /*STEMA     */
                                                          /*DATAS JULI*/
                                                          /*ANAS DE AN*/
                                                          /*Y DE 4    */
         2 FFPRJ4@@       DEC FIXED (9),                  /*ANY-DIA JU*/
                                                          /*LIA DE PRO*/
                                                          /*CES       */
                                                          /*DATA  SIST*/
                                                          /*EMA       */
         2 FFSYS4@@,                                      /*          */
           3 AASYS4@@     PIC'(4)9',                      /*ANY       */
           3 MMSYS4@@     PIC'(2)9',                      /*MES       */
           3 DDSYS4@@     PIC'(2)9',                      /*DIA       */
         2 FFSYJ4@@       DEC FIXED (9),                  /*ANY-DIA JU*/
                                                          /*LIA DEL SI*/
                                                          /*STEMA     */
                                                          /*DATA  ARRA*/
                                                          /*NQUE CICS */
         2 FFINI4@@,                                      /*          */
           3 AAINI4@@     PIC'(4)9',                      /*ANY       */
           3 MMINI4@@     PIC'(2)9',                      /*MES       */
           3 DDINI4@@     PIC'(2)9',                      /*DIA       */
                                                          /*HORA ARRAN*/
                                                          /*QIE CICS  */
         2 TTINIC@@,                                      /*          */
           3 HHINIC@@     PIC'(2)9',                      /*HORA      */
           3 NNINIC@@     PIC'(2)9',                      /*MINUT     */
           3 SSINIC@@     PIC'(2)9',                      /*SEGON     */
           3 XXINIC@@     PIC'(3)9',                      /*MIL.LESIME*/
                                                          /*S DE SEGON*/
         2 YCOLAS@@       CHAR(2),                        /*COLAS BORR*/
                                                          /*ADAS ?    */
         2 SINMOD@@       CHAR(1),                        /*SINMOD    */
         2 RDONLY@@       CHAR(1),                        /*READ ONLY */
         2 INI512@@       CHAR(1),                        /*INICIALIZA*/
                                                          /*DO STS512 */
         2 YEATPX@@       CHAR(1),                        /*ENVIO ABEN*/
                                                          /*DS A TPX  */
         2 FILL02@@       CHAR(218);                      /*FILLER    */
         %SKIP(3);
 /********************************************************************
 *     INCLUDE HISTS035                                              *
 *     TRACTAMENT 'DATE' EN CICS.                                    *
 *********************************************************************/
 DCL @AMD       PIC'999999'  INIT(0);   /* DATA PROCES       */
 DCL @AMDC      CHAR(6)      BASED(ADDR(@AMD));
 DCL @ADJUL     DEC FIXED(7) INIT(0);    /* DATA PROC.JULIANA */
 DCL @AMD_CON   CHAR(6)      INIT('');   /* DATA CONTABLE     */
 DCL @AMD_SYS   CHAR(6)      INIT('');   /* DATA SISTEMA      */
 DCL @ADJUL_SYS DEC FIXED(7) INIT(0);    /* DATA PROC.JULIANA */
         %SKIP(2);
 /* DATES AMB ANYS DE 4 DIGITS                                       */
 DCL @A4MD       PIC'99999999' INIT(0);   /* DATA PROCES       */
 DCL @A4MDC      CHAR(8)       BASED(ADDR(@A4MD));
 DCL @A4DJUL     DEC FIXED(9)  INIT(0);   /* DATA PROC.JULIANA */
 DCL @A4MD_CON   CHAR(8)       INIT('');  /* DATA CONTABLE     */
 DCL @A4MD_SYS   CHAR(8)       INIT('');  /* DATA SISTEMA      */
 DCL @A4DJUL_SYS DEC FIXED(9)  INIT(0);   /* DATA PROC.JULIANA */
         %SKIP(2);
 DCL @LEIDO_FDATE BIT(1)      INIT('1'B);/* DATA JA OBTINGUDA */
 EXEC CICS ADDRESS CWA (PTRCWAS);
 @AMDC      = STRING(KR2079@@.FFPRO@@);
 @AMD_CON   = STRING(KR2079@@.FFCON@@);
 @AMD_SYS   = STRING(KR2079@@.FFSYS@@);
 @ADJUL     = KR2079@@.FFPRJ@@;
 @ADJUL_SYS = KR2079@@.FFSYJ@@;
         %SKIP(2);
 @A4MDC     = STRING(KR2079@@.FFPRO4@@);
 @A4MD_CON  = STRING(KR2079@@.FFCON4@@);
 @A4MD_SYS  = STRING(KR2079@@.FFSYS4@@);
 @A4DJUL    = KR2079@@.FFPRJ4@@;
 @A4DJUL_SYS= KR2079@@.FFSYJ4@@;
         %SKIP(2);
 PTRCWAS    = ADDR(@AMD);      /* PER A EVITAR MAXAQUES A LA CWA     */
 /********************************************************************
 *     FI INCLUDE HISTS035                                           *
 *********************************************************************/
 DCL DELAY BUILTIN;
 DCL SYSPRINT FILE PRINT;
 DCL OPCIO1 CHAR(1) INIT('');
 DCL OPCIO2 CHAR(1) INIT('');
 DCL PES   CHAR(1) INIT('');
 DCL ALAN  CHAR(4) INIT('ZZZZ');
 DCL OPCIO1_2 CHAR(1) INIT('');
 DCL OPCIO2_2 CHAR(1) INIT('');
 DCL PES_2   CHAR(1) INIT('');
 DCL ALAN_2  CHAR(4) INIT('ZZZZ');

 DCL REGWEB_SAL     CHAR(31600) BASED(PTRDSAL);
 DCL 1 INFO_0001,
      2 NUMREG_0001        PIC '(6)9' INIT (000001),
      2 LNGREG_0001        PIC '(6)9';

 DCL 1 INFO_0011,
      2 NUMREG_0011        PIC '(6)9' INIT (000011),
      2 LNGREG_0011        PIC '(6)9';

 DCL 1 REGENT BASED(PTRDENT),
     2 NUMREG_1      PIC '(6)9',
     2 LNGREG_1      PIC '(6)9', /* S DE 10 */
     2 REGWEB_1      CHAR(10),
     2 NUMREG_2      PIC '(6)9',
     2 LNGREG_2      PIC '(6)9',
     2 REGWEB_2      CHAR(10);   /* S DE 10 */

 /* MOVEM L'AREA REBUDA AL REGISTRE WW0011 */
 WW0001 = '';
 STRING(WW0001) = REGWEB_1;
 OPCIO1 = WW0001.OPCIO1;
 OPCIO2 = WW0001.OPCIO2;
 WW0011 = '';
 STRING(WW0011) = REGWEB_2;
 OPCIO1 = WW0011.OPCIO1;
 OPCIO2 = WW0011.OPCIO2;
 WW0001.RESPOS = 'RESP0001';
 WW0011.RESPOS = 'RESP0011';
 LNGREG_0001 = 10;
 LNGREG_0011 = 10;
 REGWEB_SAL  =  STRING(INFO_0001) || STRING(WW0001) ||
                STRING(INFO_0011) || STRING(WW0011);
 /* @WEBERROR('RED',1368,WW0001@@.RESPOS@@); */
 LONGMS  = STG(WW0001);
 LONGMS  = 24 + LONGMS + STG(WW0011);

 EXEC CICS XCTL PROGRAM('STS016');

 END ARQ991;
