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.
000001 // CLASS=A,MSGCLASS=X,REGION=2048K
000002 //JOBLIB DD DSN=library-containing-DBSIDPR,DISP=SHR
000003 // DD DSN=library-containing-multi-user-modules,DISP=SHR
000004 // DD DSN=etc...,DISP=SHR
000005 //*-------------------------------------------------------------------*
000006 //* STEP 1: PRE-COMPILE THE PROCEDURE PROGRAM *
000007 //*-------------------------------------------------------------------*
000008 //PRECOMP EXEC PGM=DBXMMPR
000009 //WORK1 DD DSN=&.&WORK1.,UNIT=SYSDA,DISP=(NEW,PASS),
000010 // DCB=(RECFM=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
000011 //WORK2 DD DSN=&.&WORK2.,UNIT=SYSDA,DISP=(NEW,PASS),
000012 // DCB=(RECFM=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
000013 //WORK3 DD DSN=&.&WORK3.,UNIT=SYSDA,DISP=(NEW,PASS),
000014 // DCB=(RECFM=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
000015 //SYSOUT DD SYSOUT=*
000016 //SYSPRINT DD SYSOUT=*
000017 //SNAPER DD SYSOUT=*
000018 //SNAPER DD SYSOUT=*
000019 //SYSPUNCH DD DSN=&.&SQLCOB.,UNIT=SYSDA,DISP=(NEW,PASS),
000020 // DCB=(RECF M=F,LRECL=80,BLKSIZE=80),SPACE=(TRK,(1,1))
000021 //SYSUDUMP DD SYSOUT=*
000022 //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. ******
000260 /*
000261 //* *** End of Program and Continuation of JCL. ***
000262 //*
000263
//*-------------------------------------------------------------------*
000264 //* STEP2: COMPILE COBOL USER PROGRAM OUTPUT FROM COBOL PRECOMPILER *
000265
//*-------------------------------------------------------------------*
000266 //*
000267 //COBOL EXEC PGM=IGYCRCTL,
000268 // PARM='RENT,NUM,NODYN,APOST,NOSEQUENCE,LIST',
000269 // COND=(8,LT)
000270 //SYSLIN DD DISP=(MOD,PASS),DSN=&.&COBOLOD.,
000271 // UNIT=SYSDA,SPACE=(TRK,(15,15))
000272 //SYSPRINT DD SYSOUT=*
000273 //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
000274 //SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
000275 //SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
000276 //SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
000277 //SYSUT5 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
000278 //SYSUT6 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
000279 //SYSUT7 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
000280 //SYSIN DD DSN=&.&SQLCOB.,UNIT=SYSDA,DISP=(OLD,DELETE,DELETE)
000281 /*
000282
//*-------------------------------------------------------------------*
000283 //* STEP3: LINK USER PROGRAM WITH SYSTEM MODULES
*
000284
//*-------------------------------------------------------------------*
000285 //*
000286 //LINK EXEC LKED,COND=(8,LT),
000287 // PARM.LKED='RENT,XREF,LIST,LET,MAP'
000288 //LKED.SYSLIN DD DSN=&.&COBOLOD.,UNIT=SYSDA,DISP=(OLD,DELETE,DELETE)
000289 // DD DDNAME=SYSIN
000290 //LKED.SYSLMOD DD DSN=dsnname.LODLIB2,DISP=SHR
000291 //*KED.SYSLIB DD DSN=MVSSYS.COB2.V1R3M2.COB2LIB,DISP=SHR
000292 //LKED.SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
000293 //LKED.OBJLIB DD DSN=DCMALL.R900.CAILIB,DISP=SHR
000294 // DD DSN=DCMDEV.DB.R100.TST.LODLIB,DISP=SHR
000295 // DD DSN=DCMDEV.DB.R100.LODLIB,DISP=SHR
000296 //LKED.CEELIB DD DSN=DCMDEV.DBDT.DSYTEST.LOADLIB,DISP=SHR
000297 //LKED.SYSIN DD *
000298 INCLUDE CEELIB(CEEUOPT)
000299 INCLUDE OBJLIB(DBXHVPR)
000300 INCLUDE OBJLIB(DBXPIPR)
000301 NAME ITEMKILL(R)
000302 /*
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 © 2015 CA Technologies.
All rights reserved.
|
|