SYCTSAR4: PROC OPTIONS(MAIN REENTRANT) /* @(#) syctsar4.pli 1.1 5/8/96 */
/****** SYCTSAR4 - Client RPC Request APPL - PL/I - CICS ************/
/* */
/* CICS TRANID: SYR4 */
/* */
/* PROGRAM: SYCTSAR4 */
/* */
/* PURPOSE: Demonstrates Open Client for CICS CALLs. */
/* */
/* FUNCTION: Illustrates how to send an RPC request with */
/* parameters to: */
/* */
/* - A SQL Server */
/* - An Open Server running in a CICS region. */
/* */
/* SQL Server: */
/* */
/* If the request is sent to a SQL Server it */
/* intitiates the stored procedure "SYR2". */
/* */
/* Note: The Net-Gateway/MCG product includes a script*/
/* that creates this procedure in a target SQL */
/* server. */
/* */
/* Open Server/CICS: */
/* */
/* If the request is sent to an Open Server/CICS */
/* region, invoke the CICS transaction SYR1. */
/* */
/* Note: The Open Server/CICS product includes the */
/* sample transaction SYR1. This is the server */
/* side transaction invoked by this program. */
/* */
/* Open Server/IMS: */
/* */
/* If the request is sent to an Open Server/IMS */
/* region, invoke the IMS transaction SYR1. */
/* */
/* Note: The Open Server/IMS product includes the */
/* sample transaction SYR1. This is the server */
/* side transaction invoked by this program. */
/* */
/* PREREQS: Before running SYCTSAR4, make sure that the server */
/* you wish to access has an entry in the Connection */
/* Router Table for that Server and the MCG(s) that */
/* you wish to use. */
/* */
/* INPUT: On the input screen, make sure to enter the Server */
/* name, user id, and password for the target server. */
/* TRAN NAME is not used for LAN servers. */
/* */
/* If the target server is in a CICS or IMS region, */
/* enter SYR1 in the TRAN NAME field if the server is */
/* */
/* Open Client CALLs used in this sample: */
/* */
/* CSBCTXALLOC allocate a context */
/* CSBCTXDROP drop a context */
/* CTBBIND bind a column variable */
/* CTBCLOSE close a server connection */
/* CTBCMDALLOC allocate a command */
/* CTBCMDDROP drop a command */
/* CTBCOMMAND initiate remote procedure call */
/* CTBCONALLOC allocate a connection */
/* CTBCONDROP drop a connection */
/* CTBCONPROPS alter properties of a connection */
/* CTBCONNECT open a server connection */
/* CTBDESCRIBE return a description of result data */
/* CTBDIAG retrieve SQLCODE messages */
/* CTBEXIT exit client library */
/* CTBFETCH fetch result data */
/* CTBINIT init client library */
/* CTBPARAM define a command parameter */
/* CTBRESULTS sets up result data */
/* CTBSEND send a request to the server */
/* */
/* History: */
/* */
/* Date BTS# Descrition */
/* ======= ====== ================================================= */
/* Feb1795 Create */
/* Oct3095 99999 Rewrite and add front end to the program */
/* */
/********************************************************************/
DCL PLIXOPT CHAR(50) VAR INIT('NOSPIE, NOSTAE') STATIC EXTERNAL;
/********************************************************************/
/* CLIENT LIBRARY PL/I COPY BOOK */
/********************************************************************/
%INCLUDE CTPUBLIC;
/*------------------------------------------------------------------*/
/* CICS BMS DEFINITIONS PL/I COPY BOOK */
/*------------------------------------------------------------------*/
%INCLUDE SYCTBA4;
/*------------------------------------------------------------------*/
/* Standard CICS Attribute and Print Control Chararcter List */
/*------------------------------------------------------------------*/
%INCLUDE DFHBMSCA;
/*------------------------------------------------------------------*/
/* CICS Standard Attention Identifiers PL/I Copy Book */
/*------------------------------------------------------------------*/
%INCLUDE DFHAID;
/*------------------------------------------------------------------*/
/* CLIENT LIB ROUTINES DECLARATIONS */
/*------------------------------------------------------------------*/
DCL
CSBCTXAL ENTRY OPTIONS(INTER ASSEMBLER),
CSBCTXDR ENTRY OPTIONS(INTER ASSEMBLER),
CTBBIND ENTRY OPTIONS(INTER ASSEMBLER),
CTBCLOSE ENTRY OPTIONS(INTER ASSEMBLER),
CTBCMDAL ENTRY OPTIONS(INTER ASSEMBLER),
CTBCMDDR ENTRY OPTIONS(INTER ASSEMBLER),
CTBCOMMA ENTRY OPTIONS(INTER ASSEMBLER),
CTBCONAL ENTRY OPTIONS(INTER ASSEMBLER),
CTBCONDR ENTRY OPTIONS(INTER ASSEMBLER),
CTBCONPR ENTRY OPTIONS(INTER ASSEMBLER),
CTBCONNE ENTRY OPTIONS(INTER ASSEMBLER),
CTBDESCR ENTRY OPTIONS(INTER ASSEMBLER),
CTBDIAG ENTRY OPTIONS(INTER ASSEMBLER),
CTBEXIT ENTRY OPTIONS(INTER ASSEMBLER),
CTBFETCH ENTRY OPTIONS(INTER ASSEMBLER),
CTBINIT ENTRY OPTIONS(INTER ASSEMBLER),
CTBPARAM ENTRY OPTIONS(INTER ASSEMBLER),
CTBRESUL ENTRY OPTIONS(INTER ASSEMBLER),
CTBSEND ENTRY OPTIONS(INTER ASSEMBLER);
/*------------------------------------------------------------------*/
/* BUILT IN FUNCTIONS DECLARATIONS */
/*------------------------------------------------------------------*/
DCL
ADDR BUILTIN,
CSTG BUILTIN,
INDEX BUILTIN,
LENGTH BUILTIN,
STG BUILTIN,
SUBSTR BUILTIN;
DCL
SYSPRINT STREAM OUTPUT PRINT ;
/*------------------------------------------------------------------*/
/* WORK AREAS */
/*------------------------------------------------------------------*/
DCL
01 CS_LIB_MISC_FIELDS,
05 CSL_CMD_HANDLE FIXED BIN(31) INIT(0),
05 CSL_CON_HANDLE FIXED BIN(31) INIT(0),
05 CSL_CTX_HANDLE FIXED BIN(31) INIT(0),
05 CSL_NULL FIXED BIN(31) INIT(0),
05 CSL_RC FIXED BIN(31);
DCL
01 PROPS_FIELDS,
05 PF_SERVER CHAR(30) INIT(' '),
05 PF_SERVER_SIZE FIXED BIN(31) INIT(0),
05 PF_USER CHAR(08) INIT(' '),
05 PF_USER_SIZE FIXED BIN(31) INIT(0),
05 PF_PWD CHAR(08) INIT(' '),
05 PF_PWD_SIZE FIXED BIN(31) INIT(0),
05 PF_TRAN CHAR(08) INIT(' '),
05 PF_TRANL FIXED BIN(31) INIT(0),
05 PF_NETDRV CHAR(08) INIT(' '),
05 PF_DRV_SIZE FIXED BIN(31) INIT(0),
05 PF_DEPT CHAR(03) INIT('D11'),
05 PF_DEPT_SIZE FIXED BIN(31) INIT(3),
05 PF_MSGLIMIT FIXED BIN(31),
05 PF_STRLEN FIXED BIN(31);
DCL
01 PARAM_FIELDS,
05 PM_LEN FIXED BIN(31),
05 PM_PARAM1 FIXED BIN(31),
05 PM_PARAM2 CHAR(03) VAR INIT(' '),
05 PM_NULLIND FIXED BIN(15);
DCL
01 FETCH_FIELDS,
05 FF_ROWS_READ FIXED BIN(31),
05 FF_ROW_NUM FIXED BIN(31) INIT(0);
DCL
01 OUTPUT_ROW,
05 OR_COL_FIRSTNME PIC'(12)X',
05 SPACE1 CHAR(01) INIT(' '),
05 OR_COL_LASTNAME PIC'(15)X',
05 SPACE2 CHAR(01) INIT(' '),
05 OR_COL_EDUCLVL PIC'ZZ9',
05 SPACE3 CHAR(08) INIT(' '),
05 OR_COL_JOBCODE PIC'ZZ9V.',
05 SPACE4 CHAR(06) INIT(' '),
05 OR_COL_SALARY PIC'ZZ,ZZZV.99';
DCL
01 OUTPUT_ROW_STR CHAR(59)
DEFINED OUTPUT_ROW;
DCL
01 OUTPUT_ROW2,
05 OR2_PAREN CHAR(01) INIT('('),
05 OR2_COL_RET1 PIC'99999',
05 OR2_MESSAGE CHAR(17)
INIT(' row(s) affected)');
DCL
01 OUTPUT_ROW_STR2 CHAR(23)
DEFINED OUTPUT_ROW2;
DCL
01 COLUMN_FIELDS,
05 CF_COL_FIRSTNME CHAR(12) VAR,
05 CF_COL_LASTNAME CHAR(15) VAR,
05 CF_COL_EDUCLVL FIXED BIN(15) INIT(0),
05 CF_COL_JOBCODE FIXED DEC(5,2),
05 CF_COL_SALARY FIXED DEC(8,2),
05 CF_COL_LEN FIXED BIN(31),
05 CF_COL_NULL FIXED BIN(31) INIT(0),
05 CF_COL_NUMBER FIXED BIN(31) INIT(1),
05 CF_COL_INDICATOR FIXED BIN(15) INIT(0);
DCL
01 CMD_FIELDS STATIC,
05 CF_CMD CHAR(04) INIT('SYR2');
DCL
01 RESULTS_FIELDS,
05 RF_TYPE FIXED BIN(31);
DCL
01 DATAFMT,
05 DF_NAME CHAR(132),
05 DF_NAMELEN FIXED BIN(31),
05 DF_DATATYPE FIXED BIN(31),
05 DF_FORMAT FIXED BIN(31),
05 DF_MAXLENGTH FIXED BIN(31),
05 DF_SCALE FIXED BIN(31),
05 DF_PRECISION FIXED BIN(31),
05 DF_STATUS FIXED BIN(31),
05 DF_COUNT FIXED BIN(31),
05 DF_USERTYPE FIXED BIN(31),
05 DF_LOCALE CHAR(68);
DCL
01 DISP_MSG,
05 TEST_CASE CHAR(09) INIT('SYCTSAR4 '),
05 MSG,
10 SAMP_LIT CHAR(05) INIT('rc = '),
10 SAMP_RC PIC'99',
10 REST_LIT CHAR(15)
INIT(' Result Type: '),
10 REST_TYPE PIC'9999',
10 FILLER CHAR(03) INIT(' '),
10 MSGSTR CHAR(40) INIT(' ');
DCL
BAD_INPUT BIT(01) INIT('0'B),
BLANK CHAR(01) INIT(' '),
BLANK_13 CHAR(13) INIT(' '),
FALSE BIT(01) INIT('0'B),
I1 FIXED BIN(15) INIT(0),
MAX_SCREEN_ROWS FIXED BIN(15) INIT(07 ),
MSG_TEXT_1 CHAR(79) INIT(' '),
MSG_TEXT_2 CHAR(79) INIT(' '),
PAGE_CNT FIXED BIN(31) INIT(0),
OUTLEN FIXED BIN(31) INIT(0),
PARM_CNT FIXED BIN(31),
NETDRIVER FIXED BIN(31) INIT(9999),
STRLEN FIXED BIN(31) INIT(0),
TMP_TIME CHAR(08) INIT(' '),
TMP_DATE CHAR(08) INIT(' '),
TRUE BIT(01) INIT('1'B),
UTIME FIXED DEC(15) INIT(0);
DCL
DIAG_MSGS_INITIALIZED BIT(1) INIT('0'B),
ENTER_DATA_SW BIT(1) INIT('0'B),
NO_ERRORS_SW BIT(1) INIT('0'B),
NO_MORE_RESULTS BIT(1) INIT('0'B),
NO_MORE_ROWS BIT(1) INIT('0'B),
PRINT_ONCE BIT(1) INIT('1'B);
DCL
01 QUERY_FIELDS,
05 QF_LEN FIXED BIN(15) INIT(1),
05 QF_MAXLEN FIXED BIN(15) INIT(1),
05 QF_ANSWER CHAR(01) INIT(' ');
DCL
01 CANCELED_FIELDS,
05 CICS_RESPONSE FIXED BIN(31);
DCL
01 DIAG_FIELDS,
05 DG_MSGNO FIXED BIN(31) INIT(1),
05 DG_NUM_OF_MSGS FIXED BIN(31) INIT(0);
/*------------------------------------------------------------------*/
/* Client Message Structure */
/*------------------------------------------------------------------*/
DCL
01 CLIENT_MSG,
05 CM_SEVERITY FIXED BIN(31),
05 CM_MSGNO FIXED BIN(31),
05 CM_TEXT CHAR(256),
05 CM_TEXT_LEN FIXED BIN(31),
05 CM_OS_MSGNO FIXED BIN(31),
05 CM_OS_MSGTXT CHAR(256),
05 CM_OS_MSGTEXT_LEN FIXED BIN(31),
05 CM_STATUS FIXED BIN(31);
DCL
01 DISP_CLIENT_MSG_1,
05 CM_SEVERITY_HDR CHAR(13)
INIT(' Severity: '),
05 CM_SEVERITY_DATA PIC'ZZZ9',
05 CM_STATUS_HDR CHAR(12)
INIT(', Status: '),
05 CM_STATUS_DATA PIC'ZZZ9' ;
DCL
01 DISP_CLIENT_MSG_2,
05 CM_OC_MSGNO_HDR CHAR(13)
INIT(' OC MsgNo: '),
05 CM_OC_MSGNO_DATA PIC'ZZZZZZZ9' ;
DCL
01 DISP_CLIENT_MSG_3,
05 CM_OC_MSG_HDR CHAR(13)
INIT(' OC MsgTx: '),
05 CM_OC_MSG_DATA CHAR(66);
DCL
01 DISP_CLIENT_MSG_3A,
05 CM_OC_MSG_DATA_1 CHAR(66),
05 CM_OC_MSG_DATA_2 CHAR(66),
05 CM_OC_MSG_DATA_3 CHAR(66),
05 CM_OC_MSG_DATA_4 CHAR(58);
DCL
01 DISP_CLIENT_MSG_3B,
05 FILLER CHAR(13) INIT(' '),
05 CM_OC_MSG_DATA_X CHAR(66);
DCL
01 DISP_CLIENT_MSG_4,
05 CM_OS_MSG_HDR CHAR(13)
INIT(' OS MsgNo: '),
05 CM_OS_MSGNO_DATA PIC'ZZZZZZZ9' ;
DCL
01 DISP_CLIENT_MSG_5,
05 CM_OS_MSG_HDR CHAR(13)
INIT(' OS MsgTx: '),
05 CM_OS_MSG_DATA CHAR(66);
/*------------------------------------------------------------------*/
/* Server Message Structure */
/*------------------------------------------------------------------*/
DCL
01 SERVER_MSG,
05 SM_MSGNO FIXED BIN(31),
05 SM_STATE FIXED BIN(31),
05 SM_SEV FIXED BIN(31),
05 SM_TEXT CHAR(256),
05 SM_TEXT_LEN FIXED BIN(31),
05 SM_SVRNAME CHAR(256),
05 SM_SVRNAME_LEN FIXED BIN(31),
05 SM_PROC CHAR(256),
05 SM_PROC_LEN FIXED BIN(31),
05 SM_LINE FIXED BIN(31),
05 SM_STATUS FIXED BIN(31);
DCL
01 DISP_SERVER_MSG_1,
05 SM_MSG_NO_HDR CHAR(13)
INIT(' Message#: '),
05 SM_MSG_NO_DATA PIC'ZZZZZZZ9',
05 SM_SEVERITY_HDR CHAR(14)
INIT(', Severity: '),
05 SM_SEVERITY_DATA PIC'ZZZ9',
05 SM_STATE_HDR CHAR(14)
INIT(', State No: '),
05 SM_STATE_DATA PIC'ZZZ9' ;
DCL
01 DISP_SERVER_MSG_2,
05 SM_LINE_NO_HDR CHAR(13)
INIT(' Line No: '),
05 SM_LINE_NO_DATA PIC'ZZZ9',
05 SM_STATUS_HDR CHAR(14)
INIT(', Status : '),
05 SM_STATUS_DATA PIC'ZZZ9' ;
DCL
01 DISP_SERVER_MSG_3,
05 SM_SVRNAME_HDR CHAR(13)
INIT(' Serv Nam: '),
05 SM_SVRNAME_DATA CHAR(66) ;
DCL
01 DISP_SERVER_MSG_4,
05 SM_PROC_ID_HDR CHAR(13)
INIT(' Proc ID: '),
05 SM_PROC_ID_DATA CHAR(66);
DCL
01 DISP_SERVER_MSG_5,
05 SM_MSG_HDR CHAR(13)
INIT(' Message : '),
05 SM_MSG_DATA CHAR(66);
DCL
01 DISP_SERVER_MSG_5X,
05 FILLER CHAR(13) INIT(' '),
05 SM_MSG_DATA_X CHAR(66);
/*------------------------------------------------------------------*/
/* CICS Condition Handler */
/*------------------------------------------------------------------*/
EXEC CICS HANDLE CONDITION MAPFAIL(NO_INPUT)
ERROR(ERRORS) ;
/*------------------------------------------------------------------*/
/* CICS Aid Handler */
/*------------------------------------------------------------------*/
EXEC CICS HANDLE AID ANYKEY(NO_INPUT)
CLEAR(GETOUT) ;
/*------------------------------------------------------------------*/
/* program initialization */
/*------------------------------------------------------------------*/
DIAG_MSGS_INITIALIZED = TRUE ;
MSG_TEXT_2 = 'Press Clear To Exit';
NO_ERRORS_SW = TRUE ;
PAGE_CNT = PAGE_CNT + 1;
SERVERL = -1 ;
DO I1 = 1 TO 13 ;
RSLTNO( I1 ) = BLANK ;
END ;
CALL GET_SYSTEM_TIME ;
GET_INPUT_AGAIN:
CALL DISPLAY_INITIAL_SCREEN ;
CALL GET_INPUT_DATA ;
/*------------------------------------------------------------------*/
/* allocate a context structure */
/*------------------------------------------------------------------*/
CALL CSBCTXAL( CS_VERSION_46,
CSL_RC,
CSL_CTX_HANDLE );
IF CSL_RC ^= CS_SUCCEED THEN
DO;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CSCTXALLOC failed';
CALL ERROR_OUT;
CALL ALL_DONE;
END;
/*------------------------------------------------------------------*/
/* initialize the Client-Library */
/*------------------------------------------------------------------*/
CALL CTBINIT( CSL_CTX_HANDLE,
CSL_RC,
CS_VERSION_46 );
IF CSL_RC ^= CS_SUCCEED THEN
DO;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBINIT failed';
CALL ERROR_OUT;
CALL ALL_DONE;
END;
CALL PROCESS_INPUT ;
CALL QUIT_CLIENT_LIBRARY ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to get system time */
/* */
/*------------------------------------------------------------------*/
GET_SYSTEM_TIME: PROC ;
EXEC CICS ASKTIME ABSTIME(UTIME);
EXEC CICS FORMATTIME
ABSTIME(UTIME)
DATESEP('/')
MMDDYY(TMP_DATE)
TIME(TMP_TIME)
TIMESEP ;
END GET_SYSTEM_TIME ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to get system time */
/* */
/*------------------------------------------------------------------*/
DISPLAY_INITIAL_SCREEN: PROC ;
SDATEO = TMP_DATE ;
STIMEO = TMP_TIME ;
MSG1O = MSG_TEXT_1 ;
PROGNMO = 'SYCTSAR4' ;
MSG1O = MSG_TEXT_1 ;
MSG2O = MSG_TEXT_2 ;
SPAGEO = '0001' ;
EXEC CICS SEND MAP('A4PANEL')
MAPSET('SYCTBA4')
CURSOR
FRSET
ERASE
FREEKB ;
END DISPLAY_INITIAL_SCREEN ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to get input data */
/* */
/*------------------------------------------------------------------*/
GET_INPUT_DATA: PROC ;
EXEC CICS RECEIVE MAP('A4PANEL')
MAPSET('SYCTBA4')
ASIS ;
IF SERVERL = 0 THEN
DO ;
IF PF_SERVER = BLANK THEN
DO ;
SERVERL = -1 ; /* set the cursor position */
MSG_TEXT_1 = 'Please Enter Server Name' ;
ENTER_DATA_SW = TRUE ;
END ;
END ;
ELSE DO ;
PF_SERVER = SERVERI ;
PF_SERVER_SIZE = SERVERL ;
END ;
IF USERL = 0 THEN
DO ;
IF PF_USER = BLANK THEN
DO ;
USERL = -1 ; /* set the cursor position */
MSG_TEXT_1 = 'Please Enter User-ID' ;
ENTER_DATA_SW = TRUE ;
END ;
END ;
ELSE DO ;
PF_USER = USERI ;
PF_USER_SIZE = USERL ;
END ;
IF PSWDL ^= 0 THEN
DO ;
PF_PWD = PSWDI;
PF_PWD_SIZE = PSWDL ;
END ;
IF TRANL ^= 0 THEN
DO ;
PF_TRAN = TRANI;
PF_TRANL = TRANL ;
END ;
IF NETDRVL ^= 0 THEN
DO ;
PF_NETDRV = NETDRVI ;
PF_DRV_SIZE = NETDRVL ;
END ;
IF ENTER_DATA_SW = TRUE THEN
DO ;
ENTER_DATA_SW = FALSE ;
CALL DISPLAY_INITIAL_SCREEN ;
MSG_TEXT_1 = BLANK ;
CALL GET_INPUT_DATA ;
END ;
END GET_INPUT_DATA ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to process input data */
/* */
/*------------------------------------------------------------------*/
PROCESS_INPUT: PROC ;
/*------------------------------------------------------------*/
/* allocate a connection to the server */
/*------------------------------------------------------------*/
CSL_CON_HANDLE = 0 ;
CALL CTBCONAL( CSL_CTX_HANDLE,
CSL_RC,
CSL_CON_HANDLE ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBCONALLOC failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* alter properties of the connection for user-id */
/*------------------------------------------------------------*/
CALL CTBCONPR( CSL_CON_HANDLE,
CSL_RC,
CS_SET,
CS_USERNAME,
PF_USER,
PF_USER_SIZE,
CS_FALSE,
OUTLEN ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBCONPROPS for user-id failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* alter properties of the connection for password */
/*------------------------------------------------------------*/
CALL CTBCONPR( CSL_CON_HANDLE,
CSL_RC,
CS_SET,
CS_PASSWORD,
PF_PWD,
PF_PWD_SIZE,
CS_FALSE,
OUTLEN ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBCONPROPS for password failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* alter properties of the connection for transaction */
/*------------------------------------------------------------*/
CALL CTBCONPR( CSL_CON_HANDLE,
CSL_RC,
CS_SET,
CS_TRANSACTION_NAME,
PF_TRAN,
PF_TRANL,
CS_FALSE,
OUTLEN ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBCONPROPS for transaction failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* alter properties of the connection for Network driver */
/*------------------------------------------------------------*/
SELECT;
WHEN (PF_NETDRV = ' ')
NETDRIVER = CS_LU62 ;
WHEN (PF_NETDRV = 'LU62' | PF_NETDRV = 'lu62')
NETDRIVER = CS_LU62 ;
WHEN (PF_NETDRV = 'IBMTCPIP' | PF_NETDRV = 'ibmtcpip')
NETDRIVER = CS_TCPIP ;
WHEN (PF_NETDRV = 'INTERLIN' | PF_NETDRV = 'interlin')
NETDRIVER = CS_INTERLINK ;
WHEN (PF_NETDRV = 'CPIC' | PF_NETDRV = 'cpic')
NETDRIVER = CS_NCPIC ;
OTHERWISE
DO;
MSGSTR = 'Invalid Network driver entered';
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END;
END;
CALL CTBCONPR( CSL_CON_HANDLE,
CSL_RC,
CS_SET,
CS_NET_DRIVER,
NETDRIVER,
CS_UNUSED,
CS_FALSE,
OUTLEN ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBCONPROPS for Network driver failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* setup retrieval of All Messages */
/*------------------------------------------------------------*/
CALL CTBDIAG( CSL_CON_HANDLE,
CSL_RC,
CS_UNUSED,
CS_INIT,
CS_ALLMSG_TYPE,
CS_UNUSED,
CS_UNUSED ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBDIAG CS_INIT failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* set the upper limit of number of messages */
/*------------------------------------------------------------*/
PF_MSGLIMIT = 5 ;
CALL CTBDIAG( CSL_CON_HANDLE,
CSL_RC,
CS_UNUSED,
CS_MSGLIMIT,
CS_ALLMSG_TYPE,
CS_UNUSED,
PF_MSGLIMIT ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBDIAG CS_MSGLIMIT failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* open connection to the server or CICS region */
/*------------------------------------------------------------*/
CALL CTBCONNE( CSL_CON_HANDLE,
CSL_RC,
PF_SERVER,
PF_SERVER_SIZE,
CS_FALSE ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBCONNECT failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* invokes SEND_COMMAND routine */
/*------------------------------------------------------------*/
IF NO_ERRORS_SW
THEN
CALL SEND_PARAM ;
/*------------------------------------------------------------*/
/* process the results of the command */
/*------------------------------------------------------------*/
IF NO_ERRORS_SW THEN
DO ;
DO WHILE( ^NO_MORE_RESULTS ) ;
CALL PROCESS_RESULTS ;
END ;
CALL CLOSE_CONNECTION ;
END ;
END PROCESS_INPUT ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to allocate, send, and process commands */
/* */
/*------------------------------------------------------------------*/
SEND_PARAM: PROC ;
/*------------------------------------------------------------*/
/* allocate a command handle */
/*------------------------------------------------------------*/
CALL CTBCMDAL( CSL_CON_HANDLE,
CSL_RC,
CSL_CMD_HANDLE ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBCMDALLOC failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* prepare the command (an RPC request) */
/*------------------------------------------------------------*/
PF_STRLEN = STG(CF_CMD);
CALL CTBCOMMA( CSL_CMD_HANDLE,
CSL_RC,
CS_RPC_CMD,
CF_CMD,
PF_STRLEN,
CS_UNUSED );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBCOMMAND failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* */
/* setup a return parameter for NUM_OF_ROWS */
/* */
/* describe the first parameter (NUM_OF_ROWS) */
/* */
/*------------------------------------------------------------*/
DF_NAME = '@parm1';
DF_NAMELEN = 6;
DF_DATATYPE = CS_INT_TYPE;
DF_FORMAT = CS_FMT_UNUSED;
DF_MAXLENGTH = CS_UNUSED;
DF_STATUS = CS_RETURN;
DF_USERTYPE = CS_UNUSED;
PM_LEN = STG(PM_PARAM1);
PM_PARAM1 = 0; /* NUM_OF_ROWS */
PM_NULLIND = 0;
CALL CTBPARAM( CSL_CMD_HANDLE,
CSL_RC,
DATAFMT,
PM_PARAM1,
PM_LEN,
PM_NULLIND );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBPARAM CS_INT_TYPE parm1 failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* */
/* describe the second parameter (DEPTNO) */
/* */
/*------------------------------------------------------------*/
DF_NAME = '@parm2';
DF_NAMELEN = 6;
DF_DATATYPE = CS_VARCHAR_TYPE;
DF_FORMAT = CS_FMT_UNUSED;
DF_MAXLENGTH = CS_UNUSED;
DF_STATUS = CS_INPUTVALUE;
DF_USERTYPE = CS_UNUSED;
PM_PARAM2 = PF_DEPT; /* DEPTNO */
PM_LEN = PF_DEPT_SIZE ;
PM_NULLIND = 0;
CALL CTBPARAM( CSL_CMD_HANDLE,
CSL_RC,
DATAFMT,
PM_PARAM2,
PM_LEN,
PM_NULLIND );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBPARAM CS_VARCHAR_TYPE parm2 failed' ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* send the command */
/*------------------------------------------------------------*/
CALL CTBSEND( CSL_CMD_HANDLE,
CSL_RC ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBSEND failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
END SEND_PARAM ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to process the result */
/* */
/*------------------------------------------------------------------*/
PROCESS_RESULTS: PROC ;
/*------------------------------------------------------------*/
/* set up the results data */
/*------------------------------------------------------------*/
CALL CTBRESUL( CSL_CMD_HANDLE,
CSL_RC,
RF_TYPE ) ;
/*------------------------------------------------------------*/
/* determine the outcome of the comand execution */
/*------------------------------------------------------------*/
SELECT( CSL_RC ) ;
WHEN( CS_SUCCEED )
DO ;
/*--------------------------------------------------------------*/
/* determine the type of result returned by the current request */
/*--------------------------------------------------------------*/
SELECT( RF_TYPE ) ;
/*------------------------------------------------------------*/
/* process row results */
/*------------------------------------------------------------*/
WHEN( CS_ROW_RESULT )
DO ;
CALL RESULT_ROW_PROCESSING ;
DO WHILE( ^NO_MORE_ROWS ) ;
CALL FETCH_ROW_PROCESSING ;
END ;
END ;
/*------------------------------------------------------------*/
/* process parameter results --- there should be no parameter */
/* to process */
/*------------------------------------------------------------*/
WHEN( CS_PARAM_RESULT )
DO ;
NO_MORE_ROWS = FALSE ;
CALL RESULT_PARAM_PROCESSING ;
CALL FETCH_PARAM_PROCESSING ;
END ;
/*------------------------------------------------------------*/
/* process status results --- the stored procedure status */
/* result will not be processed in this example */
/*------------------------------------------------------------*/
WHEN( CS_STATUS_RESULT )
DO ;
NO_MORE_ROWS = FALSE ;
CALL CTBFETCH( CSL_CMD_HANDLE,
CSL_RC,
CS_UNUSED, /* type */
CS_UNUSED, /* offset */
CS_UNUSED, /* option */
FF_ROWS_READ );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBFETCH status failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
END ;
/*------------------------------------------------------------*/
/* print an error message if the server encountered an error */
/* while executing the request */
/*------------------------------------------------------------*/
WHEN( CS_CMD_FAIL )
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBRESUL failed with CS_CMD_FAIL restype' ;
CALL ERROR_OUT ;
END ;
/*------------------------------------------------------------*/
/* print a message for successful commands that returned no */
/* data( optional ) */
/*------------------------------------------------------------*/
WHEN( CS_CMD_SUCCEED )
DO ;
MSGSTR =
'CTBRESUL returned CS_CMD_SUCCEED restype' ;
END ;
/*------------------------------------------------------------*/
/* print a message for requests that have been processed */
/* successfully( optional ) */
/*------------------------------------------------------------*/
WHEN( CS_CMD_DONE )
DO ;
MSGSTR =
'CTBRESUL returned CS_CMD_DONE restype' ;
END ;
OTHERWISE
DO ;
NO_MORE_RESULTS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBRESUL returned UNKNOWN restype' ;
CALL ERROR_OUT ;
END ;
END ; /* end of SELECT( RF_TYPE ) */
END ;
/*------------------------------------------------------------*/
/* print an error message if the CTBRESULTS call failed */
/*------------------------------------------------------------*/
WHEN( CS_FAIL )
DO ;
NO_MORE_RESULTS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBRESULTS failed with CS_FAIL ret_cd' ;
CALL ERROR_OUT ;
END ;
/*------------------------------------------------------------*/
/* drop out of the results loop if no more result sets are */
/* available for processing or if the results were cancelled */
/*------------------------------------------------------------*/
WHEN( CS_END_RESULTS )
DO ;
NO_MORE_RESULTS = TRUE ;
END ;
WHEN( CS_CANCELLED )
DO ;
NO_MORE_RESULTS = TRUE ;
END ;
OTHERWISE
DO ;
NO_MORE_RESULTS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBRESUL failed with unknown ret_cd' ;
CALL ERROR_OUT ;
END ;
END ; /* end of SELECT( CSL_RC ) */
RF_TYPE = 0 ;
END PROCESS_RESULTS ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to process result rows */
/* */
/*------------------------------------------------------------------*/
RESULT_ROW_PROCESSING: PROC ;
CALL BIND_ROW_PROCESSING ;
END RESULT_ROW_PROCESSING ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to bind each data */
/* */
/*------------------------------------------------------------------*/
BIND_ROW_PROCESSING: PROC ;
/*------------------------------------------------------------*/
/* We need to bind the data to program variables. We don't */
/* care about the indicator variable so we'll pass NULL for */
/* that PARAMeter in OC_BIND(). */
/*------------------------------------------------------------*/
/*------------------------------------------------------------*/
/* bind the first column, FIRSTNME defined as VARCHAR(12) */
/*------------------------------------------------------------*/
DF_DATATYPE = CS_VARCHAR_TYPE;
DF_FORMAT = CS_FMT_UNUSED;
DF_MAXLENGTH = STG(CF_COL_FIRSTNME) - 2;
DF_COUNT = 1; /* rows per fetch */
CF_COL_NUMBER = 1; /* bind the first column */
CALL CTBBIND( CSL_CMD_HANDLE,
CSL_RC,
CF_COL_NUMBER,
DATAFMT,
CF_COL_FIRSTNME,
CF_COL_LEN,
CS_PARAM_NOTNULL,
CF_COL_INDICATOR,
CS_PARAM_NULL );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBBIND CS_VARCHAR_TYPE column 1 failed' ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
/*------------------------------------------------------------*/
/* bind the second column, LASTNAME defined as VARCHAR(15) */
/*------------------------------------------------------------*/
DF_MAXLENGTH = STG(CF_COL_LASTNAME) - 2;
CF_COL_NUMBER = 2; /* bind the second column */
CALL CTBBIND( CSL_CMD_HANDLE,
CSL_RC,
CF_COL_NUMBER,
DATAFMT,
CF_COL_LASTNAME,
CF_COL_LEN,
CS_PARAM_NOTNULL,
CF_COL_INDICATOR,
CS_PARAM_NULL );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBBIND CS_VARCHAR_TYPE column 2 failed' ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
/*------------------------------------------------------------*/
/* bind the third column, EDUCLVL defined as SMALLINT */
/*------------------------------------------------------------*/
DF_DATATYPE = CS_SMALLINT_TYPE;
DF_MAXLENGTH = CS_UNUSED;
CF_COL_NUMBER = 3; /* bind the third column */
CALL CTBBIND( CSL_CMD_HANDLE,
CSL_RC,
CF_COL_NUMBER,
DATAFMT,
CF_COL_EDUCLVL,
CF_COL_LEN,
CS_PARAM_NOTNULL,
CF_COL_INDICATOR,
CS_PARAM_NULL );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBBIND CS_SMALLINT_TYPE column 3 failed' ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
/*------------------------------------------------------------*/
/* bind the fourth column, JOBCODE as DECIMAL(3,0). It will */
/* convert from float8 or money. */
/*------------------------------------------------------------*/
DF_DATATYPE = CS_PACKED370_TYPE;
DF_SCALE = CS_SRC_VALUE;
DF_PRECISION = CS_SRC_VALUE;
DF_MAXLENGTH = STG(CF_COL_JOBCODE);
CF_COL_NUMBER = 4; /* bind the fourth column */
CF_COL_JOBCODE = 1;
CALL CTBBIND( CSL_CMD_HANDLE,
CSL_RC,
CF_COL_NUMBER,
DATAFMT,
CF_COL_JOBCODE,
CF_COL_LEN,
CS_PARAM_NOTNULL,
CF_COL_INDICATOR,
CS_PARAM_NULL );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBBIND CS_PACKED370_TYPE column 4 fail' ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
/*------------------------------------------------------------*/
/* bind the fifth column, SALARY as DECIMAL(8,2). It will */
/* convert from money. */
/*------------------------------------------------------------*/
DF_MAXLENGTH = STG(CF_COL_SALARY);
CF_COL_NUMBER = 5; /* bind the fifth column */
CF_COL_SALARY = 0;
CALL CTBBIND( CSL_CMD_HANDLE,
CSL_RC,
CF_COL_NUMBER,
DATAFMT,
CF_COL_SALARY,
CF_COL_LEN,
CS_PARAM_NOTNULL,
CF_COL_INDICATOR,
CS_PARAM_NULL );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBBIND CS_PACKED370_TYPE column 5 fail' ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
END BIND_ROW_PROCESSING ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to fetch row processing */
/* */
/*------------------------------------------------------------------*/
FETCH_ROW_PROCESSING: PROC ;
CALL CTBFETCH( CSL_CMD_HANDLE,
CSL_RC,
CS_UNUSED, /* type */
CS_UNUSED, /* offset */
CS_UNUSED, /* option */
FF_ROWS_READ ) ;
SELECT( CSL_RC ) ;
WHEN( CS_SUCCEED )
DO ;
NO_MORE_ROWS = FALSE ;
IF FF_ROW_NUM = 0 THEN
DO ;
FF_ROW_NUM = FF_ROW_NUM + 1;
RSLTNO(FF_ROW_NUM) = 'FirstName ' ||
'LastName ' ||
'EducLvl ' ||
'JobCode ' ||
'Salary' ;
FF_ROW_NUM = FF_ROW_NUM + 1;
RSLTNO(FF_ROW_NUM) = '============ ' ||
'=============== ' ||
'======= ' ||
'======= ' ||
'=========' ;
END ;
FF_ROW_NUM = FF_ROW_NUM + 1;
IF FF_ROW_NUM > MAX_SCREEN_ROWS THEN
DO ;
MSG_TEXT_1 = 'Please press return to continue!' ;
MSG_TEXT_2 = BLANK ;
CALL DISP_DATA ;
DO FF_ROW_NUM = 1 TO MAX_SCREEN_ROWS ;
RSLTNO( MAX_SCREEN_ROWS ) = BLANK ;
END ;
PAGE_CNT = PAGE_CNT + 1 ;
FF_ROW_NUM = 1;
RSLTNO(FF_ROW_NUM) = 'FirstName ' ||
'LastName ' ||
'EducLvl ' ||
'JobCode ' ||
'Salary' ;
FF_ROW_NUM = FF_ROW_NUM + 1;
RSLTNO(FF_ROW_NUM) = '============ ' ||
'=============== ' ||
'======= ' ||
'======= ' ||
'=========' ;
FF_ROW_NUM = FF_ROW_NUM + 1;
END ;
/*------------------------------------------------------------*/
/* display results */
/*------------------------------------------------------------*/
OR_COL_FIRSTNME = CF_COL_FIRSTNME;
OR_COL_LASTNAME = CF_COL_LASTNAME;
OR_COL_EDUCLVL = CF_COL_EDUCLVL;
OR_COL_JOBCODE = CF_COL_JOBCODE;
OR_COL_SALARY = CF_COL_SALARY;
RSLTNO(FF_ROW_NUM) = OUTPUT_ROW_STR;
END ; /* end of WHEN( CS_SUCCEED ) */
WHEN( CS_END_DATA )
DO ;
NO_MORE_ROWS = TRUE ;
MSG_TEXT_1 = 'All rows processing completed!' ;
MSG_TEXT_2 = 'Press Clear To Exit';
CALL DISP_DATA ;
END ; /* end of WHEN( CS_END_DATA ) */
WHEN( CS_FAIL )
DO ;
NO_MORE_ROWS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBFETCH returned CS_FAIL ret_cd' ;
CALL ERROR_OUT;
END ; /* end of WHEN( CS_FAIL ) */
WHEN( CS_ROW_FAIL )
DO ;
NO_MORE_ROWS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBFETCH returned CS_ROW_FAIL ret_cd' ;
CALL ERROR_OUT;
END ; /* end of WHEN( CS_ROW_FAIL ) */
WHEN( CS_CANCELLED )
DO ;
NO_MORE_ROWS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR = 'CTBFETCH returned CS_CANCELLED ret_cd' ;
CALL ERROR_OUT;
END ; /* end of WHEN( CS_CANCELLED ) */
OTHERWISE
DO ;
NO_MORE_ROWS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBFETCH returned Unknown ret_cd' ;
CALL ERROR_OUT;
END ; /* end of OTHERWISE */
END ; /* end of SELECT( CSL_RC ) */
END FETCH_ROW_PROCESSING ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to describe the returned parameters */
/* */
/*------------------------------------------------------------------*/
RESULT_PARAM_PROCESSING: PROC;
I1 = 1;
CALL CTBDESCR( CSL_CMD_HANDLE,
CSL_RC,
I1,
DATAFMT ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBDESCR failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* bind the return parameter, NUM_OF_ROWS defined as INTEGER */
/*------------------------------------------------------------*/
DF_DATATYPE = CS_INT_TYPE;
DF_FORMAT = CS_FMT_UNUSED;
DF_MAXLENGTH = CS_UNUSED;
DF_COUNT = 1; /* rows per fetch */
CF_COL_NUMBER = 1; /* bind the first column */
CALL CTBBIND( CSL_CMD_HANDLE,
CSL_RC,
CF_COL_NUMBER,
DATAFMT,
PM_PARAM1,
CF_COL_LEN,
CS_PARAM_NOTNULL,
CF_COL_INDICATOR,
CS_PARAM_NULL );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBBIND return parameter failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
END RESULT_PARAM_PROCESSING ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to fetch return parameter */
/* */
/*------------------------------------------------------------------*/
FETCH_PARAM_PROCESSING: PROC ;
CALL CTBFETCH( CSL_CMD_HANDLE,
CSL_RC,
CS_UNUSED,
CS_UNUSED,
CS_UNUSED,
FF_ROWS_READ );
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBFETCH return parameter failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
FF_ROW_NUM = FF_ROW_NUM + 1;
OR2_COL_RET1 = PM_PARAM1;
RSLTNO(FF_ROW_NUM) = OUTPUT_ROW_STR2;
END FETCH_PARAM_PROCESSING ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to print output messages. */
/* */
/*------------------------------------------------------------------*/
ERROR_OUT: PROC;
SAMP_RC = CSL_RC;
REST_TYPE = RF_TYPE ;
IF DIAG_MSGS_INITIALIZED & ^BAD_INPUT
THEN
CALL GET_DIAG_MESSAGES ;
/*------------------------------------------------------------------*/
/* display error message */
/*------------------------------------------------------------------*/
MSG_TEXT_1 = TEST_CASE || SAMP_LIT || SAMP_RC ||
REST_LIT || REST_TYPE || ' ' ||
MSGSTR ;
IF PRINT_ONCE THEN
DO ;
CALL DISP_DATA ;
PRINT_ONCE = FALSE ;
END ;
NO_ERRORS_SW = FALSE ;
MSGSTR = BLANK ;
SAMP_RC = 0;
REST_TYPE = 0 ;
END ERROR_OUT;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to retrieve any diagnostic messages */
/* */
/*------------------------------------------------------------------*/
GET_DIAG_MESSAGES: PROC ;
DCL CNT FIXED BIN(15) ;
/*------------------------------------------------------------------*/
/* Disable calls to this subroutine */
/*------------------------------------------------------------------*/
DIAG_MSGS_INITIALIZED = FALSE ;
/*------------------------------------------------------------------*/
/* First, get client messages */
/*------------------------------------------------------------------*/
CALL CTBDIAG( CSL_CON_HANDLE,
CSL_RC,
CS_UNUSED,
CS_STATUS,
CS_CLIENTMSG_TYPE,
CS_UNUSED,
DG_NUM_OF_MSGS ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBDIAG CS_STATUS CLIENTMSG_TYPE failed';
CALL ERROR_OUT ;
CALL ALL_DONE ;
END ;
ELSE DO ;
IF DG_NUM_OF_MSGS > 0 THEN
DO ;
DO CNT = 1 TO DG_NUM_OF_MSGS ;
CALL RETRIEVE_CLIENT_MSGS ;
END ;
END ;
END ;
/*------------------------------------------------------------------*/
/* Then, get server messages */
/*------------------------------------------------------------------*/
CALL CTBDIAG( CSL_CON_HANDLE,
CSL_RC,
CS_UNUSED,
CS_STATUS,
CS_SERVERMSG_TYPE,
CS_UNUSED,
DG_NUM_OF_MSGS ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBDIAG CS_STATUS SERVERMSG_TYPE failed' ;
CALL ERROR_OUT ;
CALL ALL_DONE ;
END ;
ELSE DO ;
IF DG_NUM_OF_MSGS > 0 THEN
DO ;
DO CNT = 1 TO DG_NUM_OF_MSGS ;
CALL RETRIEVE_SERVER_MSGS ;
END ;
END ;
END ;
END GET_DIAG_MESSAGES ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to retrieve diagnostic messages from client */
/* */
/*------------------------------------------------------------------*/
RETRIEVE_CLIENT_MSGS: PROC ;
I1 = 1 ;
CALL CTBDIAG( CSL_CON_HANDLE,
CSL_RC,
CS_UNUSED,
CS_GET,
CS_CLIENTMSG_TYPE,
DG_MSGNO,
CLIENT_MSG ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBDIAG CS_GET CS_CLIENTMSG_TYPE FAILED' ;
CALL ERROR_OUT ;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------------*/
/* display message text */
/*------------------------------------------------------------------*/
RSLTNO( I1 ) = 'Client Message:' ;
I1 = 3 ;
CM_SEVERITY_DATA = CM_SEVERITY ;
CM_STATUS_DATA = CM_STATUS ;
RSLTNO( I1 ) = CM_SEVERITY_HDR || CM_SEVERITY_DATA ||
CM_STATUS_HDR || CM_STATUS_DATA ;
I1 = I1 + 1 ;
CM_OC_MSGNO_DATA = CM_MSGNO ;
RSLTNO( I1 ) = CM_OC_MSGNO_HDR || CM_OC_MSGNO_DATA ;
I1 = I1 + 1 ;
IF CM_MSGNO ^= 0 THEN
DO ;
CM_OC_MSG_DATA = SUBSTR( CM_TEXT, 1, 66 ) ;
RSLTNO( I1 ) = ' OC MsgTx: ' || CM_OC_MSG_DATA ;
I1 = I1 + 1 ;
IF CM_TEXT_LEN > 66 THEN
DO ;
CM_OC_MSG_DATA_X = SUBSTR( CM_TEXT, 67, 66 ) ;
RSLTNO( I1 ) = BLANK_13 || CM_OC_MSG_DATA_X ;
I1 = I1 + 1 ;
IF CM_TEXT_LEN > 132 THEN
DO ;
CM_OC_MSG_DATA_X = SUBSTR( CM_TEXT, 133, 66 ) ;
RSLTNO( I1 ) = BLANK_13 ||
CM_OC_MSG_DATA_X ;
I1 = I1 + 1 ;
IF CM_TEXT_LEN > 198 THEN
DO ;
CM_OC_MSG_DATA_X = SUBSTR( CM_TEXT, 199 ) ;
RSLTNO( I1 ) = BLANK_13 ||
CM_OC_MSG_DATA_X ;
I1 = I1 + 1 ;
END ;
END ;
END ;
END ;
ELSE DO ;
RSLTNO( I1 ) = ' OC MsgTx: No Message!' ;
I1 = I1 + 1 ;
END ;
CM_OS_MSGNO_DATA = CM_OS_MSGNO ;
RSLTNO( I1 ) = ' OS MsgNo: ' || CM_OS_MSGNO_DATA ;
I1 = I1 + 1 ;
IF CM_OS_MSGNO ^= 0 THEN
DO ;
CM_OS_MSG_DATA = SUBSTR( CM_OS_MSGTXT, 1, 66 ) ;
RSLTNO( I1 ) = ' OS MsgTx: ' ||
CM_OS_MSG_DATA ;
I1 = I1 + 1 ;
IF CM_OS_MSGTEXT_LEN > 66 THEN
DO ;
CM_OC_MSG_DATA_X = SUBSTR( CM_OS_MSGTXT, 67, 66 ) ;
RSLTNO( I1 ) = BLANK_13 || CM_OC_MSG_DATA_X ;
I1 = I1 + 1 ;
IF CM_OS_MSGTEXT_LEN > 132 THEN
DO ;
CM_OC_MSG_DATA_X = SUBSTR(CM_OS_MSGTXT,133,66);
RSLTNO( I1 ) = BLANK_13 || CM_OC_MSG_DATA_X ;
I1 = I1 + 1 ;
IF CM_OS_MSGTEXT_LEN > 198 THEN
DO ;
CM_OC_MSG_DATA_X = SUBSTR(CM_OS_MSGTXT,199);
RSLTNO( I1 ) = BLANK_13 ||
CM_OC_MSG_DATA_X ;
I1 = I1 + 1 ;
END ;
END ;
END ;
END ;
ELSE DO ;
RSLTNO( I1 ) = ' OS MsgTx: No Message!' ;
I1 = I1 + 1 ;
END ;
END RETRIEVE_CLIENT_MSGS ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to retrieve diagnostic messages from server */
/* */
/*------------------------------------------------------------------*/
RETRIEVE_SERVER_MSGS: PROC ;
CALL CTBDIAG( CSL_CON_HANDLE,
CSL_RC,
CS_UNUSED,
CS_GET,
CS_SERVERMSG_TYPE,
DG_MSGNO,
SERVER_MSG ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBDIAG CS_GET CS_SERVERMSG_TYPE failed' ;
CALL ERROR_OUT ;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------------*/
/* display message text */
/*------------------------------------------------------------------*/
SM_MSG_NO_DATA = SM_MSGNO ;
SM_SEVERITY_DATA = SM_SEV ;
SM_STATE_DATA = SM_STATE ;
SM_LINE_NO_DATA = SM_LINE ;
SM_STATUS_DATA = SM_STATUS ;
IF SM_SVRNAME_LEN > 66
THEN
SM_SVRNAME_DATA = SUBSTR( SM_SVRNAME, 1, 63 ) || '...' ;
ELSE
SM_SVRNAME_DATA = SUBSTR( SM_SVRNAME, 1, 66 ) ;
IF SM_PROC_LEN > 66
THEN
SM_PROC_ID_DATA = SUBSTR( SM_PROC, 1, 63 ) || '...' ;
ELSE
SM_PROC_ID_DATA = SUBSTR( SM_PROC, 1, 66 ) ;
SM_MSG_DATA = SUBSTR( SM_TEXT, 1, 66 ) ;
RSLTNO (1) = 'Server Message:' ;
RSLTNO (3) = SM_MSG_NO_HDR || SM_MSG_NO_DATA ||
SM_SEVERITY_HDR || SM_SEVERITY_DATA ||
SM_STATE_HDR || SM_STATE_DATA ;
RSLTNO (4) = SM_LINE_NO_HDR || SM_LINE_NO_DATA ||
SM_STATUS_HDR || SM_STATUS_DATA ;
RSLTNO (5) = SM_SVRNAME_HDR || SM_SVRNAME_DATA ;
RSLTNO (6) = SM_PROC_ID_HDR || SM_PROC_ID_DATA ;
RSLTNO (7) = SM_MSG_HDR || SM_MSG_DATA ;
IF SM_TEXT_LEN > 66 THEN
DO ;
SM_MSG_DATA_X = SUBSTR( SM_TEXT, 67, 66 ) ;
RSLTNO(8) = BLANK_13 || SM_MSG_DATA_X ;
IF SM_TEXT_LEN > 132 THEN
DO ;
SM_MSG_DATA_X = SUBSTR( SM_TEXT, 133, 66 ) ;
RSLTNO(9) = BLANK_13 || SM_MSG_DATA_X ;
IF SM_TEXT_LEN > 198 THEN
DO ;
SM_MSG_DATA_X = SUBSTR( SM_TEXT, 198 ) ;
RSLTNO(10) = BLANK_13 || SM_MSG_DATA_X ;
END ;
END ;
END ;
END RETRIEVE_SERVER_MSGS ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to drop and to deallocate all handlers, to close */
/* server connection and exit client library */
/* */
/*------------------------------------------------------------------*/
ALL_DONE: PROC ;
CALL CLOSE_CONNECTION;
CALL QUIT_CLIENT_LIBRARY;
STOP ;
END ALL_DONE ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to perform drop command handler, close server */
/* connection, and deallocate Connection Handler. */
/* */
/*------------------------------------------------------------------*/
CLOSE_CONNECTION: PROC ;
/*------------------------------------------------------------------*/
/* drop the command handle */
/*------------------------------------------------------------------*/
CALL CTBCMDDR( CSL_CMD_HANDLE,
CSL_RC ) ;
IF CSL_RC = CS_FAIL THEN
DO ;
MSGSTR = 'CTBCMDDROP CSL_CMD_HANDLE failed' ;
CALL ERROR_OUT ;
END ;
/*------------------------------------------------------------------*/
/* close the server connection */
/*------------------------------------------------------------------*/
CALL CTBCLOSE( CSL_CON_HANDLE,
CSL_RC,
CS_UNUSED ) ;
IF CSL_RC = CS_FAIL THEN
DO ;
MSGSTR = 'CTBCLOSE CSL_CON_HANDLE failed' ;
CALL ERROR_OUT ;
END ;
/*------------------------------------------------------------------*/
/* DE_ALLOCATE THE CONNECTION HANDLE */
/*------------------------------------------------------------------*/
CALL CTBCONDR( CSL_CON_HANDLE,
CSL_RC ) ;
IF CSL_RC = CS_FAIL THEN
DO ;
MSGSTR = 'CTBCONDROP CSL_CON_HANDLE failed' ;
CALL ERROR_OUT ;
END ;
END CLOSE_CONNECTION ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to perform exit client library and deallocate context */
/* structure. */
/* */
/*------------------------------------------------------------------*/
QUIT_CLIENT_LIBRARY: PROC ;
/*------------------------------------------------------------------*/
/* exit the Client Library */
/*------------------------------------------------------------------*/
CALL CTBEXIT( CSL_CTX_HANDLE,
CSL_RC,
CS_UNUSED ) ;
IF CSL_RC = CS_FAIL THEN
DO ;
MSGSTR = 'CTBEXIT failed' ;
CALL ERROR_OUT ;
END ;
/*------------------------------------------------------------------*/
/* de-allocate the context stricture */
/*------------------------------------------------------------------*/
CALL CSBCTXDR( CSL_CTX_HANDLE,
CSL_RC ) ;
IF CSL_RC = CS_FAIL THEN
DO ;
MSGSTR = 'CSBCTXDROP failed' ;
CALL ERROR_OUT ;
END ;
EXEC CICS RETURN ;
END QUIT_CLIENT_LIBRARY ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to display output */
/* */
/*------------------------------------------------------------------*/
DISP_DATA: PROC ;
SDATEO = TMP_DATE ;
STIMEO = TMP_TIME;
PROGNMO = 'SYCTSAR4' ;
SELECT( PAGE_CNT ) ;
WHEN( 1 ) SPAGEO = '0001' ;
WHEN( 2 ) SPAGEO = '0002' ;
WHEN( 3 ) SPAGEO = '0003' ;
WHEN( 4 ) SPAGEO = '0004' ;
WHEN( 5 ) SPAGEO = '0005' ;
WHEN( 6 ) SPAGEO = '0006' ;
WHEN( 7 ) SPAGEO = '0007' ;
WHEN( 8 ) SPAGEO = '0008' ;
WHEN( 9 ) SPAGEO = '0009' ;
OTHERWISE SPAGEO = '9999' ;
END ;
SERVERA = DFHBMPRO;
SERVERO = PF_SERVER;
USERA = DFHBMPRO;
USERO = PF_USER;
NETDRVA = DFHBMPRO;
NETDRVO = PF_NETDRV;
PSWDA = DFHBMDAR;
PSWDO = PF_PWD;
MSG1O = MSG_TEXT_1;
MSG2O = MSG_TEXT_2;
/*------------------------------------------------------------------*/
/* DISPLAY THE DATA */
/*------------------------------------------------------------------*/
EXEC CICS SEND MAP('A4PANEL')
MAPSET('SYCTBA4')
CURSOR
FRSET
ERASE
FREEKB ;
EXEC CICS RECEIVE INTO(QF_ANSWER)
LENGTH(QF_LEN)
MAXLENGTH(QF_MAXLEN)
RESP(CICS_RESPONSE) ;
END DISP_DATA ;
/*------------------------------------------------------------------*/
/* */
/* Label: NO_INPUT --- to handle MAPFAIL/ANYKEY condition */
/* */
/*------------------------------------------------------------------*/
NO_INPUT:
MSG_TEXT_1 = 'Please Enter Input Fields' ;
GO TO GET_INPUT_AGAIN ;
/*------------------------------------------------------------------*/
/* */
/* Label: GETOUT --- to handle CLEAR condition */
/* */
/*------------------------------------------------------------------*/
GETOUT:
EXEC CICS RETURN ;
/*------------------------------------------------------------------*/
/* */
/* Label: ERRORS --- to handle ERROR condition */
/* */
/*------------------------------------------------------------------*/
ERRORS:
EXEC CICS DUMP DUMPCODE('ERRS') ;
END SYCTSAR4;
