 /********************************************************************/
 /*  ACCIONES STANDARD DE ACCESO A MQ:                               */
 /*  CONN,DISC,CMIT,FINN(MQCLOSE),BACK,GET,GETN,PUT,PUT1,PUTN,       */
 /*  GETB,GETW                                                       */
 /*  ACCIONES NO STANDARD DE ACCESO A MQ:                            */
 /*  GETW (HACE GET DE UN MENSAJE ESPECIFICO CON WAIT INTERVAL       */
 /*  GETB (HACE GET NEXT CON WAIT INTERVAL SUMINISTRADO              */
 /*  CONX (SE CONECTA A ENTORNO-CLIENTE QUE SE LE INDIQUE)           */
 /*  RPLY GRABA MSG EN LA COLA MQRTQU (SIN MIRAR NOMBRE ESTANDARD)   */
 /********************************************************************/
 /********************************************************************/
 /*  INCLUDES QUE CONTIENEN LAS DECLARACIONES DE MQSERIES            */
 /********************************************************************/
 %INCLUDE SYSLIB(CMQP);
 %INCLUDE SYSLIB(CMQEPP);
 %IF @CATALS_NOMPGM = 'STSC65'
 %THEN %DO;
 @INCLUDE HISTSTWA;
 @INCLUDE HISTS011;
       %END;
   DCL      AQACCI         CHAR(4),
            AQENTO         PIC'9',
            AQMAT          CHAR(3),
            AQCOLA         CHAR(8),
            AQDIRE         PTR,
            AQLONM         BIN FIXED (31),
            AQDATL         BIN FIXED (31),
            AQAPLI         CHAR(8),
            AQHCON         BIN FIXED (31),
            AQHOBJ         BIN FIXED (31),
            AQRETC         BIN FIXED (31),
            AQRESP         BIN FIXED (31),
            AQAREA         CHAR(3),
            AQCLIE         CHAR(1),
            AQPRTY         CHAR(1);
 DCL SW_OPEN_GET    BIT(1)   INIT('0'B);
 DCL INVPGM         CHAR(8)  INIT('');
 DCL CQENTO         CHAR(1)  BASED(ADDR(AQENTO));
 DCL MENSAJE        CHAR(1)  BASED(AQDIRE);
 DCL LMQOO     BINARY FIXED (31);  /*  OPCIONES DE OPEN   */
 DCL LMQOD     LIKE MQOD;          /*  OBJECT DESCRIPTOR  */
 DCL LMQMD     LIKE MQMD;          /*  MESSAGE DESCRIPTOR */
 DCL LMQPMO    LIKE MQPMO;         /*  OPCIONES DE PUT    */
 DCL LMQGMO    LIKE MQGMO;         /*  OPCIONES DE GET    */
      DCL PBCLIE    BINARY FIXED (15) INIT(0);
      DCL PBAREA    BINARY FIXED (15) INIT(0);
      DCL PBAPLIC   BINARY FIXED (15) INIT(0);
      DCL PBDIST    BINARY FIXED (15) INIT(0);
      DCL PBMATRI   BINARY FIXED (15) INIT(0);
 DCL PRTY PIC'9' BASED(ADDR(AQPRTY));
 /************/
 /*  MAIN    */
 /************/
 IF   KR3803.MQENTO = '5' |
      KR3803.MQENTO = '7'
 THEN DO;
      KR3803.MQRETC = '';
      KR3803.MQRESP = '';
      RETURN;
      END;
 AQACCI  = KR3803.MQACCI;
 AQENTO  = KR3803.MQENTO;
 AQMAT   = KR3803.MQMAT;
 AQCOLA  = KR3803.MQCOLA;
 AQDIRE  = KR3803.MQDIRE;
 AQLONM  = KR3803.MQLONM;
 AQDATL  = KR3803.MQDATL;
 AQAPLI  = KR3803.MQAPLI;
 AQHCON  = KR3803.MQHCON;
 AQHOBJ  = KR3803.MQHOBJ;
 AQRETC  = KR3803.MQRETC;
 AQRESP  = KR3803.MQRESP;
 AQAREA  = KR3803.MQAREA;
 AQCLIE  = KR3803.MQCLIE;
 AQPRTY  = KR3803.MQPRTY;
 SELECT(AQACCI);
    WHEN('CONN') CALL CONEXION;
    WHEN('CONX') CALL CONEXION;
    WHEN('DISC') CALL DESCONEXION;
    WHEN('RPLY') CALL ABRIR_PUT_CERRAR;
    WHEN('PUT ') CALL ABRIR_PUT_CERRAR;
    WHEN('PUT1') CALL ABRIR_PUT_CERRAR;
    WHEN('PUTN') CALL ABRIR_PUT;
    WHEN('GET ') CALL ABRIR_GET;
    WHEN('GETN') CALL ABRIR_GET;
    WHEN('GETB') CALL ABRIR_GET;
    WHEN('GETW') CALL ABRIR_GET;
    WHEN('FINN') CALL CERRAR;
    WHEN('CMIT') CALL PTO_SINCRONIZ;
    WHEN('BACK') CALL MARCHA_ATRAS;
    OTHER CALL ERROR_MQ;
 END;
 IF   AQRETC = MQCC_OK &
      AQRESP = MQCC_OK
 THEN DO;
      IF   AQACCI = 'PUT ' |
           AQACCI = 'PUT1' |
           AQACCI = 'RPLY' |
           AQACCI = 'GETN' |
           AQACCI = 'GETB'
      THEN KR3803.MQMSGI = LMQMD.MSGID;
      IF   AQACCI = 'GET ' |
           AQACCI = 'GETN' |
           AQACCI = 'GETB' |
           AQACCI = 'GETW'
      THEN DO;
           IF   LMQMD.REPLYTOQ = '' &
                LMQMD.REPLYTOQMGR = ''
           THEN DO;
                KR3803.MQRTQU = LMQMD.REPLYTOQ;
                KR3803.MQRTQM = LMQMD.REPLYTOQMGR;
                KR3803.MQMSGI = LMQMD.CORRELID;
                END;
           PRTY = LMQMD.PRIORITY;
           END;
      END;
 ELSE IF   AQRESP = 2033
      THEN DO;
           %IF @CATALS_NOMPGM = 'STSC65'
           %THEN %DO;
           EXEC CICS ASSIGN INVOKINGPROG(INVPGM) NOHANDLE;
                 %END;
           PUT SKIP LIST(AQRESP,
                         '--STSC65-- '||INVPGM||LMQOD.OBJECTNAME);
           END;
 /* COMENTARIOS PARA LOG DE TIREA
 %IF @CATALS_NOMPGM = 'STSC65'
 %THEN %DO;
 DCL AI_VSIMQLOG CHAR(118) BASED(ADDR(VSIMQLOG));
 DCL 1  VSIMQLOG UNAL,
      2 CLAVE  CHAR(24),
      2 ACCION CHAR(4),
      2 PUTDAT CHAR(8),
      2 PUTTIM CHAR(8),
      2 GETTIM CHAR(8),
      2 TIREAT CHAR(8),
      2 LONPUT BIN FIXED(31),
      2 LONGET BIN FIXED(31),
      2 JOBCIC CHAR(8),
      2 USUARI CHAR(8),
      2 GESTOR CHAR(8),
      2 AREA   CHAR(3),
      2 APLIC  CHAR(8),
      2 COLA   CHAR(8),
      2 MATRIC CHAR(3),
      2 WS     CHAR(2),
      2 ENTORN CHAR(1),
      2 CLIENT CHAR(1);
 IF   AQCOLA = 'MQSINCO' &
      AQRETC = MQCC_OK & AQRESP = MQCC_OK
 THEN IF   AQACCI = 'PUT ' |
           AQACCI = 'PUT1' |
           AQACCI = 'PUTN'
      THEN DO;
           EXEC CICS ADDRESS TWA (PTRTWA);
           PTREPITWA=ADDR(NEWTWA);
           VSIMQLOG        = '';
           VSIMQLOG.CLAVE  = KR3803.MQMSGI;
           VSIMQLOG.ACCION = AQACCI;
           VSIMQLOG.PUTDAT = LMQMD.PUTDATE;
           VSIMQLOG.PUTTIM = LMQMD.PUTTIME;
           VSIMQLOG.LONPUT = AQLONM;
           VSIMQLOG.JOBCIC = STRING(AI_APPLID);
           VSIMQLOG.USUARI = OPERTWA;
           VSIMQLOG.GESTOR = 'MQS'||AQENTO;
           VSIMQLOG.APLIC  = AQAPLI;
           VSIMQLOG.COLA   = AQCOLA;
           VSIMQLOG.AREA   = AQAREA;
           VSIMQLOG.MATRIC = MATTWA;
           VSIMQLOG.WS     = WSTWA;
           VSIMQLOG.ENTORN = AQENTO;
           VSIMQLOG.CLIENT = AQCLIE;
           EXEC CICS WRITE FILE('F2222')
                           RIDFLD(VSIMQLOG.CLAVE)
                           FROM(AI_VSIMQLOG)
                           NOHANDLE;
           END;
      ELSE IF   AQACCI = 'GET ' |
                AQACCI = 'GETN' |
                AQACCI = 'GETB' |
                AQACCI = 'GETW'
           THEN DO;
                VSIMQLOG     = '';
                VSIMQLOG.CLAVE = KR3803.MQMSGI;
                EXEC CICS READ FILE('F2222') UPDATE
                               RIDFLD(VSIMQLOG.CLAVE)
                               INTO(AI_VSIMQLOG)
                               NOHANDLE;
                VSIMQLOG.ACCION = AQACCI;
                VSIMQLOG.GETTIM = TIME();
                VSIMQLOG.TIREAT = LMQMD.PUTTIME;
                VSIMQLOG.LONGET = AQDATL;
                EXEC CICS REWRITE FILE('F2222')
                                  FROM(AI_VSIMQLOG)
                                  NOHANDLE;
                END;
       %END;
    FIN COMENTARIOS PARA LOG DE TIREA */
 KR3803.MQENTO =  AQENTO;
 KR3803.MQMAT  =  AQMAT;
 KR3803.MQCOLA =  AQCOLA;
 KR3803.MQDIRE =  AQDIRE;
 KR3803.MQLONM =  AQLONM;
 KR3803.MQDATL =  AQDATL;
 KR3803.MQAPLI =  AQAPLI;
 KR3803.MQHCON =  AQHCON;
 KR3803.MQHOBJ =  AQHOBJ;
 KR3803.MQRETC =  AQRETC;
 KR3803.MQRESP =  AQRESP;
 KR3803.MQAREA =  AQAREA;
 KR3803.MQCLIE =  AQCLIE;
 KR3803.MQPRTY =  AQPRTY;
 KR3803.MQMWM  =  0;
 /******************************************************************/
 /*  'CONN'  REALIZA LA CONEXION CON EL QUEUE MANAGER*/
 /******************************************************************/
 CONEXION:  PROC REORDER;
      DCL   AQMNAME CHAR(48);
      DCL 1 AQMNAME_R BASED(ADDR(AQMNAME)),
             2 NOMBRE_GEN   CHAR(3),
             2 ENTORNO      PIC'9';
      AQMNAME = 'MQS';
      %IF @CATALS_NOMPGM = 'STSR65'
      %THEN %DO;
      %INCLUDE HISTS022;
      IF   AQACCI = 'CONX'
      THEN ;
      ELSE DO;
           DCL (PLIRETV,SUBSTR) BUILTIN;
           DCL STS022 ENTRY OPTIONS(INTER ASM,RETCODE);
           DCL FI_FORCAT CONDITION;
           DCL RETORN          BIN FIXED (15)  INIT (0);
           KNMDD022 = 'F0MQS';
           CALL STS022(KPAR1_STS022,KPAR2_STS022,KPAR3_STS022);
           IF   PLIRETV = 0
           THEN DO;
                RETORN = PLIRETV;
                PUT SKIP LIST('STSR65E018-ERROR EN EL RDRJFCB,RETORN= '
                           || RETORN);
                SIGNAL CONDITION(FI_FORCAT);
                END;
           CQENTO = SUBSTR(JFCBDSNM,2,1);
           AQCLIE = SUBSTR(JFCBDSNM,3,1);
           END;
            %END;
      %ELSE %IF @CATALS_NOMPGM = 'STSC65'
            %THEN %DO;
      AQENTO = AI_ENTORN;
      AQCLIE = AI_CLIENT;
                  %END;
            %ELSE %IF @CATALS_NOMPGM = 'STSRS5'
                  %THEN %DO;
      AQENTO = KR3803.MQENTO;
      AQCLIE = KR3803.MQCLIE;
                        %END;
      AQMNAME_R.ENTORNO    = AQENTO;
      AQHOBJ = 0;
      CALL MQCONN ( AQMNAME,
                    AQHCON,
                    AQRETC,
                    AQRESP);
      IF   AQRETC = 1 &
           AQRESP = 2002
      THEN DO;
           AQRETC = 0;
           AQRESP = 0;
           END;
 END CONEXION;
 /******************************************************************/
 /*  'DISC'  PROVOCA LA DESCONEXION AL QUEUE MANAGER               */
 /******************************************************************/
 DESCONEXION:  PROC REORDER;
      CALL MQDISC ( AQHCON,
                    AQRETC,
                    AQRESP);
 END DESCONEXION;
 /******************************************************************/
 /*  'PUT '  HACE UN PUT1 SOBRE UNA COLA (OPEN, PUT, CLOSE) NO SYNC*/
 /*  'PUT1'  HACE UN PUT1 SOBRE UNA COLA (OPEN, PUT, CLOSE)        */
 /*  'RPLY'  HACE UN PUT1 SOBRE UNA COLA DE RESPUESTA              */
 /******************************************************************/
 ABRIR_PUT_CERRAR:  PROC REORDER;
      CALL DESC_OBJ;
      CALL DESC_MSG;
      CALL PUT_OPT;
      IF   AQRETC = MQCC_OK & AQRESP = MQCC_OK
      THEN CALL MQPUT1 ( AQHCON,
                         LMQOD,
                         LMQMD,
                         LMQPMO,
                         AQLONM,
                         MENSAJE,
                         AQRETC,
                         AQRESP);
 END ABRIR_PUT_CERRAR;
 /******************************************************************/
 /* 'PUTN'  PONE UN MENSAJE EN UNA COLA. SI EL CAMPO MQHOBJ ESTA   */
 /*         VACIO HACE PRIMERO UN OPEN. ACONSEJABLE EN LOS BUCLES  */
 /******************************************************************/
 ABRIR_PUT:  PROC REORDER;
      IF   AQHOBJ = 0
      THEN DO;
           CALL OPEN_PUT_OPT;
           CALL ABRIR;
           END;
      IF   AQRETC = MQCC_OK & AQRESP = MQCC_OK
      THEN DO;
           CALL DESC_MSG;
           CALL PUT_OPT;
           CALL MQPUT ( AQHCON,
                        AQHOBJ,
                        LMQMD,
                        LMQPMO,
                        AQLONM,
                        MENSAJE,
                        AQRETC,
                        AQRESP);
           END;
 END ABRIR_PUT;
 /******************************************************************/
 /* 'GETN' -TOMA UN MENSAJE DE UNA COLA. SI EL CAMPO MQHOBJ ESTA   */
 /*   VACIO HACE PRIMERO UN OPEN. ACONSEJABLE EN LOS BUCLES  */
 /* 'GETB' -LA OPCION GETB ES IGUAL PERO SE USA TIEMPO DE WAIT     */
 /******************************************************************/
 ABRIR_GET:  PROC REORDER;
 IF   AQHOBJ = 0
 THEN DO;
      CALL OPEN_GET_OPT;
      CALL ABRIR;
  /*  SW_OPEN_GET = '1'B;  PASA ABAJO */
      END;
 IF   AQRETC = MQCC_OK & AQRESP = MQCC_OK
 THEN DO;
      SW_OPEN_GET = '1'B;
      CALL DESC_MSG;
      CALL GET_OPT;
      CALL GET;
 %IF @CATALS_NOMPGM = 'STSC65'
 %THEN %DO;
      IF   AQRESP = MQRC_TRUNCATED_MSG_FAILED
      THEN DO;
           AQRETC = MQCC_OK;
           AQRESP = MQCC_OK;
           DCL VILW           CHAR(1)       INIT(LOW(1));
           PUT SKIP LIST('MQRC_MSG_TRUNCATED',AQDATL,AQLONM);
           PUT SKIP LIST('MQRC_MSG_TRUNCATED',AQDATL,AQLONM);
           EXEC CICS FREEMAIN DATAPOINTER(AQDIRE);
           EXEC CICS GETMAIN SET(AQDIRE)
                             INITIMG(VILW)
                             FLENGTH(AQDATL);
           AQLONM = AQDATL;
           CALL GET;
           END;
       %END;
      IF   AQRETC = MQCC_WARNING &
           AQRESP = MQRC_FORMAT_ERROR
      THEN DO;
           AQRETC = MQCC_OK;
           AQRESP = MQCC_OK;
           PUT SKIP LIST('MQRC_FORMAT_ERROR');
           END;
      END;
 END ABRIR_GET;
 GET:  PROC REORDER;
      CALL MQGET ( AQHCON,
                   AQHOBJ,
                   LMQMD,
                   LMQGMO,
                   AQLONM,
                   MENSAJE,
                   AQDATL,
                   AQRETC,
                   AQRESP);
 END GET;
 /******************************************************************/
 /*  'FINN'  CIERRA UNA COLA QUE HA SIDO ABIERTA PREVIAMENTE CON   */
 /*          UN PUTN                                               */
 /******************************************************************/
 CERRAR:  PROC REORDER;
      DCL LMQCO     BINARY FIXED (31);  /*  OPCIONES DE CLOSE  */
      LMQCO = MQCO_NONE;
      CALL MQCLOSE( AQHCON,
                    AQHOBJ,
                    LMQCO,
                    AQRETC,
                    AQRESP);
 END CERRAR;
 /******************************************************************/
 /* 'CMIT'  COLOCA UN PUNTO DE SINCRONIZACION. LOS MENSAJES        */
 /*         ENVIADOS DESDE EL ULTIMO PTO DE SINCRONIZACION         */
 /*         SE HACEN PERMANENTES                                   */
 /******************************************************************/
 PTO_SINCRONIZ:  PROC REORDER;
      CALL MQCMIT ( AQHCON,
                    AQRETC,
                    AQRESP);
 END PTO_SINCRONIZ;
 /******************************************************************/
 /*  'BACK'  DEJA SIN ENVIAR LOS MENSAJES PUESTOS EN LA COLA       */
 /*          DESPUES DEL ULTIMO PTO DE SINCRONIZACION              */
 /******************************************************************/
 MARCHA_ATRAS:  PROC REORDER;
      CALL MQBACK ( AQHCON,
                    AQRETC,
                    AQRESP);
 END MARCHA_ATRAS;
 /******************************************************************/
 /* OPCIONES DE OPEN PARA PUT                                      */
 /******************************************************************/
 OPEN_PUT_OPT:  PROC REORDER;
      LMQOO = MQOO_FAIL_IF_QUIESCING + MQOO_OUTPUT;
 END OPEN_PUT_OPT;
 /******************************************************************/
 /* OPCIONES DE OPEN PARA GET                                      */
 /******************************************************************/
 OPEN_GET_OPT:  PROC REORDER;
      LMQOO = MQOO_FAIL_IF_QUIESCING + MQOO_INPUT_AS_Q_DEF;
 END OPEN_GET_OPT;
 /******************************************************************/
 /* CONSTRUYE EL DESCRIPTOR DE OBJETO                              */
 /******************************************************************/
 DESC_OBJ:  PROC REORDER;
      DCL QUEUE     CHAR(MQ_Q_NAME_LENGTH) INIT('');
      IF   AQACCI = 'RPLY'
      THEN DO;
           QUEUE = KR3803.MQRTQU;
           END;
      ELSE DO;
           PBAREA  = INDEX(AQAREA, ' ');
           PBAPLIC = INDEX(AQAPLI, ' ');
           PBDIST  = INDEX(AQCOLA, ' ');
           IF   AQENTO = 4 & AQMAT = 'INF'
           THEN AQMAT  = 'INE';
           IF   AQCOLA = 'MQSINCO'
           THEN IF   AQACCI = 'PUT ' |
                     AQACCI = 'PUT1' |
                     AQACCI = 'PUTN'
                THEN AQMAT  = 'R1A';
                ELSE AQMAT  = '   ';
           ELSE
           IF   AQAPLI = 'CAJAVITA'
           THEN IF   AQACCI = 'PUT ' |
                     AQACCI = 'PUT1' |
                     AQACCI = 'PUTN'
                THEN AQMAT  = 'MQV';
                ELSE AQMAT  = '   ';
           ELSE
           IF   AQAPLI = 'KUTXA'
           THEN IF   AQACCI = 'PUT ' |
                     AQACCI = 'PUT1' |
                     AQACCI = 'PUTN'
                THEN AQMAT  = 'MQK';
                ELSE AQMAT  = '   ';
           PBMATRI = INDEX(AQMAT , ' ');
           IF   PBAREA   = 0 THEN PBAREA  = 4;
           IF   PBAPLIC  = 0 THEN PBAPLIC = 9;
           IF   PBDIST   = 0 THEN PBDIST  = 9;
           IF   PBMATRI  = 0 THEN PBMATRI = 4;
                PBCLIE = 1;
                /* PRUEBA TIREA POR TCP */
 %IF @CATALS_NOMPGM = 'STSC65'
 %THEN %DO;
           DCL 1 ID_TERMID BASED(ADDR(EIBTRMID)),
                 2 ID_CON CHAR(1),
                 2 ID_SES CHAR(1);
           IF   AQCOLA = 'MQSINCO'
           THEN DO;
                IF   ID_SES = 'X' |
                     ID_SES = '1'
                THEN DO;
                     PBAPLIC = 5;
                     AQAPLI = 'SS57';
                     END;
                ELSE DO;
                     PBAPLIC = 5;
                     AQAPLI = 'SS57';
                     END;
                END;
       %END;
                /* FIN PRUEBA TIREA POR TCP */
           QUEUE = SUBSTR(AQMAT,1,PBMATRI-1) ||
                   'MQS' || AQENTO           ||  '.'  ||
                   SUBSTR(AQCLIE,1,PBCLIE)   ||
                   SUBSTR(AQAREA,1,PBAREA-1) ||  '.'  ||
                   SUBSTR(AQAPLI,1,PBAPLIC-1)||  '.'  ||
                   SUBSTR(AQCOLA,1,PBDIST-1);
           END;
      LMQOD.OBJECTTYPE = MQOT_Q;        /* SE TRATA DE UNA COLA */
      LMQOD.OBJECTNAME = QUEUE;         /* NOMBRE DE LA COLA    */
 END DESC_OBJ;
 /******************************************************************/
 /* CONSTRUYE EL DESCRIPTOR DEL MENSAJE                            */
 /******************************************************************/
 DESC_MSG:  PROC REORDER;
      DCL QUEUE     CHAR(MQ_Q_NAME_LENGTH) INIT('');
      LMQMD.MSGTYPE =     MQMT_DATAGRAM;
      LMQMD.PERSISTENCE = MQPER_PERSISTENT;
      LMQMD.MSGID =       MQMI_NONE;
      LMQMD.CORRELID =    MQCI_NONE;
      LMQMD.FORMAT   =    MQFMT_STRING;
      IF   AQACCI = 'GET ' |
           AQACCI = 'GETW' |
           AQACCI = 'PUT ' |
           AQACCI = 'PUT1'
      THEN LMQMD.CORRELID = KR3803.MQMSGI;
           PBCLIE = 1;
      IF  (AQACCI = 'PUT ' |
           AQACCI = 'PUT1' |
           AQACCI = 'PUTN') &
          (AQCOLA = 'MQSINCO')
      THEN DO;
           IF   AQCOLA = 'MQSINCO' /* ??????? */
           THEN AQCOLA = MQRTQL;       /* ??????? */
           PBAREA  = INDEX(AQAREA, ' ');
           PBAPLIC = INDEX(AQAPLI, ' ');
           PBDIST  = INDEX(AQCOLA, ' ');
           IF   PBAREA   = 0 THEN PBAREA  = 4;
           IF   PBAPLIC  = 0 THEN PBAPLIC = 9;
           IF   PBDIST   = 0 THEN PBDIST  = 9;
           QUEUE =
              'MQS' || AQENTO           ||  '.'  ||
              SUBSTR(AQCLIE,1,PBCLIE)   ||
              SUBSTR(AQAREA,1,PBAREA-1) ||  '.'  ||
              SUBSTR(AQAPLI,1,PBAPLIC-1)||  '.'  ||
              SUBSTR(AQCOLA,1,PBDIST-1);
           LMQMD.MSGTYPE =     MQMT_REQUEST;
           LMQMD.REPLYTOQ    = QUEUE;
           LMQMD.REPLYTOQMGR = 'MQS' || AQENTO;
        /*    PRUEBAS DE USUARIO TIREA */
           IF   AQENTO = '6' THEN
           LMQMD.REPLYTOQMGR = 'MQS' || '4';
           END;
 END DESC_MSG;
 /******************************************************************/
 /* OPCIONES DE PUT                                                */
 /******************************************************************/
 PUT_OPT:  PROC REORDER;
      IF   AQACCI = 'PUT '
      THEN LMQPMO.OPTIONS = MQPMO_FAIL_IF_QUIESCING +
                            MQPMO_NO_SYNCPOINT;
      ELSE LMQPMO.OPTIONS = MQPMO_FAIL_IF_QUIESCING +
                            MQPMO_SYNCPOINT;
      IF   AQLONM < 1 THEN PUT SKIP LIST('STSR65E019',AQLONM);
      IF   AQLONM < 1 THEN CALL ERROR_MQ;
      IF    VERIFY (AQPRTY,'0123456789') = 0
      THEN DO;
           /*DCL PRTY PIC'9' BASED(ADDR(AQPRTY));*/
           LMQMD.PRIORITY = PRTY;
           END;
 END PUT_OPT;
 /******************************************************************/
 /* OPCIONES DE GET                                                */
 /******************************************************************/
 GET_OPT:  PROC REORDER;
      LMQGMO.OPTIONS = MQGMO_FAIL_IF_QUIESCING + MQGMO_CONVERT +
                       MQGMO_SYNCPOINT;
      IF   AQCOLA = 'MQSINCO'
      THEN DO;
           IF   AQACCI = 'GETW'
           THEN LMQGMO.WAITINTERVAL = 5000;
           ELSE LMQGMO.WAITINTERVAL = 500;
           LMQGMO.OPTIONS = MQGMO_FAIL_IF_QUIESCING
                          + MQGMO_CONVERT
                          + MQGMO_WAIT
                          + MQGMO_SYNCPOINT;
           END;
      ELSE IF  (AQACCI = 'GETN' |
                AQACCI = 'GETB') &
                SW_OPEN_GET
           THEN DO;
                LMQGMO.WAITINTERVAL = 500;
                IF   AQACCI = 'GETB' &
                     KR3803.MQMWM > 0 &
                     KR3803.MQMWM < 1440
                THEN LMQGMO.WAITINTERVAL = KR3803.MQMWM * 60000;
                LMQGMO.OPTIONS = MQGMO_FAIL_IF_QUIESCING
                               + MQGMO_CONVERT
                               + MQGMO_WAIT
                               + MQGMO_SYNCPOINT;
                END;
 END GET_OPT;
 /******************************************************************/
 /*   ABRE UNA COLA DE MQSERIES                                    */
 /******************************************************************/
 ABRIR:  PROC REORDER;
      CALL  DESC_OBJ;
      CALL MQOPEN ( AQHCON,
                    LMQOD,
                    LMQOO,
                    AQHOBJ,
                    AQRETC,
                    AQRESP);
 END ABRIR;
 /******************************************************************/
 /* TRATMIENTO DE ERRORES                                          */
 /******************************************************************/
 ERROR_MQ:  PROC REORDER;
      AQRETC = 2;
      AQRESP = 2000;           /* ERROR EN MQACCI  */
      KR3803.MQRETC =  AQRETC;
      KR3803.MQRESP =  AQRESP;
      %IF @CATALS_NOMPGM = 'STSC65'
      %THEN %DO;
      %INCLUDE HISTS022;
            %END;
      %ELSE %DO;
      EXEC CICS RETURN;
            %END;
 END ERROR_MQ;
