JES2 Spool examples

Here,you will find some of the host (MVS) programming details for printing-to-email from the MVS/JES2 host system.


  • Example Batch JCL for Email Print
  • Example IMS PCB for IMS Email Print
  • Example of the WORKING-STORAGE needed for the IMS CHNG call
  • Example of the PROCEDURE DIVISION code needed for the IMS CHNG call
  • Example of the WORKING-STORATE needed for the IMS ISRT call
  • Example of the PROCEDURE DIVISION code needed for the IMS ISRT call
  • Example of the WORKING-STORAGE needed for the CICS SPOOLOPEN call
  • Example of the PROCEDURE DIVISION code needed for the CICS SPOOLOPEN call
  • Example of the WORKING-STORAGE needed for the CICS SPOOLWRITE call
  • Example of the PROCEDURE DIVISION code needed for the CICS SPOOLWRITE call
  • Example of the PROCEDURE DIVISION code needed for the CICS SPOOLCLOSE call

    Batch JCL for Email Print

    The following is an example of MVS JES2 JCL that can use the PTE01 print-to-email setup.
    //JOBNAME JOB (9999),'JOB DESCRIPTION',CLASS=E,MSGCLASS=A,PRTY=8 
    //*
    //EMAIL OUTPUT TITLE='email subject line',
    //             ADDRESS=('EMAIL: target_email@address') 
    //*
    //STEPONE EXEC PGM=SOMEPGM
    //SYSOUT  DD   SYSOUT=A,DEST=PTE01,OUTPUT=EMAIL 
    //
    

    The //EMAIL OUTPUT directive provides report distribution parameters for any report that choosed to use them. In this case, it specifies a report title that (when interpreted by the Linux jesprt lpd printer filter) will be used as an email subject line, and a report distribution address that (again, when interpreted by the lpd filter) will be used as an email address.

    The DEST=PTE01 parameter of the SYSOUT statement directs the output to be spooled to the PTE01 pseudo-printer, which ultimately routes the print data to the Linux jesprt lpd printer.

    The OUTPUT=EMAIL parameter of the SYSOUT statement ensures that the output will carry flash page parameters derived from the //EMAIL OUTPUT directive, so that the Linux jesprt lpd printer can properly route the print to the proper email address.


    PCB for IMS Email Print

    In IMS, every transaction lists it's databases in a PSB. In our case, we had to access a special database, called a modifiable alternate non-express PCB, so our PSB had to include this special PCB.

    *---------------------------------------------------------------------* 
    *  PSB "SAMPLE" for IMS tx "SAMPLE"                                   *
    *                                                                     *
    *   PCB "APM00001" is a modifiable alternate non-express PCB          *
    *---------------------------------------------------------------------*
    *
             PCB    TYPE=TP,MODIFY=YES,PCBNAME=APM00001,EXPRESS=NO
    *	
    	 PSBGEN LANG=COBOL,PSBNAME=SAMPLE,CMPAT=YES
    *---------------------------------------------------------------------*
             END
    

    The format and use of the PSB and it's parameters (including the definition of the modifiable alternate non-express PCB) can be found in Section 1.2 of the IMS Version 7 Utilities Reference: System manual.


    IMS CHNG call WORKING-STORAGE

    The IMS CHNG call takes a number of parameters, three of which are defined by the application program. The critical parameter here is the WS-PTE-OPTS variable which carries settings for report management and distribution that will ultimately be placed on the JES2 flash page. These values are then used by the jesprt print filter to determine the email destination and subject.

    The WORKING-STORAGE for the CHNG call looks like:

           01  WS-PRINT-TO-EMAIL.
    
               03    WS-PTE-LTERM            PIC X(8)       VALUE 'PTE01'.
    
    	   03    WS-PTE-OPTS.
    	    05   WS-PTE-OPTS-LL          PIC S9(4) COMP VALUE +107.
    	    05   FILLER                  PIC S9(4) COMP VALUE ZERO.
    	    05   WS-PTE-IAFP             PIC X(8)       VALUE 'IAFP=N1M'.
    	    05   WS-PTE-PRTO             PIC X(6)       VALUE ',PRTO='.
    	    05   WS-PTE-PRTO-LL          PIC S9(4) COMP VALUE +87.
    	    05   WS-PTE-PRTO-TEXT.
    	     07  FILLER                  PIC X(09)      VALUE 'CLASS(A),'.
    	     07  FILLER                  PIC X(12)      VALUE 'DEST(PTE01),'.
    	     07  FILLER                  PIC X(28)      VALUE 'TITLE(''email subject line''),'.
    	     07  FILLER                  PIC X(38)      VALUE 'ADDRESS(''EMAIL: target_email@address'')'. 	    
    
               03    WS-PTE-FDBK            PIC X(40)       VALUE SPACES.
    

    where

    • WS-PTE-LTERM contained the name of the IMS LTERM to be used in the CHNG call,
    • WS-PTE-OPTS contained the print options to be passed to the IMS Spool API
      • WS-PTE-OPTS-LL was the length (in bytes) of the entire WS-PTE-OPTS area,
      • WS-PTE-IAFP contained the IAFP options for the print stream
        • N indicated that no line control characters would be presented in the data
        • 1 indicated that the output would be placed on the SYSOUT HOLD queue until spooling completed successfully, and
        • M indicated that IMS would manage error processing
      • WS-PTE-PRTO contained the introduction text for the PRTO options, which were similar to the OUTPUT JCL statement options,
      • WS-PTE-PRTO-LL was the length (in bytes) of the WS-PTE-PRTO-TEXT area,
      • WS-PTE-PRTO-TEXT (and it's subordinate variables) contained the individual PRTO options, including the printer DEST (PTE01), the TITLE (containing our email subject line), and the ADDRESS (containing our target email address).
    • and WS-PTE-FDBK was the feedback area for the IMS DLI calls

    The definition of the PRTO option can be found in Section 1.3.2 of the IMS Version 7 Application Programming: Transaction Manager manual. Additional material defining the parameters that may be included in the PRTO option can be found in Section 1.56 of the TSO/E V2R5 Command Reference manual.


    IMS CHNG call PROCEDURE DIVISION logic

    The modifiable non-express alternate PCB can be used for a number of different database and data communications tasks. Here, we want to use it to spool output to JES2, so we must alter it's settings using an IMS CHNG call.

    The CHNG call will use the parameters prepared above to instruct IMS to send any data to the JES2 print spool. This code looks like:

          *    *********************************************************** 
          *    * IF NOT ALREADY SET, SET LENGTHS IN WS-PTE-OPTS          *
          *    ***********************************************************
               MOVE LENGTH OF WS-PTE-OPTS      TO WS-PTE-OPTS-LL.
    	   MOVE LENGTH OF WS-PTE-PRTO-TEXT TO WS-PTE-PRTO-LL.
    
          *    ***********************************************************
          *    *  SWITCH ALTPCB TO IMS SPOOL, USING PRINT-TO-EMAIL PARMS *
          *    ***********************************************************
               CALL 'CBLTDLI' USING IMS-CHNG,
    	                        CALTPCB,
    				WS-PTE-LTERM,
    				WS-PTE-OPTS,
    				WS-PTE-FDBK
    	   END-CALL.
          *    ***********************************************************
    
    where

    • IMS-CHNG was the IMS-defined opcode for the CHNG call,
    • CALTPCB was the IMS-defined PSB for the APM00001 modifiable alternate non-express PCB we used to interact with the IMS Spool API,
    • WS-PTE-LTERM was the destination LTERM (as defined in the WORKING-STORAGE above),
    • WS-PTE-OPTS was the Spool API management and report distribution options (also defined in the WORKING-STORAGE above), and
    • WS-PTE-FDBK was the IMS CALL feedback area (also defined in the WORKING-STORAGE above)

    Instructions on the definition and use of the CHNG call can be found in Section 1.3.2 of the IMS Version 7 Application Programming: Transaction Manager manual.


    IMS ISRT call WORKING-STORAGE

    JES2 expects that print data released to the spool through the IMS SPOOL API will be formatted as variable length records within variable length blocks. Thus, each block of print data must be prefixed with a "block length", and each line of print data within the block must be prefixed with a "line length". Here, we intend to spool one line per block (because of the nature of the print service our code provided), so our block (WS-EMAIL-LINE) contains only one line of print data (WS-EMAIL-BSAM-DATA).

           01  WS-EMAIL-LINE.
               03    WS-EMAIL-BDW-LL         PIC S9(4) COMP VALUE +88.
    	   03    FILLER                  PIC S9(4) COMP VALUE ZERO. 
    	   03    WS-EMAIL-BSAM-DATA.
    	    05   WS-EMAIL-BSAM-RDW-LL    PIC S9(4) COMP VALUE +84.
    	    05   FILLER                  PIC S9(4) COMP VALUE ZERO.
    	    05   WS-EMAIL-BSAM-TEXT      PIC X(80).
    
    where

    • WS-EMAIL-LINE held the IMS Spool API description of one block of print text,
    • WS-EMAIL-BDW-LL contained the length of the WS-EMAIL-LINE block,
    • WS-EMAIL-BSAM-DATA held the IMS Spool API description of one line of print text,
    • WS-EMAIL-BSAM-RDW-LL contained the length of the WS-EMAIL-BSAM-DATA line, and
    • WS-EMAIL-BSAM-TEXT contained the line of text to be spooled

    IMS ISRT call PROCEDURE DIVISION logic

    The logic necessary to spool lines of output is moderately simple. The text to be spooled must be placed into the WORKING-STORAGE workarea, the line and block lengths are then computed and set, and the block of print data is ISRTed into the print spool.

          *    *********************************************************** 
          *    * SET THE CONTENTS OF THE LINE TO BE EMAILED              *
          *    ***********************************************************
               MOVE 'text to be emailed'         TO WS-EMAIL-BSAM-TEXT.
    	   
          *    ***********************************************************
          *    * IF NOT ALREADY SET, SET LENGTHS IN WS-EMAIL-LINE        *
          *    ***********************************************************
               MOVE LENGTH OF WS-EMAIL-LINE      TO WS-EMAIL-BDW-LL.
    	   MOVE LENGTH OF WS-EMAIL-BSAM-DATA TO WS-EMAIL-BSAM-RDW-LL.
    
          *    ***********************************************************
          *    *  SPOOL ONE LINE OF PRINT TO THE PRINT-TO-EMAIL PCB      *
          *    ***********************************************************
               CALL 'CBLTDLI' USING IMS-ISRT,
    	                        CALTPCB,
    				WS-EMAIL-LINE
    	   END-CALL.
          *    ***********************************************************
    
    where

    • IMS-ISRT was the IMS-defined opcode for the ISRT call,
    • CALTPCB was the IMS-defined PSB for the APM00001 modifiable alternate non-express PCB we used to interact with the IMS Spool API, and
    • WS-EMAIL-LINE was the spool print line defined in the WORKING-STORAGE above

    Instructions on the definition and use of the ISRT call can be found in Section 1.3.7 of the IMS Version 7 Application Programming: Transaction Manager manual.


    CICS SPOOLOPEN call WORKING-STORAGE

    The WORKING-STORAGE for the SPOOLOPEN call looks like:

            01    FILLER.
              03  WS-JES-TOKEN                   PIC X(8).
    
               03  WS-JES-OUTDESC-PTR            USAGE IS POINTER.
               03  WS-JES-OUTDESC-ADDR
    	       REDEFINES WS-JES-OUTDESC-PTR  PIC 9(9) COMP.
    
               03  WS-JES-OUTDESC.
                05   WS-JES-OUTDESC-LEN          PIC 9(9) COMP VALUE +82.
                05   WS-JES-OUTDESC-TXT.
                 07  FILLER                      PIC X(12)     VALUE 'DEST(PTE01) '.
                 07  FILLER                      PIC X(28)     VALUE 'TITLE(''email subject line'') '.
                 07  FILLER                      PIC X(38)     VALUE 'ADDRESS(''EMAIL: target_email@address'')'. 
    
    
           LINKAGE SECTION.
    
              01  LS-OUTDESC.                                        
                  03  LS-OUTDESC-ADDR            PIC 9(9) COMP. 
                  03  LS-OUTDESC-TEXT            PIC X(1020).   
    
    where

    • WS-JES-TOKEN was used to store a spooling "handle" generated by the CICS SPOOL API when the spool was opened,
    • WS-JES-OUTDESC-PTR and WS-JES-OUTDESC-ADDR were used to store the address of the block of memory allocated to store the spool parameters for the CICS SPOOL API,
    • WS-JES-OUTDESC contains the PRTO print options to be passed to the CICS SPOOL API:
      • WS-JES-OUTDESC-LEN contained the length of the entire PRTO option block, including itself
      • WS-JES-OUTDESC-TXT (and it's subordinate variables) contained the individual PRTO options, including the printer DEST (PTE01), the TITLE (containing our email subject line), and the ADDRESS (containing our target email address).
    • LS-OUTDESC and it's subordinate variables were used to provide an indirect reference to the PRTO option block prepared from the WS-JES-OUTDESC WORKING-STORAGE variables.

    The definition of the PRTO option can be found in Section 1.229 of the CICS TS for OS/390 V1R3 Application Programming Reference manual. Additional material defining the parameters that may be included in the PRTO option can be found in Section 1.56 of the TSO/E V2R5 Command Reference manual.


    CICS SPOOLOPEN call PROCEDURE DIVISION logic

    The CICS SPOOL API requires that we pass the CICSOPEN function a pointer to a pointer to the PRTO parameters. This means that we have to perform some COBOL trickery, because COBOL is brain-dead when it comes application management of pointers.

          *       ************************************************************ 
          *       * FIRST, WE ALLOCATE SOME STORAGE TO BUILD OUR PARMLIST IN *
          *       ************************************************************
                  EXEC CICS
                      GETMAIN
                      SET(WS-JES-OUTDESC-PTR)
                      LENGTH(1024)
                  END-EXEC
    
          *       ************************************************************
          *       * IF THAT WORKED, WE COPY OUR PARMLIST INTO THE STORAGE    *
          *       * AND PERFORM THE CICS SPOOLOPEN                           *
          *       ************************************************************
                  IF WS-CICS-RESP IS EQUAL TO DFHRESP(NORMAL)
    
          *           ********************************************************
          *           * PREPARE THE DYNAMIC MEMORY TO RECEIVE THE PARMLIST   *
          *           * (WE RESORT TO THIS TRICKERY BECAUSE COBOL IS MOSTLY  *
          *           * BRAIN-DEAD WHEN IT COMES TO POINTERS-TO-POINTERS)    *
          *           ********************************************************
                      SET ADDRESS OF LS-OUTDESC     TO WS-JES-OUTDESC-PTR
                      MOVE WS-JES-OUTDESC-ADDR      TO LS-OUTDESC-ADDR
                      ADD 4                         TO LS-OUTDESC-ADDR
    
          *           ********************************************************
          *           * SET THE PARMLIST LENGTH, IF IT HASN'T BEEN SET YET   *
          *           ********************************************************
                      MOVE LENGTH OF WS-JES-OUTDESC-TXT
                                                    TO WS-JES-OUTDESC-LEN
    
          *           ********************************************************
          *           * COPY THE COMPLETED PARMLIST TO THE ALLOCATED STORAGE *
          *           ********************************************************
                      MOVE WS-JES-OUTDESC           TO LS-OUTDESC-TEXT
    
          *           ********************************************************
          *           * EXECUTE THE CICS SPOOLOPEN TO OPEN THE PRINT OUTPUT  *
          *           ********************************************************
                      EXEC CICS
                          SPOOLOPEN OUTPUT
                          PRINT NOCC RECORDLENGTH(132)
                          CLASS('A') NODE('*') USERID('*')
                          OUTDESCR(WS-JES-OUTDESC-PTR)
                          TOKEN(WS-JES-TOKEN)
                          RESP(WS-CICS-RESP) RESP2(WS-CICS-RESP2)
                      END-EXEC
    
          *           ********************************************************
          *           * RELEASE THE STORAGE WE GETMAINED EARLIER             *
          *           ********************************************************
                      EXEC CICS
                          FREEMAIN
                          DATAPOINTER(WS-JES-OUTDESC-PTR)
                      END-EXEC
                  END-IF
          *       ************************************************************
    

    Before we can SPOOLOPEN, we have to get some temporary storage (through a GETMAIN call). This gives us a pointer that we can manipulate and store. Once we have the storage, we make it addressable to the COBOL code and adjust the pointer so that it points to the data area we're going to use. We copy our PRTO parameters into this block of memory, because we'll use the pointer to this storage in our SPOOLOPEN call (I said that COBOL was brain-dead, didn't I?).

    Once we've set up our parameterlist, we SPOOLOPEN the spooling system. SPOOLOPEN returns a "token" (essentially, a file handle for the SPOOL API) that we must save, and use in the rest of the SPOOL API calls.

    Finally, we FREEMAIN the allocated block of storage, because we no longer need it.


    CICS SPOOLWRITE call WORKING-STORAGE

    This area is very simple; it's just a 132-byte buffer that we will populate with a single line for the SPOOLWRITE call. We'll iterate through all our print lines, repeatedly populating this field with a single line's worth of data and invoking SPOOLWRITE until all the print data has been spooled.

            01    FILLER.
                  03  WS-JES-PRTLINE         PIC X(132). 
    
    


    CICS SPOOLWRITE call PROCEDURE DIVISION logic

    Here is one iteration of our line output logic. The single line of report data is placed in WS-JES-PRTLINE, and the CICS SPOOLWRITE function is invoked to write it out.

          *       ************************************************************ 
          *       * IF STILL OK, WRITE A LINE TO THE SPOOL                   *
          *       ************************************************************
                  IF WS-CICS-RESP IS EQUAL TO DFHRESP(NORMAL)
    	      
          *          ********************************************************* 
          *          * MOVE THE PRINT DATA INTO THE BUFFER                   *
          *          *********************************************************
                      MOVE 'data to print'  TO WS-JES-PRTLINE
    	      
          *          ********************************************************* 
          *          * SPOOLWRITE THE BUFFER                                 *
          *          *********************************************************
                      EXEC CICS
                        SPOOLWRITE
                        TOKEN(WS-JES-TOKEN)
                        LINE FROM(WS-JES-PRTLINE)
                        RESP(WS-CICS-RESP) RESP2(WS-CICS-RESP2)
                      END-EXEC
                  END-IF
          *       ************************************************************
    


    CICS SPOOLCLOSE call PROCEDURE DIVISION logic

    Finally, we close the report with a SPOOLCLOSE call, which releases the spooled data to JES for printing.

          *       ************************************************************ 
          *       * IF STILL OK, CLOSE THE SPOOL                             *
          *       ************************************************************
                  IF WS-CICS-RESP IS EQUAL TO DFHRESP(NORMAL)
    	      
          *          ********************************************************* 
          *          * CLOSE THE SPOOL CONNECTION                            *
          *          *********************************************************
                      EXEC CICS
                          SPOOLCLOSE KEEP
                          TOKEN(WS-JES-TOKEN)
                          RESP(WS-CICS-RESP) RESP2(WS-CICS-RESP2)
                      END-EXEC
                  END-IF
          *       ************************************************************
    

    After this, JES will take the spooled print data and print it to the pseudo-printer named in the parameters passed to the SPOOLOPEN call.



    Copyright (©) Lew Pitcher, March 2002