Sample program – SYCTSAA4
SYCTSAA4: PROC OPTIONS(MAIN REENTRANT);
/* @(#) syctsaa4.pli 11.3 12/14/95 */
/****** SYCTSAA4 - CLIENT LANGUAGE REQUEST APPL - PL/I - CICS ********/
/* CICS TRANID: SYA4 /* /* PROGRAM: SYCTSAA4
/* PURPOSE: Demonstrates Open Client for CICS CALLs. */
/*
/* FUNCTION: Illustrates how to send a language request with */
/* parameters to: /* - A SQL Server /* */
/* */
/* SQL Server: */
/* */
/* If the request is sent to a SQL Server it */
/* executes the SQL statement: */
/* */
/* SELECT FIRSTNME, EDUCLVL */
/* FROM SYBASE.SAMPLETB */
/* */
/* Note: The Net-Gateway/MCG product includes a script */
/* that creates this procedure in a target SQL */
/* server. */
/* */
/* */
/* PREREQS: Before running SYCTSAA4, 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. */
/* */
/* */
/* Open Client CALLs used in this sample: */
/* */
/* CSBCONVERT convert a datatype from one value to another */
/* CSBCTXALLOC allocate a context */
/* CSBCTXDROP drop a context */
/* CTBBIND bind a column variable */
/* CTBCLOSE close a server connection */
/* CTBCONFIG set or retrieve context properties */
/* 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 */
/* CTBRESULTS set up result data */
/* CTBRESINFO return result set info */
/* 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
CSBCONVE ENTRY OPTIONS(INTER ASSEMBLER),
CSBCTXAL ENTRY OPTIONS(INTER ASSEMBLER),
CSBCTXDR ENTRY OPTIONS(INTER ASSEMBLER),
CTBBIND ENTRY OPTIONS(INTER ASSEMBLER),
CTBCLOSE ENTRY OPTIONS(INTER ASSEMBLER),
CTBCONFI 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),
CTBRESUL ENTRY OPTIONS(INTER ASSEMBLER),
CTBRESIN 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 INTERNAL_FIELDS,
05 PARM_CNT FIXED BIN(31),
05 NETDRIVER FIXED BIN(31) INIT(9999);
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_STRLEN FIXED BIN(31),
05 PF_MSGLIMIT FIXED BIN(31);
DCL
01 DIAG_FIELDS,
05 DF_STATUS FIXED BIN(31) INIT(0),
05 DF_MSGNO FIXED BIN(31) INIT(1),
05 DF_NUM_OF_MSGS FIXED BIN(31) INIT(0);
DCL
01 CONFIG_FIELDS,
05 CF_MAXCONNECT FIXED BIN(31),
05 CF_OUTLEN FIXED BIN(31);
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 FETCH_FIELDS,
05 FF_ROWS_READ FIXED BIN(31),
05 FF_ROW_NUM FIXED BIN(31) INIT(0);
DCL
01 RESINFO_FIELDS,
05 RF_NUMDATA FIXED BIN(31);
DCL
01 OUTPUT_ROW,
05 OR_COL_FIRSTNME_CHAR CHAR(12),
05 SPACE1 CHAR(01) INIT(' '),
05 OR_COL_EDLEVEL PIC'999';
DCL
01 OUTPUT_ROW_STR CHAR(16)
DEFINED OUTPUT_ROW;
DCL
01 OUTPUT_ROW2,
05 OR2_MESG CHAR(37)
INIT('The maximum number of connections is '),
05 OR2_MAXCONNECT PIC'99999',
05 OR2_PERIOD CHAR(01) INIT('.');
DCL
01 OUTPUT_ROW_STR2 CHAR(43)
DEFINED OUTPUT_ROW2;
DCL
01 OUTPUT_ROW4,
05 OR4_MESG CHAR(25)
INIT('The number of columns is '),
05 OR4_NUMDATA PIC'99999',
05 OR4_PERIOD CHAR(01) INIT('.');
DCL
01 OUTPUT_ROW_STR4 CHAR(31)
DEFINED OUTPUT_ROW4;
DCL
01 COLUMN_FIELDS,
05 CF_COL_FIRSTNME CHAR(12) VAR,
05 CF_COL_FIRSTNME_CHAR CHAR(12),
05 CF_COL_EDLEVEL FIXED BIN(15),
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 LANG_FIELDS STATIC,
05 CF_LANG1 CHAR(19)
INIT('Wrong SQL statement'),
05 CF_LANG2 CHAR(45)
INIT('SELECT FIRSTNME, EDUCLVL FROM SYBASE.SAMPLETB');
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 DATAFMT2,
05 DF2_NAME CHAR(132),
05 DF2_NAMELEN FIXED BIN(31),
05 DF2_DATATYPE FIXED BIN(31),
05 DF2_FORMAT FIXED BIN(31),
05 DF2_MAXLENGTH FIXED BIN(31),
05 DF2_SCALE FIXED BIN(31),
05 DF2_PRECISION FIXED BIN(31),
05 DF2_STATUS FIXED BIN(31),
05 DF2_COUNT FIXED BIN(31),
05 DF2_USERTYPE FIXED BIN(31),
05 DF2_LOCALE CHAR(68);
DCL
01 DISP_MSG,
05 TEST_CASE CHAR(09) INIT('SYCTSAA4 '),
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
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(10 ),
MSG_TEXT_1 CHAR(79) INIT(' '),
MSG_TEXT_2 CHAR(79) INIT(' '),
OUTLEN FIXED BIN(31) INIT(0),
PAGE_CNT FIXED BIN(15) INIT(0),
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);
/*------------------------------------------------------------------*/
/* 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_50,
CSL_RC,
CSL_CTX_HANDLE );
IF CSL_RC ^= CS_SUCCEED THEN
DO;
MSGSTR = 'CSCTXALLOC failed';
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE;
END;
/*------------------------------------------------------------------*/
/* initialize the Client-Library */
/*------------------------------------------------------------------*/
CALL CTBINIT( CSL_CTX_HANDLE,
CSL_RC,
CS_VERSION_50 );
IF CSL_RC ^= CS_SUCCEED THEN
DO;
MSGSTR = 'CTBINIT failed';
NO_ERRORS_SW = FALSE ;
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 = 'SYCTSAA4' ;
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 ;
MSGSTR = 'CTBCONALLOC failed' ;
NO_ERRORS_SW = FALSE ;
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 ;
MSGSTR = 'CTBCONPROPS for user-id failed' ;
NO_ERRORS_SW = FALSE ;
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 ;
MSGSTR = 'CTBCONPROPS for password failed' ;
NO_ERRORS_SW = FALSE ;
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 ;
MSGSTR = 'CTBDIAG CS_INIT failed' ;
NO_ERRORS_SW = FALSE ;
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 ;
MSGSTR = 'CTBDIAG CS_MSGLIMIT failed' ;
NO_ERRORS_SW = FALSE ;
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 ;
MSGSTR = 'CTBCONNECT failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* invokes SEND_COMMAND routine */
/*------------------------------------------------------------*/
IF NO_ERRORS_SW
THEN
CALL SEND_COMMAND ;
/*------------------------------------------------------------*/
/* 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_COMMAND: PROC ;
/*------------------------------------------------------------*/
/* find out what the maximum number of connections is */
/*------------------------------------------------------------*/
CALL CTBCONFI( CSL_CTX_HANDLE,
CSL_RC,
CS_GET,
CS_MAX_CONNECT,
CF_MAXCONNECT,
STG(CF_MAXCONNECT),
CS_FALSE,
CF_OUTLEN ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBCONFIG failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* display number of connections */
/*------------------------------------------------------------*/
OR2_MAXCONNECT = CF_MAXCONNECT;
/*------------------------------------------------------------*/
/* allocate a command handle */
/*------------------------------------------------------------*/
CALL CTBCMDAL( CSL_CON_HANDLE,
CSL_RC,
CSL_CMD_HANDLE ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBCMDALLOC failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* prepare the language request */
/*------------------------------------------------------------*/
PF_STRLEN = STG(CF_LANG2 ) ;
CALL CTBCOMMA( CSL_CMD_HANDLE,
CSL_RC,
CS_LANG_CMD,
CF_LANG2,
PF_STRLEN,
CS_UNUSED ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBCOMMAND failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE ;
END ;
/*------------------------------------------------------------*/
/* send the language request */
/*------------------------------------------------------------*/
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_COMMAND ;
/*------------------------------------------------------------------*/
/* */
/* 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 ;
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 ;
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 returned 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 = 'CTBRESUL returned CS_FAIL ret_code' ;
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 returned unknown ret_code' ;
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 ;
/*------------------------------------------------------------*/
/* 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(). */
/*------------------------------------------------------------*/
CALL CTBRESIN( CSL_CMD_HANDLE,
CSL_RC,
CS_NUMDATA,
RF_NUMDATA,
STG(RF_NUMDATA),
CF_COL_LEN ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBRESINFO failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
FF_ROW_NUM = FF_ROW_NUM + 1;
/*------------------------------------------------------------*/
/* display the number of connections */
/*------------------------------------------------------------*/
OR2_MAXCONNECT = CF_MAXCONNECT ;
RSLTNO(FF_ROW_NUM) = OUTPUT_ROW_STR2 ;
FF_ROW_NUM = FF_ROW_NUM + 2;
/*------------------------------------------------------------*/
/* display the number of columns */
/*------------------------------------------------------------*/
OR4_NUMDATA = RF_NUMDATA ;
RSLTNO(FF_ROW_NUM) = OUTPUT_ROW_STR4 ;
IF RF_NUMDATA ^= 2 THEN
DO ;
MSGSTR = 'CTBRESINFO returned wrong # of parms' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
FF_ROW_NUM = FF_ROW_NUM + 2;
/*------------------------------------------------------------*/
/* Setup column headings */
/*------------------------------------------------------------*/
RSLTNO(FF_ROW_NUM) = 'FirstName EducLvl' ;
FF_ROW_NUM = FF_ROW_NUM + 1;
RSLTNO(FF_ROW_NUM) = '=========== =======' ;
DO PARM_CNT = 1 TO RF_NUMDATA ;
CALL BIND_COLUMNS ;
END ;
END RESULT_ROW_PROCESSING ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to bind each data */
/* */
/*------------------------------------------------------------------*/
BIND_COLUMNS: PROC ;
CALL CTBDESCR( CSL_CMD_HANDLE,
CSL_RC,
PARM_CNT,
DATAFMT ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBDESCRIBE failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
/*------------------------------------------------------------*/
/* 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(). */
/*------------------------------------------------------------*/
/*------------------------------------------------------------*/
/* rows per fetch */
/*------------------------------------------------------------*/
DF_COUNT = 1 ;
SELECT( DF_DATATYPE ) ;
/*------------------------------------------------------------*/
/* bind the first column, FIRSTNME defined as VARCHAR(12) */
/*------------------------------------------------------------*/
WHEN( CS_VARCHAR_TYPE )
DO ;
DF_DATATYPE = CS_VARCHAR_TYPE;
DF_FORMAT = CS_FMT_UNUSED;
DF_MAXLENGTH = STG(CF_COL_FIRSTNME) - 2;
DF_COUNT = 1;
CF_COL_NUMBER = 1;
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 ;
MSGSTR = 'CTBBIND CS_VARCHAR_TYPE failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
END ;
/*------------------------------------------------------------*/
/* bind the second column, EDLEVEL defined as SMALLINT */
/*------------------------------------------------------------*/
WHEN( CS_SMALLINT_TYPE )
DO ;
DF_DATATYPE = CS_SMALLINT_TYPE;
DF_FORMAT = CS_FMT_UNUSED;
DF_MAXLENGTH = STG(CF_COL_EDLEVEL);
DF_COUNT = 1;
CF_COL_NUMBER = 2;
CALL CTBBIND( CSL_CMD_HANDLE,
CSL_RC,
CF_COL_NUMBER,
DATAFMT,
CF_COL_EDLEVEL,
CF_COL_LEN,
CS_PARAM_NOTNULL,
CF_COL_INDICATOR,
CS_PARAM_NULL ) ;
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CTBBIND CS_SMALLINT_TYPE failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
END ;
OTHERWISE ;
END ; /* end of SELECT( DF_DATATYPE ) */
END BIND_COLUMNS ;
/*------------------------------------------------------------------*/
/* */
/* 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 ;
CF_COL_FIRSTNME_CHAR = BLANK ;
DF_DATATYPE = CS_VARCHAR_TYPE;
DF_MAXLENGTH = LENGTH( CF_COL_FIRSTNME ) ;
DF2_DATATYPE = CS_CHAR_TYPE;
DF2_MAXLENGTH = STG(CF_COL_FIRSTNME_CHAR);
CALL CSBCONVE( CSL_CTX_HANDLE,
CSL_RC,
DATAFMT,
CF_COL_FIRSTNME,
DATAFMT2,
CF_COL_FIRSTNME_CHAR,
CF_COL_LEN);
IF CSL_RC ^= CS_SUCCEED THEN
DO ;
MSGSTR = 'CSCONVERT CS_CHAR_TYPE failed' ;
NO_ERRORS_SW = FALSE ;
CALL ERROR_OUT;
CALL ALL_DONE;
END ;
FF_ROW_NUM = FF_ROW_NUM + 1 ;
/*------------------------------------------------------------*/
/* save ROW RESULTS for later display */
/*------------------------------------------------------------*/
OR_COL_FIRSTNME_CHAR = CF_COL_FIRSTNME_CHAR;
OR_COL_EDLEVEL = CF_COL_EDLEVEL;
IF FF_ROW_NUM > 10 THEN
DO;
MSG_TEXT_1 = 'Please press return to continue!' ;
MSG_TEXT_2 = BLANK ;
CALL DISP_DATA ;
FF_ROW_NUM = 1;
PAGE_CNT = PAGE_CNT + 1 ;
/*------------------------------------------------------------*/
/* Setup column headings */
/*------------------------------------------------------------*/
RSLTNO(FF_ROW_NUM) = 'FirstName EducLvl' ;
FF_ROW_NUM = FF_ROW_NUM + 1 ;
RSLTNO(FF_ROW_NUM) = '=========== =======' ;
FF_ROW_NUM = FF_ROW_NUM + 1 ;
END ;
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_code' ;
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_code' ;
CALL ERROR_OUT;
END ; /* end of WHEN( CS_ROW_FAIL ) */
WHEN( CS_CANCELLED )
DO ;
NO_MORE_ROWS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSG1O = 'CTBFETCH returned CS_CANCELLED ret_code' ;
CALL ERROR_OUT;
END ; /* end of WHEN( CS_CANCELLED ) */
OTHERWISE
DO ;
NO_MORE_ROWS = TRUE ;
NO_ERRORS_SW = FALSE ;
MSGSTR =
'CTBFETCH returned Unknown ret_code' ;
CALL ERROR_OUT;
END ; /* end of OTHERWISE */
END ; /* end of SELECT( CSL_RC ) */
END FETCH_ROW_PROCESSING ;
/*------------------------------------------------------------------*/
/* */
/* Subroutine to print output messages. */
/* */
/*------------------------------------------------------------------*/
ERROR_OUT: PROC;
SAMP_RC = CSL_RC;
REST_TYPE = RF_TYPE ;
IF DIAG_MSGS_INITIALIZED
THEN
CALL GET_DIAG_MESSAGES ;
/*------------------------------------------------------------------*/
/* display error messages */
/*------------------------------------------------------------------*/
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,
DF_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 DF_NUM_OF_MSGS > 0 THEN
DO ;
DO CNT = 1 TO DF_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,
DF_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 DF_NUM_OF_MSGS > 0 THEN
DO ;
DO CNT = 1 TO DF_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,
DF_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,
DF_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 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 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 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 structure */
/*------------------------------------------------------------------*/
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 = 'SYCTSAA4' ;
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 SYCTSAA4;