000100 identification division.
000200 program-id. jclsend.
000300**************************************************************
000400* This program sends JCL to JES2 queues using the CICS
000500* SPOOL interface.
000600*
000700* The userid must be "INTRDR"
000800*
000900* The node must be a valid MVS node id...you should get this
001000* information from your MVS system programmer. In this program
001100* you must modify the value clause for data element JCL-NODE
001200*
001300* It submits JCL information from a table built in working-
001400* storage; each entry is 80 bytes and consists of a JCL
001500* statement
001600*
001700* Author: Real LOngchamps - LONGCHAMPS Informatique Inc
001800*
001900****************************************************************
002000 Data Division.
002100 Working-Storage section.
002200 01  jcl-parm.
002300     05  jcl-token                pic x(8) value low-values.
002400     05  jcl-node                 pic x(8) value 'N1'.
002500     05  jcl-userid               pic x(8) value 'INTRDR'.
002600     05  jcl-class                pic x    value 'A'.
002700     05  jcllen                   pic s9(8) value 80 comp.
002800
002900 01  messages.
003000     05  mess1  pic x(80) value '***error opening spool'.
003100     05  mess2  pic x(80) value '***error writing to spool'.
003200     05  mess3  pic x(80) value '***error closing spool '.
003300     04  mess4  pic x(80) value '**jcl submitted successfully**'.
003400
003500 01  jcl-table.
003600     05  pic x(80)
               value "//RML00A JOB ,'REAL LONGCHAMPS',CLASS=A".
003700     05  PIC X(80) VALUE '//STEP1  EXEC PGM=IEFBR14'.
003800     05  pic x(80) value '//DD1 DD DSN=RML00.CICS.CNTL,DISP=SHR'.
003900     05  PIC X(80) VALUE '//'.
003910
004000 01  filler   REDEFINES JCL-TABLE.
004100     05  jcl-stmt   PIC X(80)    OCCURS 4 TIMES
004200                                 INDEXED BY SUB.
004400
004300 01  jcl-statement          pic x(80).

004400
004500 procedure division.
004600
004700     exec cics spoolopen output
004800                          userid(jcl-userid)
004900                          token(jcl-token)
005000                          node(jcl-node)
005100                          class(jcl-class)
005200                          nocc
005300                          print
005400                          resp(eibresp)
005500     end-exec
005600
005700     evaluate eibresp
005800         when dfhresp(normal) continue
005900         when other    exec cics send from(mess1)
006000                                      erase
006100                                      length(length of mess1)
006200                       end-exec
006300                       exec cics return end-exec
006400     end-evaluate
006500
006600     perform  varying sub from 1 by 1 until sub > 4
006700
006800           move jcl-stmt (sub) to jcl-statement
006900           exec cics spoolwrite token(jcl-token)
007000                                from(jcl-statement)
007100                                flength(jcllen)
007200                                resp(eibresp)
007300           end-exec
007400
007500           evaluate eibresp
007600               when dfhresp(normal)    continue
007700           when other      exec cics send from(mess2)
007800                                          erase
007900                                          length(length of mess2)
008000                           end-exec
008100                           exec cics return end-exec
008200           end-evaluate
008300
008400     end-perform
008500
008600     exec cics spoolclose token(jcl-token)
008700                          resp(eibresp)
008800     end-exec
008900
009000     evaluate eibresp
009100         when dfhresp(normal) continue
009200         when other    exec cics send from(mess3)
009300                                      erase
009400                                      length(length of mess3)
009500                       end-exec
009600                       exec cics return end-exec
009700     end-evaluate
009800
009900     exec cics send from(mess4)
010000                    erase
010100                    length(length of mess4)
010200     end-exec
010300
010400     exec cics return end-exec
010500
010600     stop run.