***********************************************************************
* BATSUB  - SUBMIT A SUITE OF BATCH JOBS TO THE INTERNAL READER       *
*                                                                     *
* INPUT FILES:                                                        *
*  - JOBLST - FB80 FILE, FIRST 8 CHARS ARE THE JOB NAME TO SUBMIT     *
*  - JCLLIB - PDS, CONTAINING THE JCL TO SUBMIT                       *
*                                                                     *
* OUTPUT FILES:                                                       *
*  - INTRDR - FB80, DEFINED AS 'SYSOUT=(A,INTRDR)', TYPICALLY.        *
***********************************************************************
         $REGS
BATSUB   $ENTER
MAIN     $INIT
         OPEN  (JOBLST,INPUT)               OPEN FILES
         OPEN  (JCLLIB,INPUT)               )
         OPEN  (INTRDR,OUTPUT)              )
*
         LH    R2,DCBLRECL-IHADCB+JCLLIB    GET FILE ATTRIBUTES
         STH   R2,JCLLRECL                  ) & SAVE.
         LH    R2,DCBBLKSI-IHADCB+JCLLIB    )
         STH   R2,JCLBLKSI                  )
         GETMAIN R,LV=(2)                   ALLOCATE I/O BUFFER
         ST    R1,IOADRA                    )
*
* USE THE JOB NAME FROM JOBLST, AND FIND THAT MEMBER IN THE PDS
MAIN1000 EQU   *
         GET   JOBLST,LSTWRK                GET A JOB
         MVC   JOBNAME,LSTWRK               )
         FIND  JCLLIB,JOBNAME,D             FIND IT IN THE PDS
         LTR   RF,RF                        OK?
         BZ    MAIN1100                     YES - CONTINUE
*                                           NO  - ABEND
         MVC   MSGE01J(8),JOBNAME
         WTO   TEXT=MSGE01
         ABEND 001,DUMP
*
* MEMBER FOUND, NOW READ BLOCK-BY-BLOCK
MAIN1100 EQU   *
         MVC   MSGI02J(8),JOBNAME           WRITE MSG TO LOG
         WTO   TEXT=MSGI02                  )
*
MAIN2000 EQU   *
         L     R2,IOADRA                    R2 = I/O BUFFER ADDR
         READ  DECBA,SF,JCLLIB,(2),'S'      READ A BLOCK
         CHECK DECBA                        )
*
         LH    R3,JCLBLKSI                  LEN(R3) = BLKSZ - RESID.
         L     R4,DECBA+16                  ) LOAD 'IOB', GET RESIDUAL
         LH    R4,14(R4)                    ) FROM 'CSW'.
         SR    R3,R4                        ) SUB FROM BLKSZ
         LH    R4,JCLLRECL                  R4 = LRECL
         LR    R5,R2                        R5 = LAST RECORD ADDR:
         AR    R5,R3                        ) IOADDR + BLKLEN - LRECL
         SR    R5,R4                        )
* LOOP FOR EACH RECORD
MAIN2100 EQU   *
         PUT   INTRDR,(R2)                  WRITE RECORD
         BXLE  R2,R4,MAIN2100               ITERATE & BRANCH
         B     MAIN2000                     READ NEXT BLOCK
*
MAIN3000 EQU   *                            MEMBER EOF
         B     MAIN1000                     READ NEXT MEMBER
*
MAIN9000 EQU   *
         L     R2,IOADRA                    FREE I/O BUFFER
         LH    R3,JCLBLKSI                  )
         FREEMAIN R,A=(2),LV=(3)            )
         CLOSE JOBLST                       CLOSE FILES
         CLOSE JCLLIB                       )
         CLOSE INTRDR                       )
         B     MAINEXIT
         LTORG
*
* ---------------------------------------------------------------------
*
* SAVEAREA
         $SAVE
*
* DCBS/DECBS
JOBLST   DCB   DDNAME=JOBLST,MACRF=GM,DSORG=PS,RECFM=FB,LRECL=80,      X
               EODAD=MAIN9000
JCLLIB   DCB   DDNAME=JCLLIB,MACRF=R,DSORG=PO,RECFM=FB,                X
               EODAD=MAIN3000
INTRDR   DCB   DDNAME=INTRDR,MACRF=PM,DSORG=PS,RECFM=FB,LRECL=80
*
* WORK AREA
LSTWRK   DS    CL80
JOBWRK   DS    CL80
JOBNAME  DS    CL8
IOADRA   DS    A
JCLLRECL DS    H
JCLBLKSI DS    H
MSGE01   DC    AL2(80),CL80'BATSUB-01E - ERROR IN FIND FOR XXXXXXXX'
MSGE01J  EQU   MSGE01+33
MSGI02   DC    AL2(80),CL80'BATSUB-02I - SUBMITTING JOB XXXXXXXX'
MSGI02J  EQU   MSGI02+30
*
* DSECTS
         DCBD  DEVD=DA,DSORG=PO
         END