Following is the z/OS COBOL functional equivalent of the C procedure shown previously (see Sample JCL for C). For a z/VSE sample in COBOL, see Sample JCL for z/VSE.
The following JCL example is for z/OS sites.
Note: Use the following as a guide to prepare your JCL. The JCL statements are for example only. Lowercase letters in a statement indicate a value you must supply. Code all statements to your site and installation standards.
//jobname See the note above.
// CLASS=A,MSGCLASS=X,REGION=2048K
//JOBLIB DD DSN=library-containing-DBSIDPR,DISP=SHR
// DD DSN=library-containing-multi-user-modules,DISP=SHR
// DD DSN=etc...,DISP=SHR
//*-------------------------------------------------------------------*
//* STEP 1: PRE-COMPILE THE PROCEDURE PROGRAM *
//*-------------------------------------------------------------------*
//PRECOMP EXEC PGM=DBXMMPR
//WORK1 DD DSN=&.&WORK1.,UNIT=SYSDA,DISP=(NEW,PASS),
// DCB=(RECFM=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
//WORK2 DD DSN=&.&WORK2.,UNIT=SYSDA,DISP=(NEW,PASS),
// DCB=(RECFM=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
//WORK3 DD DSN=&.&WORK3.,UNIT=SYSDA,DISP=(NEW,PASS),
// DCB=(RECFM=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SNAPER DD SYSOUT=*
//SNAPER DD SYSOUT=*
//SYSPUNCH DD DSN=&.&SQLCOB.,UNIT=SYSDA,DISP=(NEW,PASS),
// DCB=(RECF M=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
//SYSUDUMP DD SYSOUT=*
//SYSIN DD *
*** ITEMKILL - COBOL Procedure example ***
* (Line numbers removed for clarity)
* This procedure is triggered when a supplier cancels production
* of a product in our consumer catalog. The program checks to see
* how many open orders we need to cancel and decides, based
* on this number, whether to send apology letters to a small
* number of customers, or to generate an error message instructing
* us to contact the supplier to attempt to fill the orders.
* This procedure is passed an input parameter that determines the
* the number of orders we are willing to cancel (if any).
* The "PROCSQLUSAGE" option used below identifies this program
* as a procedure.
*$DBSQLOPT PROCSQLUSAGE=MODIFIES USRNTRY=NONE
*$DBSQLOPT SQLMODE=DATACOM AUTHID=SYSADM ISOLEVEL=C
IDENTIFICATION DIVISION.
* The PROGRAM-ID must match both the name of the load-module
* that we are going to produce, and the EXTERNAL name defined by
* the CREATE PROCEDURE statement that we execute later.
PROGRAM-ID. ITEMKILL.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 NUM-BACK-ORDERS PIC S9(9) COMP.
01 NUM-ORDERS-CANCELED PIC S9(9) COMP VALUE 0.
EXEC SQL END DECLARE SECTION END-EXEC.
LINKAGE SECTION.
*** DECLARE PROCEDURE PARAMETERS
* The variables declared in the linkage section must
* precisely match the parameter definitions specified
* in the CREATE PROCEDURE statement, and must appear
* in the same order. When SQL regains control after
* execution of the procedure, it ignores data that
* your program stored into parameters defined by the
* CREATE PROCEDURE statement to be input only ("IN").
* See the "Parameter Style and Error Handling" section
* for more details.
01 CANCELED-PART-ID-IN PIC S9(9) COMP.
01 VENDOR-ID-IN PIC S9(9) COMP.
01 MAX-BAD-ORDERS-IN PIC S9(9) COMP.
*** DECLARE NULL INDICATORS FOR THE PARAMETERS.
* These declarations must be included if (and only if) the
* PARAMETER STYLE specified in your CREATE PROCEDURE is
* GENERAL WITH NULLS or DATACOM SQL.
01 CANCELED-PART-ID-NULL PIC S9(4) COMP.
01 VENDOR-ID-NULL PIC S9(4) COMP.
01 MAX-BAD-ORDERS-NULL PIC S9(4) COMP.
*** DECLARE "PARAMETER STYLE DATACOM SQL" OUTPUT PARAMETERS
* These declarations must be included if (and only if) your
* PARAMETER STYLE is DATACOM SQL. A copybook containing
* these declarations is provided with CA Datacom/DB SQL.
* The variable containing the sqlcode may not be named
* "SQLCODE" since the SQLCA uses this name.
* These additional parameters allow the procedure
* to control the SQLCODE that SQL sees as the
* result of the CALL/EXECUTE PROCEDURE statement that
* was executed or triggered. Note that a negative
* SQLCODE-OUT aborts any INSERT, UPDATE, or DELETE
* that triggers it.
* See the "Parameter Styles and Error Handling" section
* for more details on this.
01 SQLCODE-OUT PIC S9(9) COMP.
01 PROCNAME.
49 PROCNAME-LEN PIC S9(4) COMP.
49 PROCNAME-TEXT PIC X(128).
01 SPECNAME.
49 SPECNAME-LEN PIC S9(4) COMP.
49 SPECNAME-TEXT PIC X(128).
* Note that in SQL 10.0, error messages longer than 80 bytes
* are truncated. In the future, this may not be the case.
01 ERRMSG.
49 ERRMSG-LEN PIC S9(4) COMP.
49 ERRMSG-TEXT PIC X(128).
01 DBCODE-EXT PIC X(2).
01 DBCODE-INT PIC S9(4) COMP.
PROCEDURE DIVISION USING CANCELED-PART-ID-IN, VENDOR-ID-IN,
MAX-BAD-ORDERS-IN, CANCELED-PART-ID-NULL, VENDOR-ID-NULL,
MAX-BAD-ORDERS-NULL,
SQLCODE-OUT, PROCNAME, SPECNAME, ERRMSG, DBCODE-EXT,
DBCODE-INT.
EXEC SQL WHENEVER SQLERROR GO TO SQL-ERROR-RTN END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
*** Initialize values of output parameters for SQL.
* Since triggers may not call procedures that have output
* (OUT or INOUT) parameters, and we intend to use this
* procedure as a trigger, we have coded/created it without
* output parameters other than those required for parameter
* style DATACOM SQL.
MOVE 0 TO SQLCODE-OUT.
MOVE 0 TO ERRMSG-LEN.
MOVE 'NO ERROR' TO ERRMSG-TEXT.
MOVE ' ' TO DBCODE-EXT.
MOVE 0 TO DBCODE-INT.
* Handle nulls on input.
IF (CANCELED-PART-ID-NULL = -1)
MOVE
'ITEM_ORDER_KILLER ABORTED: CANCELED PART ID IS NULL'
TO ERRMSG-TEXT
GO TO USER-DEFINED-ERROR
ELSE IF (VENDOR-ID-NULL = -1)
MOVE 'ITEM_ORDER_KILLER ABORTED: VENDOR ID IS NULL'
TO ERRMSG-TEXT
GO TO USER-DEFINED-ERROR
ELSE IF (MAX-BAD-ORDERS-NULL = -1)
MOVE 0 TO MAX-BAD-ORDERS-IN.
* How many back orders for this item are affected?
EXEC SQL
select count(*)
into :NUM-BACK-ORDERS
from sales.order_items
where item_id = :CANCELED-PART-ID-IN and
item_status = 'BACK-ORDERED';
END-EXEC.
* Handle outstanding orders.
IF (NUM-BACK-ORDERS > 0)
* This cancellation by the supplier affects too many
* orders. Try to get him to honor the orders.
IF (NUM-BACK-ORDERS > MAX-BAD-ORDERS-IN)
* Generate a user-defined error.
MOVE
"ITEM_ORDER_KILLER FOUND EXCEEDED ORDER CANCELLATION LIMIT"
TO ERRMSG-TEXT
ELSE
* Mark orders and send apology letters to customers
* whose orders are being canceled.
EXEC SQL
update sales.order_items
set item_status = 'CANCELED',
comments = 'ITEM DISCONTINUED'
where item_id = :CANCELED-PART-ID-IN and
item_status = 'BACK-ORDERED';
END-EXEC
EXEC SQL
insert into customer.apology_letters
(customer_id, order_id, item_id, quantity,
comments, problem_type)
select A.customer_id, A.order_id, B.item_id,
B.quantity, B.comments,'ITEM DISCONTINUED'
from sales.orders A, sales.order_items B
where A.order_id = B.order_id and
B.item_id = :CANCELED-PART-ID-IN and
B.item_status = :'CANCELED';
END-EXEC
MOVE NUM-BACK-ORDERS TO NUM-ORDERS-CANCELED.
* Record the problem so we can track "problem" vendors.
EXEC SQL
Insert into vendor.problems
(vendor_id, problem_type, num_orders_affected,
num_orders_canceled, related_item_id,
problem_date, resolution_date)
values (:VENDOR-ID-IN,'ITEM DISCONTINUED',
:NUM-BACK-ORDERS, :NUM-ORDERS-CANCELED,
:CANCELED-PART-ID-IN, CURRENT DATE, NULL);
END-EXEC.
* Does ERRMSG-TEXT indicate a user-defined error occurred?
IF (ERRMSG-TEXT NOT EQUAL 'NO ERROR')
GO TO USER-DEFINED-ERROR.
GOBACK.
*** Supply error information to output parameters.
* Copy the error diagnostics we received from SQL in our
* SQLCA to the output parameters, which in turn are
* copied by SQL into the SQLCA of the calling CALL/EXECUTE
* PROCEDURE statement.
SQL-ERROR-RTN.
MOVE SQLCA-ERR-MSG TO ERRMSG-TEXT.
MOVE SQLCA-DBCODE-EXT TO DBCODE-EXT.
MOVE SQLCA-DBCODE-INT TO DBCODE-INT.
MOVE SQLCODE TO SQLCODE-OUT.
MOVE 80 TO ERRMSG-LEN.
*** Note that the output of this display statement would have appeared
* in a SYSOUT file attached to output of the Multi-User job, so
* I have decided its use is inappropriate.
* DISPLAY 'SQLCODE =' SQLCODE-OUT'
GOBACK.
USER-DEFINED-ERROR.
* ERRMSG-TEXT has already been set.
MOVE 80 TO ERRMSG-LEN.
MOVE -534 TO SQLCODE-OUT.
GOBACK.
**** End of Program. JCL continues below. ******
/*
//* *** End of Program and Continuation of JCL. ***
//*
//*-------------------------------------------------------------------*
//* STEP2: COMPILE COBOL USER PROGRAM OUTPUT FROM COBOL PRECOMPILER *
//*-------------------------------------------------------------------*
//*
//COBOL EXEC PGM=IGYCRCTL,
// PARM='RENT,NUM,NODYN,APOST,NOSEQUENCE,LIST',
// COND=(8,LT)
//SYSLIN DD DISP=(MOD,PASS),DSN=&.&COBOLOD.,
// UNIT=SYSDA,SPACE=(TRK,(15,15))
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT5 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT6 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT7 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSIN DD DSN=&.&SQLCOB.,UNIT=SYSDA,DISP=(OLD,DELETE,DELETE)
/*
//*-------------------------------------------------------------------*
//* STEP3: LINK USER PROGRAM WITH SYSTEM MODULES
*
//*-------------------------------------------------------------------*
//*
//LINK EXEC LKED,COND=(8,LT),
// PARM.LKED='RENT,XREF,LIST,LET,MAP'
//LKED.SYSLIN DD DSN=&.&COBOLOD.,UNIT=SYSDA,DISP=(OLD,DELETE,DELETE)
// DD DDNAME=SYSIN
//LKED.SYSLMOD DD DSN=dsnname.LODLIB2,DISP=SHR
//LKED.SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
//LKED.OBJLIB DD DSN=DCMALL.R900.CAILIB,DISP=SHR
// DD DSN=DCMDEV.DB.R100.TST.LODLIB,DISP=SHR
// DD DSN=DCMDEV.DB.R100.LODLIB,DISP=SHR
//LKED.CEELIB DD DSN=DCMDEV.DBDT.DSYTEST.LOADLIB,DISP=SHR
//LKED.SYSIN DD *
INCLUDE CEELIB(CEEUOPT)
INCLUDE OBJLIB(DBXHVPR)
INCLUDE OBJLIB(DBXPIPR)
NAME ITEMKILL(R)
/*
Note that the library containing the procedure's load module must be added to the STEPLIB or JOBLIB of the Multi-User Facility startup JCL.
|
Copyright © 2014 CA.
All rights reserved.
|
|