This sample program, SYCCSAR2, processes a LAN-side client RPC, syr2.c, from the Open Client DB-Library program. syr2.c is included on the TRS CD or tape.
The SYCCSAR2 sample program is provided as part of the Open ServerConnect package. It references a table, SYBASE.SAMPLETB, which you create from the file SYOSCREA provided with Open ServerConnect in the CTRL library.
This program accesses the sample DB2 table, SYBASE.SAMPLETB and selects columns from all rows with a department number that matches the number supplied in a passed parameter. It returns the selected rows to the client. One of the return parameters indicates how many rows are affected.
After each row is sent, this program examines the TDSNDROW return code. If a cancel request is received, it stops sending rows.
If the program completes successfully, it sends a confirmation message to the client; otherwise, it sends an error message.
This program demonstrates the use of the following Gateway-Library functions:
Name |
Action |
|---|---|
TDACCEPT |
Accept a client request. |
TDCONVRT |
Convert data from host datatype to DB-Library datatype. |
TDESCRIB |
Describe a column. |
TDFREE |
Free up the TDPROC structure for the connection. |
TDINFBCD |
Get packed decimal information for a described column. |
TDINFPRM |
Get information about one RPC parameter. |
TDINFUDT |
Get a column’s user-defined datatype. |
TDINIT |
Initialize the Gateway-Library environment. |
TDLOCPRM |
Return ID of one RPC parameter based on name. |
TDNUMPRM |
Get total number of RPC parameters. |
TDRCVPRM |
Receive RPC parameter from client program. |
TDRESULT |
Describe next communication from client. |
TDSETBCD |
Set scaling for a described column. |
TDSETPRM |
Set one return parameter. |
TDSETUDT |
Set a column’s user datatype. |
TDSNDDON |
Send results-completion to client. |
TDSNDMSG |
Send message to client. |
TDSNDROW |
Send row to client. |
TDSTATUS |
Get status information. |
*@(#) syccsar2.cobol 1.1 3/17/98 */
IDENTIFICATION DIVISION.
PROGRAM-ID. SYCCSAR2.
****** SYCCSAR2 - RPC REQUEST APPLICATION - COBOL2 - CICS *******
*
* TRANID: SYR2
* PROGRAM: SYCCSAR2
* PLAN NAME: SYR2PLAN
* FILES: n/a
* TABLES: SYBASE.SAMPLETB
*
* This program is executed via a client RPC request from sample
* dblib program 'SYR2'. The purpose of the program is primarily
* to demonstrate Server Library calls, especially those which
* would be used in a server application designed to handle
* RPC requests.
*
* Server Library calls:
* TDACCEPT accept request from client
* TDCONVRT convert data from host to DBlib datatype
* TDESCRIB describe a column
* TDFREE free TDPROC structure
* TDINFBCD get BCD information for a described column
* TDINFPRM get information about one rpc parameter
* TDINFUDT get user column datatype
* TDINIT establish environment
* TDLOCPRM return id of one rpc parameter based on name
* TDNUMPRM get total nr of rpc parameters
* TDRCVPRM retrieve rpc parameter from client
* TDRESULT describe next communication
* TDSETBCD set scaling for a described column
* TDSETPRM set return parameter
* TDSETUDT set user column datatype
* TDSNDDON send results-completion to client
* TDSNDMSG send message to client
* TDSNDROW send row to client
* TDSTATUS get status information
*
*
* The program selects columns from the DB2 sample table
* SYBASE.SAMPLETB of all rows with a department number equal
* to that supplied in a passed parameter.
*
* The number of rows is returned in a return parameter.
*
* After each row is sent, TDSNDROW's return code is examined.
* If a cancel request was received, then no more rows are sent.
*
* A confirmation message is sent to the client if all is
* well, otherwise an error message is sent.
*
* CHANGE ACTIVITY:
* 4/90 - Created, MPM
* 10/93 - Added SAMPLETB DCLGEN, some restructuring, TC
*
*---------------------------------------------------------------*
ENVIRONMENT DIVISION.
DATA DIVISION.
******************************************************************
WORKING-STORAGE SECTION.
******************************************************************
*-----------------------------------------------------------------
* DB2 SQLCA
*-----------------------------------------------------------------
EXEC SQL INCLUDE SQLCA END-EXEC.
*-----------------------------------------------------------------
* SYBASE.SAMPLETB Table Declaration
*-----------------------------------------------------------------
EXEC SQL INCLUDE SYCCSMPT END-EXEC.
*-----------------------------------------------------------------
* SERVER LIBRARY COBOL COPY BOOK
*-----------------------------------------------------------------
COPY SYGWCOB.
*-----------------------------------------------------------------
* WORK AREAS
*-----------------------------------------------------------------
01 GW-LIB-MISC-FIELDS.
05 GWL-PROC POINTER.
05 GWL-INIT-HANDLE POINTER.
05 GWL-RC PIC S9(9) COMP.
05 GWL-INFPRM-ID PIC S9(9) COMP.
05 GWL-INFPRM-TYPE PIC S9(9) COMP.
05 GWL-INFPRM-DATA-L PIC S9(9) COMP.
05 GWL-INFPRM-MAX-DATA-L PIC S9(9) COMP.
05 GWL-INFPRM-STATUS PIC S9(9) COMP.
05 GWL-INFPRM-NAME PIC X(30).
05 GWL-INFPRM-NAME-L PIC S9(9) COMP.
05 GWL-INFPRM-USER-DATA PIC S9(9) COMP.
05 GWL-INFUDT-USER-TYPE PIC S9(9) COMP.
05 GWL-STATUS-NR PIC S9(9) COMP.
05 GWL-STATUS-DONE PIC S9(9) COMP.
05 GWL-STATUS-COUNT PIC S9(9) COMP.
05 GWL-STATUS-COMM PIC S9(9) COMP.
05 GWL-STATUS-RETURN-CODE PIC S9(9) COMP.
05 GWL-STATUS-SUBCODE PIC S9(9) COMP.
05 GWL-NUMPRM-PARMS PIC S9(9) COMP.
05 GWL-RCVPRM-DATA-L PIC S9(9) COMP.
05 GWL-SETPRM-ID PIC S9(9) COMP.
05 GWL-SETPRM-TYPE PIC S9(9) COMP.
05 GWL-SETPRM-DATA-L PIC S9(9) COMP.
05 GWL-SETPRM-USER-DATA PIC S9(9) COMP.
05 GWL-CONVRT-SCALE PIC S9(9) COMP VALUE 2.
05 GWL-SETBCD-SCALE PIC S9(9) COMP VALUE 0.
05 GWL-INFBCD-LENGTH PIC S9(9) COMP.
05 GWL-INFBCD-SCALE PIC S9(9) COMP.
01 PARM-FIELDS.
05 PARM-DEPT.
49 PARM-DEPT-LEN PIC S9(4) COMP.
49 PARM-DEPT-TEXT PIC X(3).
05 PARM-RETURN-ROWS PIC S9(9) COMP VALUE 0.
01 SNA-FIELDS.
05 SNA-SUBC PIC S9(9) COMP.
05 SNA-CONNECTION-NAME PIC X(8) VALUE SPACES.
01 EMPLOYEE-FIELDS.
05 EMPLOYEE-FNM.
49 EMPLOYEE-FNM-LEN PIC S9(4) COMP.
49 EMPLOYEE-FNM-TEXT PIC X(12).
05 EMPLOYEE-LNM.
49 EMPLOYEE-LNM-LEN PIC S9(4) COMP.
49 EMPLOYEE-LNM-TEXT PIC X(15).
05 EMPLOYEE-ED PIC S9(4) COMP.
05 EMPLOYEE-JC PIC S9(3) COMP-3.
05 EMPLOYEE-SAL PIC S9(6)V9(2) COMP-3.
01 EMPLOYEE-FIELDS-CHAR REDEFINES EMPLOYEE-FIELDS.
05 FILLER PIC X(16).
05 EMPLOYEE-LNM-CHARS OCCURS 15 TIMES
PIC X.
05 FILLER PIC X(9).
01 COLUMN-NAME-FIELDS.
05 CN-FNM PIC X(10) VALUE 'FIRST_NAME'.
05 CN-LNM PIC X(9) VALUE 'LAST_NAME'.
05 CN-ED PIC X(9) VALUE 'EDUCATION'.
05 CN-JC PIC X(7) VALUE 'JOBCODE'.
05 CN-SAL PIC X(6) VALUE 'SALARY'.
01 DESCRIBE-BIND-FIELDS.
05 DB-HOST-TYPE PIC S9(9) COMP.
05 DB-CLIENT-TYPE PIC S9(9) COMP.
05 DB-DESCRIBE-HV-PTR POINTER.
05 DB-COLUMN-NAME-HV-PTR POINTER.
05 DB-NULL-INDICATOR PIC S9(4) COMP VALUE 0.
01 TDGETUSR-FIELDS.
05 GU-ACCESS-CODE PIC X(32).
05 GU-USER-ID PIC X(32).
05 GU-PASSWORD PIC X(32).
05 GU-SERVER-NAME PIC X(32).
05 GU-CLIENT-CHARSET PIC X(32).
05 GU-NATIONAL-LANG PIC X(32).
05 GU-SERVER-CHARSET PIC X(32).
05 GU-SERVER-DBCS PIC X(32).
05 GU-APP-ID PIC X(32).
01 COUNTER-FIELDS.
05 CTR-COLUMN PIC S9(9) COMP VALUE 0.
01 WORK-FIELDS.
05 WRKLEN1 PIC S9(9) COMP.
05 WRKLEN2 PIC S9(9) COMP.
05 WRK-BLANKS-SS PIC S9(9) COMP.
05 WRK-DONE-STATUS PIC S9(9) COMP.
05 WRK-EMPLOYEE-SAL PIC X(8).
01 MESSAGE-FIELDS.
05 MSG-TYPE PIC S9(9) COMP.
05 MSG-SEVERITY PIC S9(9) COMP.
05 MSG-SEVERITY-OK PIC S9(9) COMP VALUE 9.
05 MSG-SEVERITY-ERROR PIC S9(9) COMP VALUE 11.
05 MSG-NR PIC S9(9) COMP.
05 MSG-NR-OK PIC S9(9) COMP VALUE 1.
05 MSG-NR-ERROR PIC S9(9) COMP VALUE 2.
05 MSG-RPC PIC X(4) VALUE 'SYR2'.
05 MSG-RPC-L PIC S9(9) COMP.
05 MSG-TEXT PIC X(100).
05 MSG-TEXT-L PIC S9(9) COMP.
05 MSG-NOT-RPC PIC X(30)
VALUE 'SYR2 not begun via rpc request'.
05 MSG-NOT-AUTH PIC X(19)
VALUE 'User not authorized'.
05 MSG-WRONG-NR-PARMS PIC X(30)
VALUE 'Number of parameters was not 2'.
05 MSG-NOT-RETURN-PARM PIC X(42)
VALUE 'First parameter must be a RETURN parameter'.
05 MSG-NOT-CHAR-PARM PIC X(41)
VALUE 'Second parameter must be a CHARACTER type'.
05 MSG-BAD-CURSOR PIC X(27)
VALUE 'ERROR - can not open cursor'.
05 MSG-BAD-FETCH PIC X(24)
VALUE 'ERROR - fetch row failed'.
05 MSG-SQL-ERROR.
10 FILLER PIC X(10) VALUE 'Sqlcode = '.
10 MSG-SQL-ERROR-C PIC -9(3) DISPLAY.
10 FILLER PIC X(16)
VALUE ', Error Tokens: '.
10 MSG-SQL-ERROR-K PIC X(70).
10 MSG-SQL-ERROR-K-CHARS
REDEFINES MSG-SQL-ERROR-K
OCCURS 70 TIMES
PIC X.
05 MSG-SQL-ERROR-SS PIC S9(4) COMP.
01 CICS-FIELDS.
05 CICS-RESPONSE PIC S9(9) COMP.
01 SWITCHES.
05 ALL-DONE-SW PIC X VALUE 'N'.
88 NOT-ALL-DONE VALUE 'N'.
88 ALL-DONE VALUE 'Y'.
05 SEND-DONE-SW PIC X VALUE 'Y'.
88 SEND-DONE-ERROR VALUE 'N'.
88 SEND-DONE-OK VALUE 'Y'.
*-----------------------------------------------------------------
* DECLARE CURSOR
*-----------------------------------------------------------------
EXEC SQL
DECLARE ECURSOR CURSOR
FOR SELECT FIRSTNME, LASTNAME,
EDUCLVL, JOBCODE, SALARY
FROM SYBASE.SAMPLETB
WHERE WORKDEPT = :PARM-DEPT
END-EXEC.
******************************************************************
LINKAGE SECTION.
******************************************************************
01 LK-DESCRIBE-HV PIC X(255).
01 LK-COLUMN-NAME-HV PIC X(30).
******************************************************************
PROCEDURE DIVISION.
******************************************************************
* Reset DB2 error handlers
EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
* Establish gateway environment
CALL 'TDINIT' USING DFHEIBLK, GWL-RC, GWL-INIT-HANDLE.
* Accept client request
CALL 'TDACCEPT' USING GWL-PROC, GWL-RC, GWL-INIT-HANDLE,
SNA-CONNECTION-NAME, SNA-SUBC.
* TDRESULT to make sure we were started via RPC request
CALL 'TDRESULT' USING GWL-PROC, GWL-RC.
IF GWL-RC NOT = TDS-PARM-PRESENT THEN
PERFORM TDRESULT-ERROR
GO TO END-PROGRAM
END-IF.
* Verify user login information
MOVE 'TOP SECRET' TO GU-ACCESS-CODE.
CALL 'TDGETUSR' USING GWL-PROC, GWL-RC, GU-ACCESS-CODE,
GU-USER-ID, GU-PASSWORD, GU-SERVER-NAME,
GU-CLIENT-CHARSET, GU-NATIONAL-LANG,
GU-SERVER-CHARSET, GU-SERVER-DBCS, GU-APP-ID.
IF GWL-RC NOT = TDS-OK THEN
PERFORM TDGETUSR-ERROR
GO TO END-PROGRAM
END-IF.
* Get number of parameters ... should be two
CALL 'TDNUMPRM' USING GWL-PROC, GWL-NUMPRM-PARMS.
IF GWL-NUMPRM-PARMS NOT = 2 THEN
PERFORM TDNUMPRM-ERROR
GO TO END-PROGRAM
END-IF.
* Get return parameter information
MOVE 1 TO GWL-INFPRM-ID.
PERFORM GET-PARM-INFO.
(IF GWL-INFPRM-STATUS NOT = TDS-RETURN-VALUE AND
IF GWL-INFPRM-STATUS NOT = TDS-RETURN-VALUE-NULLABLE) THEN
PERFORM TDINFPRM-NOT-RETURN-PARM-ERROR
GO TO END-PROGRAM
END-IF.
MOVE GWL-INFPRM-USER-DATA TO GWL-SETPRM-USER-DATA.
MOVE GWL-INFPRM-ID TO GWL-SETPRM-ID.
MOVE GWL-INFPRM-DATA-L TO GWL-SETPRM-DATA-L.
MOVE GWL-INFPRM-TYPE TO GWL-SETPRM-TYPE.
* Get department id parameter number from known name
MOVE '@parm2' TO GWL-INFPRM-NAME.
MOVE 6 TO GWL-INFPRM-NAME-L.
CALL 'TDLOCPRM' USING GWL-PROC, GWL-INFPRM-ID,
GWL-INFPRM-NAME, GWL-INFPRM-NAME-L.
* Get department parameter information
PERFORM GET-PARM-INFO.
IF GWL-INFPRM-TYPE NOT = TDSVARYCHAR THEN
PERFORM TDINFPRM-NOT-CHAR-PARM-ERROR
GO TO END-PROGRAM
END-IF.
* Get department parameter data
CALL 'TDRCVPRM' USING GWL-PROC, GWL-RC, GWL-INFPRM-ID,
PARM-DEPT, GWL-INFPRM-TYPE,
GWL-INFPRM-MAX-DATA-L,
GWL-RCVPRM-DATA-L.
* Open the DB2 cursor for fetch
EXEC SQL OPEN ECURSOR END-EXEC.
IF SQLCODE NOT = 0
PERFORM OPEN-ERROR
GO TO END-PROGRAM
END-IF.
* The SYGETAD assembler subroutine returns the address of any
* data item in parameter two into parameter 1. It's a way to
* get around the limitations of the COBOL 2 SET verb.
CALL 'SYGETAD' USING DB-DESCRIBE-HV-PTR, EMPLOYEE-FNM.
* During 'DESCRIBE-COLUMN', LK-DESCRIBE-HV will be based on
* DB-DESCRIBE-HV-PTR, which addresses EMPLOYEE-FNM. This
* allows us to call a 'generic' TDESCRIB, using LK-DESCRIBE-HV
* as a constant in the call, even though it actually varies
* depending on the SYGETAD and SET sequence preceding it.
*
* The same technique will be used for other data items which
* must be passed by address; for example, the name of the
* columns.
CALL 'SYGETAD' USING DB-COLUMN-NAME-HV-PTR, CN-FNM.
MOVE LENGTH OF EMPLOYEE-FNM-TEXT TO WRKLEN1.
MOVE LENGTH OF CN-FNM TO WRKLEN2.
MOVE TDSVARYCHAR TO DB-HOST-TYPE.
MOVE TDSVARYCHAR TO DB-CLIENT-TYPE.
PERFORM DESCRIBE-COLUMN.
* Here we let TDESCRIB convert from DB2 varchar (TDSVARYCHAR)
* to DBCHAR.
CALL 'SYGETAD' USING DB-DESCRIBE-HV-PTR, EMPLOYEE-LNM.
CALL 'SYGETAD' USING DB-COLUMN-NAME-HV-PTR, CN-LNM.
MOVE LENGTH OF EMPLOYEE-LNM-TEXT TO WRKLEN1.
MOVE LENGTH OF CN-LNM TO WRKLEN2.
MOVE TDSVARYCHAR TO DB-HOST-TYPE.
MOVE TDSCHAR TO DB-CLIENT-TYPE.
PERFORM DESCRIBE-COLUMN.
CALL 'SYGETAD' USING DB-DESCRIBE-HV-PTR, EMPLOYEE-ED.
CALL 'SYGETAD' USING DB-COLUMN-NAME-HV-PTR, CN-ED.
MOVE LENGTH OF EMPLOYEE-ED TO WRKLEN1.
MOVE LENGTH OF CN-ED TO WRKLEN2.
MOVE TDSINT2 TO DB-HOST-TYPE.
MOVE TDSINT2 TO DB-CLIENT-TYPE.
PERFORM DESCRIBE-COLUMN.
* Get the user defined datatype of EMPLOYEE-ED column.
CALL 'TDINFUDT' USING GWL-PROC, GWL-RC, CTR-COLUMN,
GWL-INFUDT-USER-TYPE.
* Set the user defined datatype of EMPLOYEE-ED column.
CALL 'TDSETUDT' USING GWL-PROC, GWL-RC, CTR-COLUMN,
GWL-INFUDT-USER-TYPE.
* Here we let TDESCRIB convert from TDSDECIMAL to TDSFLT8.
CALL 'SYGETAD' USING DB-DESCRIBE-HV-PTR, EMPLOYEE-JC.
CALL 'SYGETAD' USING DB-COLUMN-NAME-HV-PTR, CN-JC.
MOVE LENGTH OF EMPLOYEE-JC TO WRKLEN1.
MOVE LENGTH OF CN-JC TO WRKLEN2.
MOVE TDSDECIMAL TO DB-HOST-TYPE.
MOVE TDSFLT8 TO DB-CLIENT-TYPE.
PERFORM DESCRIBE-COLUMN.
* We must inform the Server Library how many decimal places
* are in the EMPLOYEE-JC column.
CALL 'TDSETBCD' USING GWL-PROC, GWL-RC, TDS-OBJECT-COL,
CTR-COLUMN, TDS-DEFAULT-LENGTH,
GWL-SETBCD-SCALE.
* Demonstrate getting decimal column information.
CALL 'TDINFBCD' USING GWL-PROC, GWL-RC, TDS-OBJECT-COL,
CTR-COLUMN, GWL-INFBCD-LENGTH,
GWL-INFBCD-SCALE.
* Here we intend to use TDCONVRT to convert from TDSDECIMAL to
* TDSMONEY, so we point TDESCRIB to the output of TDCONVRT,
* rather than the original input.
CALL 'SYGETAD' USING DB-DESCRIBE-HV-PTR, WRK-EMPLOYEE-SAL.
CALL 'SYGETAD' USING DB-COLUMN-NAME-HV-PTR, CN-SAL.
MOVE LENGTH OF WRK-EMPLOYEE-SAL TO WRKLEN1.
MOVE LENGTH OF CN-SAL TO WRKLEN2.
MOVE TDSMONEY TO DB-HOST-TYPE.
MOVE TDSMONEY TO DB-CLIENT-TYPE.
PERFORM DESCRIBE-COLUMN.
PERFORM FETCH-AND-SEND-ROWS
UNTIL ALL-DONE.
* Close cursor
EXEC SQL CLOSE ECURSOR END-EXEC.
* Update returned parameter with number of rows fetched
CALL 'TDSETPRM' USING GWL-PROC, GWL-RC, GWL-SETPRM-ID,
GWL-SETPRM-TYPE, GWL-SETPRM-DATA-L,
PARM-RETURN-ROWS,
GWL-SETPRM-USER-DATA.
GO TO END-PROGRAM.
*-----------------------------------------------------------------
FETCH-AND-SEND-ROWS.
*-----------------------------------------------------------------
EXEC SQL FETCH ECURSOR INTO :EMPLOYEE-FIELDS END-EXEC.
IF SQLCODE = 0 THEN
* Convert from DB2 decimal (TDSDECIMAL) to dblib MONEY.
MOVE LENGTH OF EMPLOYEE-SAL TO WRKLEN1
MOVE LENGTH OF WRK-EMPLOYEE-SAL TO WRKLEN2
CALL 'TDCONVRT' USING GWL-PROC, GWL-RC,
GWL-CONVRT-SCALE, TDSDECIMAL,
WRKLEN1, EMPLOYEE-SAL, TDSMONEY,
WRKLEN2, WRK-EMPLOYEE-SAL
* send a row to the client
CALL 'TDSNDROW' USING GWL-PROC, GWL-RC
ADD 1 TO PARM-RETURN-ROWS
IF GWL-RC = TDS-CANCEL-RECEIVED THEN
MOVE 'Y' TO ALL-DONE-SW
END-IF
ELSE IF SQLCODE = +100 THEN
MOVE 'Y' TO ALL-DONE-SW
ELSE
MOVE 'Y' TO ALL-DONE-SW
PERFORM FETCH-ERROR
END-IF.
*-----------------------------------------------------------------
GET-PARM-INFO.
*-----------------------------------------------------------------
CALL 'TDINFPRM' USING GWL-PROC, GWL-RC, GWL-INFPRM-ID,
GWL-INFPRM-TYPE, GWL-INFPRM-DATA-L,
GWL-INFPRM-MAX-DATA-L
GWL-INFPRM-STATUS, GWL-INFPRM-NAME,
GWL-INFPRM-NAME-L,
GWL-INFPRM-USER-DATA.
*-----------------------------------------------------------------
DESCRIBE-COLUMN.
*-----------------------------------------------------------------
SET ADDRESS OF LK-DESCRIBE-HV TO DB-DESCRIBE-HV-PTR.
SET ADDRESS OF LK-COLUMN-NAME-HV TO DB-COLUMN-NAME-HV-PTR.
ADD 1 TO CTR-COLUMN.
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC, CTR-COLUMN,
DB-HOST-TYPE, WRKLEN1, LK-DESCRIBE-HV,
DB-NULL-INDICATOR, TDS-FALSE,
DB-CLIENT-TYPE, WRKLEN1,
LK-COLUMN-NAME-HV, WRKLEN2.
*-----------------------------------------------------------------
TDGETUSR-ERROR.
*------------------------------------------------------------------
MOVE MSG-NOT-AUTH TO MSG-TEXT.
MOVE LENGTH OF MSG-NOT-AUTH TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
TDRESULT-ERROR.
*-----------------------------------------------------------------
MOVE MSG-NOT-RPC TO MSG-TEXT.
MOVE LENGTH OF MSG-NOT-RPC TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
TDNUMPRM-ERROR.
*-----------------------------------------------------------------
MOVE MSG-WRONG-NR-PARMS TO MSG-TEXT.
MOVE LENGTH OF MSG-WRONG-NR-PARMS TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
TDINFPRM-NOT-RETURN-PARM-ERROR.
*-----------------------------------------------------------------
MOVE MSG-NOT-RETURN-PARM TO MSG-TEXT.
MOVE LENGTH OF MSG-NOT-RETURN-PARM TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
TDINFPRM-NOT-CHAR-PARM-ERROR.
*-----------------------------------------------------------------
MOVE MSG-NOT-CHAR-PARM TO MSG-TEXT.
MOVE LENGTH OF MSG-NOT-CHAR-PARM TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
OPEN-ERROR.
*-----------------------------------------------------------------
MOVE MSG-BAD-CURSOR TO MSG-TEXT.
MOVE LENGTH OF MSG-BAD-CURSOR TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
PERFORM SEND-SQL-ERROR.
*-----------------------------------------------------------------
FETCH-ERROR.
*-----------------------------------------------------------------
MOVE MSG-BAD-FETCH TO MSG-TEXT.
MOVE LENGTH OF MSG-BAD-FETCH TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
PERFORM SEND-SQL-ERROR.
*-----------------------------------------------------------------
SEND-SQL-ERROR.
*-----------------------------------------------------------------
MOVE SQLCODE TO MSG-SQL-ERROR-C.
MOVE SQLERRMC TO MSG-SQL-ERROR-K.
* -------------------------------------------------------------
* ensure possible non-printables translated to spaces
* -------------------------------------------------------------
PERFORM VARYING MSG-SQL-ERROR-SS FROM 1 BY 1
UNTIL MSG-SQL-ERROR-SS > SQLERRML
IF MSG-SQL-ERROR-K-CHARS(MSG-SQL-ERROR-SS) < SPACE
OR MSG-SQL-ERROR-K-CHARS(MSG-SQL-ERROR-SS) > '9' THEN
MOVE SPACE TO MSG-SQL-ERROR-K-CHARS(MSG-SQL-ERROR-SS)
END-IF
END-PERFORM.
MOVE MSG-SQL-ERROR TO MSG-TEXT.
MOVE LENGTH OF MSG-SQL-ERROR TO MSG-TEXT-L.
PERFORM SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
SEND-ERROR-MESSAGE.
*-----------------------------------------------------------------
MOVE 'N' TO SEND-DONE-SW.
MOVE MSG-SEVERITY-ERROR TO MSG-SEVERITY.
MOVE MSG-NR-ERROR TO MSG-NR.
MOVE TDS-ERROR-MSG TO MSG-TYPE.
PERFORM SEND-MESSAGE.
*-----------------------------------------------------------------
SEND-MESSAGE.
*-----------------------------------------------------------------
MOVE LENGTH OF MSG-RPC TO MSG-RPC-L.
* Ensure we're in right state to send a message
CALL 'TDSTATUS' USING GWL-PROC, GWL-RC, GWL-STATUS-NR,
GWL-STATUS-DONE, GWL-STATUS-COUNT,
GWL-STATUS-COMM,
GWL-STATUS-RETURN-CODE,
GWL-STATUS-SUBCODE.
IF (GWL-RC = TDS-OK AND
GWL-STATUS-COMM = TDS-RECEIVE) THEN
CALL 'TDSNDMSG' USING GWL-PROC, GWL-RC, MSG-TYPE,
MSG-NR, MSG-SEVERITY, TDS-ZERO,
TDS-ZERO, MSG-RPC, MSG-RPC-L,
MSG-TEXT, MSG-TEXT-L
END-IF.
*-----------------------------------------------------------------
END-PROGRAM.
*-----------------------------------------------------------------
IF SEND-DONE-OK
MOVE TDS-DONE-COUNT TO WRK-DONE-STATUS
ELSE
MOVE TDS-DONE-ERROR TO WRK-DONE-STATUS
MOVE ZERO TO PARM-RETURN-ROWS
END-IF.
CALL 'TDSNDDON' USING GWL-PROC, GWL-RC, WRK-DONE-STATUS,
PARM-RETURN-ROWS, TDS-ZERO,
TDS-ENDRPC.
CALL 'TDFREE' USING GWL-PROC, GWL-RC.
EXEC CICS RETURN END-EXEC.
| Copyright © 2005. Sybase Inc. All rights reserved. |
|
|
