DSN8EC2
Demonstrates how to CALL the Db2 sample ODBA stored procedure, DSN8.
IDENTIFICATION DIVISION. 00000100
PROGRAM-ID. DSN8EC2. 00000200
00000300
****** DSN8EC2 - DB2 Sample ODBA Stored Procedure Client ******** 00000400
* * 00000500
* Module Name = DSN8EC2 * 00000600
* * 00000700
* Descriptive Name = DB2 Sample Application * 00000800
* Client for DB2 Sample ODBA Stored Proc * 00000900
* Batch * 00001000
* Cobol * 00001100
* * 00001200
*LICENSED MATERIALS - PROPERTY OF IBM * 00001300
*5675-DB2 * 00001400
*(C) COPYRIGHT 1999, 2000 IBM CORP. ALL RIGHTS RESERVED. * 00001500
* * 00001600
*STATUS = VERSION 7 * 00001700
* * 00001800
* Function = Demonstrates how to CALL the DB2 sample ODBA * 00001900
* stored procedure, DSN8.DSN8EC1, for accessing * 00002000
* the IMS IVP telephone directory database, * 00002100
* DFSIVD1. * 00002200
* * 00002300
* In particular, this program: * 00002400
* (1) Calls DSN8.DSN8EC1, passing an add request * 00002500
* and the data for an entry to be inserted to * 00002600
* DFSIVD1. * 00002700
* (2) Commits the unit of work for both DB2 and * 00002800
* IMS (Note: IMS work is in an "in doubt" * 00002900
* status until the stored procedure client * 00003000
* performs a COMMIT or a ROLLBACK). * 00003100
* (3) Calls DSN8.DSN8EC1 again, passing a display * 00003200
* request for a entry to be retrieved from * 00003300
* DFSIVD1. * 00003400
* * 00003500
* * 00003600
* Notes = NONE * 00003700
* * 00003800
* Module Type = Cobol Program * 00003900
* Processor = DB2 for OS/390 precompiler, IBM Cobol * 00004000
* Module Size = See linkedit output * 00004100
* Attributes = Re-entrant * 00004200
* * 00004300
* * 00004400
* Entry Point = DSN8EC2 * 00004500
* Purpose = See function * 00004600
* Linkage = Standard MVS program invocation * 00004700
* * 00004800
* Input = Parameters explicitly passed to this function: * 00004900
* PARMS ......... PIC X(25) * 00005000
* * 00005100
* Output = Symbolic label/Name = SYSOUT * 00005200
* Description = Results of ADD and DIS * 00005300
* * 00005400
* Exit-Normal = Return Code 0 Normal Completion * 00005500
* * 00005600
* Exit-Error = Return Code 8 Abnormal Completion * 00005700
* * 00005800
* Error Messages = * 00005900
* Unexpected SQLCODE from DSN8.DSN8EC1 during * 00006000
* <command> request. <DSNTIAR detail> * 00006100
* Unexpected return code from ODBA: * 00006200
* - Command .............. <command> * 00006300
* - AIB return code ...... <AIBRETRN> * 00006400
* - AIB reason code ...... <AIBREASN> * 00006500
* - DC error call ........ <DC-ERROR-CALL> * 00006600
* * 00006700
* External References = * 00006800
* Routines/Services = * 00006900
* DSN8EC1 - DB2 sample ODBA stored procedure * 00007000
* DSNTIAR - DB2 SQLCODE message formatter * 00007100
* * 00007200
* Data areas = None * 00007300
* * 00007400
* Control Blocks = * 00007500
* SQLCA - SQL communication area * 00007600
* * 00007700
* Tables = None * 00007800
* * 00007900
* * 00008000
* Change Activity = None * 00008100
* * 00008200
* * 00008300
* *Pseudocode* * 00008400
* * 00008500
* PROCEDURE A00000-ODBA-SP-CLIENT * 00008600
* Call A30000-ADD-ENTRY to generate add request * 00008700
* Call C31000-CALL-ODBA-SP to handle add request * 00008800
* Call DSN8.DSN8EC1 to perform add request * 00008900
* Call D31100-CHECK-SQLCODE to verify DB2 call * 00009000
* Call E31110-DETAIL-SQL-ERROR to format err * 00009100
* Call F31111-PRINT-SQL-ERROR-MSG * 00009200
* Call D31200-CHECK-AIBCODE to verify IMS state * 00009300
* Call B40000-COMMIT-WORK to commit DB2 work unit * 00009400
* Call B50000-DISPLAY-ENTRY to generate display request * 00009500
* Call C31000-CALL-ODBA-SP to handle display request * 00009600
* Call DSN8.DSN8EC1 to perform display request * 00009700
* Call D31100-CHECK-SQLCODE to verify DB2 call * 00009800
* Call E31110-DETAIL-SQL-ERROR to format err * 00009900
* Call F31111-PRINT-SQL-ERROR-MSG * 00010000
* Call D31200-CHECK-AIBCODE to verify IMS state * 00010100
* * 00010200
*---------------------------------------------------------------* 00010300
00010400
00010500
00010600
ENVIRONMENT DIVISION. 00010700
CONFIGURATION SECTION. 00010800
SOURCE-COMPUTER. IBM-370. 00010900
OBJECT-COMPUTER. IBM-370. 00011000
00011100
INPUT-OUTPUT SECTION. 00011200
00011300
DATA DIVISION. 00011400
WORKING-STORAGE SECTION. 00011500
00011600
***************************************************************** 00011700
* Fields for receiving 00011800
***************************************************************** 00011900
01 DB2-SERVER-LOCATION-NAME PIC X(16). 00012000
01 IMS-SUBSYSTEM-NAME PIC X(8). 00012100
00012200
***************************************************************** 00012300
* Parameter list for invoking sample DB2 stored procedure DSN8EC1 00012400
***************************************************************** 00012500
01 DB2IO-TDBCTLID PIC X(8). 00012600
01 DB2IO-COMMAND PIC X(8). 00012700
01 DB2IO-LAST-NAME PIC X(10). 00012800
01 DB2IO-FIRST-NAME PIC X(10). 00012900
01 DB2IO-EXTENSION PIC X(10). 00013000
01 DB2IO-ZIP-CODE PIC X(7). 00013100
01 DB2OUT-AIBRETRN PIC S9(9) COMP. 00013200
01 DB2OUT-AIBREASN PIC S9(9) COMP. 00013300
01 DC-ERROR-CALL PIC X(4). 00013400
00013500
***************************************************************** 00013600
* Buffer for receiving SQL error messages 00013700
***************************************************************** 00013800
01 ERROR-MESSAGE. 00013900
02 ERROR-LEN PIC S9(4) COMP VALUE +960. 00014000
02 ERROR-TEXT PIC X(120) OCCURS 10 TIMES 00014100
INDEXED BY ERROR-INDEX. 00014200
77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +120. 00014300
00014400
***************************************************************** 00014500
* Job status indicator 00014600
***************************************************************** 00014700
01 RUN-STATUS PIC X(4). 00014800
88 NOT-OKAY VALUE 'BAD'. 00014900
88 OKAY VALUE 'GOOD'. 00015000
00015100
***************************************************************** 00015200
* Include Cobol standard language global variables 00015300
***************************************************************** 00015400
EXEC SQL INCLUDE SQLCA END-EXEC. 00015500
00015600
00015700
00015800
LINKAGE SECTION. 00015900
00016000
***************************************************************** 00016100
* DSN8EC2 invocation parameter list 00016200
***************************************************************** 00016300
01 PARMS. 00016400
05 PARMS-LEN PIC 9(4) USAGE BINARY. 00016500
05 PARMS-DATA PIC X(25). 00016600
00016700
00016800
00016900
PROCEDURE DIVISION 00017000
USING PARMS. 00017100
***************************************************************** 00017200
* Main driver: Use ODBA to add to and display from the IMS IVP DB 00017300
***************************************************************** 00017400
A00000-ODBA-SP-CLIENT. 00017500
DISPLAY '****************************************' 00017600
'****************************************'. 00017700
DISPLAY '* DSN8EC2: Sample Client for IMS/ODBA ' 00017800
'DB2 stored procedure sample (DSN8.DSN8EC1) '. 00017900
DISPLAY '*'. 00018000
MOVE 'GOOD' TO RUN-STATUS. 00018100
00018200
PERFORM B10000-PROCESS-PARMS. 00018300
00018400
PERFORM B20000-CONNECT-TO-SERVER. 00018500
00018600
IF OKAY THEN 00018700
PERFORM B30000-ADD-ENTRY. 00018800
00018900
IF OKAY THEN 00019000
PERFORM B40000-COMMIT-WORK. 00019100
00019200
IF OKAY THEN 00019300
PERFORM B50000-DISPLAY-ENTRY. 00019400
00019500
DISPLAY '****************************************' 00019600
'****************************************'. 00019700
00019800
IF NOT-OKAY THEN 00019900
MOVE 8 to RETURN-CODE. 00020000
00020100
STOP RUN. 00020200
00020300
00020400
B10000-PROCESS-PARMS. 00020500
***************************************************************** 00020600
* Process DSN8EC2 invocation parameters 00020700
***************************************************************** 00020800
UNSTRING PARMS-DATA 00020900
DELIMITED BY SPACE 00021000
INTO DB2-SERVER-LOCATION-NAME 00021100
IMS-SUBSYSTEM-NAME. 00021200
MOVE IMS-SUBSYSTEM-NAME TO DB2IO-TDBCTLID. 00021300
00021400
00021500
B20000-CONNECT-TO-SERVER. 00021600
***************************************************************** 00021700
* Connect to the remote server 00021800
***************************************************************** 00021900
DISPLAY '* Now connecting to ' DB2-SERVER-LOCATION-NAME. 00022000
DISPLAY '* for access to IMS node ' 00022100
IMS-SUBSYSTEM-NAME. 00022200
DISPLAY '*'. 00022300
00022400
EXEC SQL CONNECT TO :DB2-SERVER-LOCATION-NAME END-EXEC. 00022500
IF SQLCODE IS NOT EQUAL TO ZERO THEN 00022600
PERFORM D31100-CHECK-SQLCODE. 00022700
00022800
00022900
B30000-ADD-ENTRY. 00023000
***************************************************************** 00023100
* Generate and add an entry to the IMS IVP database DFSIVD1 00023200
***************************************************************** 00023300
MOVE 'ADD' TO DB2IO-COMMAND. 00023400
MOVE 'DOE' TO DB2IO-LAST-NAME. 00023500
MOVE 'JOHN' TO DB2IO-FIRST-NAME. 00023600
MOVE '9-876-5432' TO DB2IO-EXTENSION. 00023700
MOVE '98765' TO DB2IO-ZIP-CODE. 00023800
MOVE 0 TO DB2OUT-AIBRETRN. 00023900
MOVE 0 TO DB2OUT-AIBREASN. 00024000
MOVE ' ' TO DC-ERROR-CALL. 00024100
00024200
PERFORM C31000-CALL-ODBA-SP. 00024300
00024400
IF OKAY THEN 00024500
DISPLAY '* Entry for:' 00024600
DISPLAY '* - Last Name .......... ' DB2IO-LAST-NAME 00024700
DISPLAY '* - First Name ......... ' DB2IO-FIRST-NAME 00024800
DISPLAY '* - Extension Number ... ' DB2IO-EXTENSION 00024900
DISPLAY '* - Internal Zip Code .. ' DB2IO-ZIP-CODE 00025000
DISPLAY '* added successfully to database DFSIVD1.' 00025100
DISPLAY '*'. 00025200
00025300
00025400
B40000-COMMIT-WORK. 00025500
***************************************************************** 00025600
* Commit changes in the IMS telephone database 00025700
***************************************************************** 00025800
EXEC SQL COMMIT 00025900
END-EXEC. 00026000
00026100
PERFORM D31100-CHECK-SQLCODE. 00026200
00026300
00026400
B50000-DISPLAY-ENTRY. 00026500
***************************************************************** 00026600
* Retrieve an entry from IMS IVP database DFSIVD1 00026700
***************************************************************** 00026800
MOVE 'DIS' TO DB2IO-COMMAND. 00026900
MOVE 'LAST1' TO DB2IO-LAST-NAME. 00027000
MOVE 'NNNN' TO DB2IO-FIRST-NAME. 00027100
MOVE 'N-NNN-NNNN' TO DB2IO-EXTENSION. 00027200
MOVE 'NNNNN' TO DB2IO-ZIP-CODE. 00027300
MOVE 0 TO DB2OUT-AIBRETRN. 00027400
MOVE 0 TO DB2OUT-AIBREASN. 00027500
MOVE ' ' TO DC-ERROR-CALL. 00027600
00027700
PERFORM C31000-CALL-ODBA-SP. 00027800
00027900
IF OKAY THEN 00028000
DISPLAY '* Entry for:' 00028100
DISPLAY '* - Last Name .......... ' DB2IO-LAST-NAME 00028200
DISPLAY '* - First Name ......... ' DB2IO-FIRST-NAME 00028300
DISPLAY '* - Extension Number ... ' DB2IO-EXTENSION 00028400
DISPLAY '* - Internal Zip Code .. ' DB2IO-ZIP-CODE 00028500
DISPLAY '* retrieved successfully from DFSIVD1.' 00028600
DISPLAY '*'. 00028700
00028800
00028900
C31000-CALL-ODBA-SP. 00029000
***************************************************************** 00029100
* Invoke the sample stored procedure for IMS/ODBA 00029200
***************************************************************** 00029300
EXEC SQL CALL DSN8.DSN8EC1 (:DB2IO-TDBCTLID, 00029400
:DB2IO-COMMAND, 00029500
:DB2IO-LAST-NAME, 00029600
:DB2IO-FIRST-NAME, 00029700
:DB2IO-EXTENSION, 00029800
:DB2IO-ZIP-CODE, 00029900
:DB2OUT-AIBRETRN, 00030000
:DB2OUT-AIBREASN, 00030100
:DC-ERROR-CALL) 00030200
END-EXEC. 00030300
00030400
PERFORM D31100-CHECK-SQLCODE. 00030500
00030600
IF OKAY THEN 00030700
PERFORM D31200-CHECK-AIBCODE. 00030800
00030900
00031000
D31100-CHECK-SQLCODE. 00031100
**************************************************************** 00031200
* Verify that the prior SQL call completed successfully 00031300
**************************************************************** 00031400
IF SQLCODE NOT = 0 THEN 00031500
MOVE 'BAD' TO RUN-STATUS 00031600
DISPLAY '* Unexpected SQLCODE from DSN8.DSN8EC1 ' 00031700
'during ' DB2IO-COMMAND ' request.' 00031800
DISPLAY '*' 00031900
PERFORM E31110-DETAIL-SQL-ERROR. 00032000
00032100
00032200
E31110-DETAIL-SQL-ERROR. 00032300
**************************************************************** 00032400
* Call DSNTIAR to return a text message for an unexpected 00032500
* SQLCODE. 00032600
**************************************************************** 00032700
CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN. 00032800
IF RETURN-CODE = ZERO 00032900
PERFORM F31111-PRINT-SQL-ERROR-MSG VARYING ERROR-INDEX 00033000
FROM 1 BY 1 UNTIL ERROR-INDEX GREATER THAN 10. 00033100
00033200
* **MESSAGE FORMAT 00033300
* **ROUTINE ERROR 00033400
* **PRINT ERROR MESSAG 00033500
00033600
00033700
F31111-PRINT-SQL-ERROR-MSG. 00033800
**************************************************************** 00033900
* Print message text 00034000
**************************************************************** 00034100
DISPLAY ERROR-TEXT (ERROR-INDEX). 00034200
00034300
00034400
D31200-CHECK-AIBCODE. 00034500
**************************************************************** 00034600
* Verify that the IMS operation via ODBA succeeded 00034700
**************************************************************** 00034800
IF DB2OUT-AIBRETRN NOT = 0 OR DB2OUT-AIBREASN NOT = 0 THEN 00034900
MOVE 'BAD' TO RUN-STATUS 00035000
DISPLAY '* Unexpected return code from ODBA:' 00035100
DISPLAY '* - Command ..............' DB2IO-COMMAND 00035200
DISPLAY '* - AIB return code ......' DB2OUT-AIBRETRN 00035300
DISPLAY '* - AIB reason code ......' DB2OUT-AIBREASN 00035400
DISPLAY '* - DC error call ........' DC-ERROR-CALL 00035500
DISPLAY '*'. 00035600