             PGM

/*T: Test shell                                                      */
/*O: CRTBNDCL DBGVIEW(*ALL) LOG(*NO)                                 */
/*                                                                    +
 * Copyright (c) 2009 Rory Hewitt                                     +
 * All rights reserved.                                               +
 *                                                                    +
 * Redistribution and use in source and binary forms, with or without +
 * modification, are permitted provided that the following conditions +
 * are met:                                                           +
 * 1. Redistributions of source code must retain the above copyright  +
 *    notice, this list of conditions and the following disclaimer.   +
 * 2. Redistributions in binary form must reproduce the above         +
 *    copyright notice, this list of conditions and the following     +
 *    disclaimer in the documentation and/or other materials provided +
 *    with the distribution.                                          +
 *                                                                    +
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ''AS IS'' +
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED  +
 * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A    +
 * PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR   +
 * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,    +
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT   +
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF   +
 * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED    +
 * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT        +
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN  +
 * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE    +
 * POSSIBILITY OF SUCH DAMAGE.                                        +
 */

/* Work variables */

             DCL        VAR(&MATPGMNM)   TYPE(*CHAR) LEN(80)
             DCL        VAR(&THISPGM)    TYPE(*CHAR) LEN(10)
             DCL        VAR(&THISLIB)    TYPE(*CHAR) LEN(10)

             DCL        VAR(&USER)       TYPE(*CHAR) LEN(10)
             DCL        VAR(&KEY)        TYPE(*CHAR) LEN(6)
             DCL        VAR(&DATA)       TYPE(*CHAR) LEN(5000)
             DCL        VAR(&MSGID)      TYPE(*CHAR) LEN(7)
             DCL        VAR(&MSGDTA)     TYPE(*CHAR) LEN(132)

/* Error-handling variables */

             DCL        VAR(&RSNM0100)   TYPE(*CHAR) LEN(38)
             DCL        VAR(&CALSTKCN)   TYPE(*CHAR) LEN(4) +
                                         VALUE(X'00000001')
             DCL        VAR(&CALSTKEQ)   TYPE(*CHAR) LEN(20) +
                                         VALUE('*NONE     *NONE     ')
             DCL        VAR(&CALSTKIDLN) TYPE(*CHAR) LEN(4) +
                                         VALUE(X'0000000A')
             DCL        VAR(&CALSTKID)   TYPE(*CHAR) LEN(10) +
                                         VALUE('*PGMBDY')

/* Global MONMSG */

             MONMSG     MSGID(CPD0000 CPF0000 MCH0000) EXEC(GOTO +
                          CMDLBL(ERROR))

/*===================================================================*/
/* PROLOGUE                                                          */
/*===================================================================*/

/* Get the name/library of this program */

             CHGVAR     &MATPGMNM X'00000050000000500000000000000000'
             CALLPRC    '_MATPGMNM' &MATPGMNM
             CHGVAR     &THISPGM %SST(&MATPGMNM 51 10)
             CHGVAR     &THISLIB %SST(&MATPGMNM 19 10)

/* Set the error-handling variables */

             CHGVAR     VAR(&RSNM0100) VALUE(&CALSTKCN || &CALSTKEQ +
                          || &CALSTKIDLN || &CALSTKID)

/*===================================================================*/
/* MAINLINE                                                          */
/*===================================================================*/

/* Create the DQ1 data queue in QGPL with a key length of 6 bytes */

             CRTDTAQ    DTAQ(QGPL/DQ1) MAXLEN(5000) SEQ(*KEYED) +
                          KEYLEN(6) SENDERID(*YES)
             MONMSG     MSGID(CPF9870)

/* Start the Data Queue Server to process the data queue. Use the */
/* job number of the Data Queue Server job as the data queue key. */
/* Specify the default DQHDLR program as the data queue handler.  */

             DQ         ACTION(*START) DTAQ(QGPL/DQ1) KEY(*JOBNBR) +
                          HANDLER(DQHDLR)

/* Receive the CPC1221 completion message and parse out the job */
/* number of the Data Queue Server to pass as a key.            */

             RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDTA) +
                          MSGID(&MSGID)
             IF         COND(&MSGID = 'CPC1221') THEN(DO)
                CHGVAR     VAR(&KEY) VALUE(%SST(&MSGDTA 21 6))
             ENDDO

/* Send a character string to the Data Queue Server. The data queue */
/* handler (DQHDLR) will simply write it to the joblog of the Data  */
/* Queue Server job.                                                */

             CHGVAR     VAR(&DATA) VALUE('Character string, which +
                          will show up in the joblog')
             DQ         ACTION(*SEND) DTAQ(QGPL/DQ1) KEY(&KEY) +
                          DATA(&DATA)

/* Send a command string to the Data Queue Server. The data queue   */
/* handler (DQHDLR) will execute it. In this case, it will run the  */
/* DSPLIBL command which will create a spooled file in the Data     */
/* Queue Server job.                                                */

             CHGVAR     VAR(&DATA) VALUE('CMD:DSPLIBL')
             DQ         ACTION(*SEND) DTAQ(QGPL/DQ1) KEY(&KEY) +
                          DATA(&DATA)

/* Send a command string to the Data Queue Server. The data queue   */
/* handler (DQHDLR) will execute it. In this case, it will run the  */
/* SNDMSG command which will send a message to the user running     */
/* THIS program.                                                    */

             RTVJOBA    USER(&USER)
             CHGVAR     VAR(&DATA) VALUE('CMD:SNDMSG MSG(''Hi +
                          there!'') TOUSR(' |< &USER |< ')')
             DQ         ACTION(*SEND) DTAQ(QGPL/DQ1) KEY(&KEY) +
                          DATA(&DATA)

/* End the Data Queue Server */

             DQ         ACTION(*END) DTAQ(QGPL/DQ1) KEY(&KEY)

             GOTO       CMDLBL(ENDPGM)

/*===================================================================*/
/* Error-handling                                                    */
/*===================================================================*/

 ERROR:
             CALL       PGM(QMHMOVPM) PARM('    ' '*DIAG     +
                          *INFO     *COMP     ' X'00000003' +
                          '*PGMBDY   ' X'00000001' X'0000000800000000')
             CALL       PGM(QMHRSNEM) PARM('    ' +
                          X'0000000800000000' &RSNM0100 X'00000026' +
                          'RSNM0100' '*' X'00000000')

/*===================================================================*/
/* Program end and clean-up                                          */
/*===================================================================*/

 ENDPGM:
             RMVMSG     CLEAR(*ALL)
             MONMSG     MSGID(CPF0000)
             ENDPGM

