Appendix C: Sample Language Application for CICS  Appendix D: Sample RPC Application for IMS TM (Explicit)

Appendix C: Sample Language Application for CICS

Sample program SYCPSAL1

The following program accepts all valid dynamic SQL requests except select commands. delete requests must have a where clause, or they will be rejected. Upon successful completion, this program sends a confirmation message to the client; otherwise it sends an error message.

  SYSAMP1: PROC OPTIONS(MAIN REENTRANT);
  /*        @(#) sycpsal1.pli 1.1 3/17/98     */
  /****** SYCPSAL1 - LANGUAGE REQUEST APPLICATION - PL/I - CICS *******/
  /*                                                                  */
  /*  TRANID:        SYL1                                             */
  /*  PROGRAM:       SYCPSAL1                                         */
  /*  PLAN NAME:     SYL1PLAN                                         */
  /*  FILES:         none                                             */
  /*  TABLES:        adhoc                                            */
  /*                                                                  */
  /*  This program is executed via a client language request          */
  /*  from sample dblib program 'SYL1', or by SYBASE's ISQL if        */
  /*  installed.  The client program must login to a transaction      */
  /*  group with SYL1 as the language handler.                        */
  /*                                                                  */
  /*  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 language requests.        */
  /*                                                                  */
  /*  Server Library calls:                                           */
  /*   TDACCEPT      accept request from client                       */
  /*   TDFREE        free TDPROC structure                            */
  /*   TDINFLOG      return trace settings                            */
  /*   TDINFPGM      return program information                       */
  /*   TDINIT        establish environment                            */
  /*   TDRCVSQL      receive language text                            */
  /*   TDRESULT      describe next communication                      */
  /*   TDSETSPT      set specific tracing                             */
  /*   TDSNDDON      send results-completion to client                */
  /*   TDSNDMSG      send message to client                           */
  /*   TDSQLLEN      get length of incoming text                      */
  /*   TDSTATUS      get status information                           */
  /*                                                                  */
  /*                                                                  */
  /*  The program accepts all valid SQL requests other than           */
  /*  'SELECT'.  A 'DELETE' must have a WHERE clause, or it is        */
  /*  rejected.                                                       */
  /*                                                                  */
  /*  A confirmation message is sent to the client if all is          */
  /*  well, otherwise an error message is sent.                       */
  /*                                                                  */
  /*  CHANGE ACTIVITY:                                                */
  /*     6/90    - Created, MPM                                       */
  /*                                                                  */
  /********************************************************************/
 
  /*------------------------------------------------------------------*/
  /*        DB2 SQLCA                                                 */
  /*------------------------------------------------------------------*/
          EXEC SQL INCLUDE SQLCA;
 
  /*------------------------------------------------------------------*/
  /*        minimum SQLDA                                             */
  /*------------------------------------------------------------------*/
          DCL
              01  SQLDA,
                  05  SQLDAID               CHAR(8)       INIT(' '),
                  05  SQLDABC               FIXED BIN(31) INIT(0),
                  05  SQLN                  FIXED BIN(15) INIT(0),
                  05  SQLD                  FIXED BIN(15) INIT(0);
 
  /********************************************************************/
  /*        SERVER LIBRARY PL/I COPY BOOK                             */
  /********************************************************************/
          %INCLUDE SYGWPLI;
 
  /*------------------------------------------------------------------*/
  /*        SERVER LIB ROUTINES DECLARATIONS                          */
  /*------------------------------------------------------------------*/
          DCL
              TDACCEPT ENTRY OPTIONS(INTER ASSEMBLER),
              TDFREE   ENTRY OPTIONS(INTER ASSEMBLER),
              TDINFLOG ENTRY OPTIONS(INTER ASSEMBLER),
              TDINFPGM ENTRY OPTIONS(INTER ASSEMBLER),
              TDINIT   ENTRY OPTIONS(INTER ASSEMBLER),
              TDRCVSQL ENTRY OPTIONS(INTER ASSEMBLER),
              TDRESULT ENTRY OPTIONS(INTER ASSEMBLER),
              TDSETSPT ENTRY OPTIONS(INTER ASSEMBLER),
              TDSNDDON ENTRY OPTIONS(INTER ASSEMBLER),
              TDSNDMSG ENTRY OPTIONS(INTER ASSEMBLER),
              TDSQLLEN ENTRY OPTIONS(INTER ASSEMBLER),
              TDSTATUS ENTRY OPTIONS(INTER ASSEMBLER);
 
  /*------------------------------------------------------------------*/
  /*        BUILT IN FUNCTIONS DECLARATIONS                           */
  /*------------------------------------------------------------------*/
          DCL
              ADDR      BUILTIN,
              INDEX     BUILTIN,
              LENGTH    BUILTIN,
              NULL      BUILTIN,
              STG       BUILTIN,
              STRING    BUILTIN,
              SUBSTR    BUILTIN,
              TRANSLATE BUILTIN,
              VERIFY    BUILTIN;
 
  /*------------------------------------------------------------------*/
  /*        WORK AREAS                                                */
  /*------------------------------------------------------------------*/
          DCL
              01  GW_LIB_MISC_FIELDS,
                  05  GWL_PROC                    PTR,
                  05  GWL_INIT_HANDLE             PTR,
                  05  GWL_RC                      FIXED BIN(31),
                  05  GWL_SQLLEN                  FIXED BIN(31),
                  05  GWL_STATUS_NR               FIXED BIN(31),
                  05  GWL_STATUS_DONE             FIXED BIN(31),
                  05  GWL_STATUS_COUNT            FIXED BIN(31),
                  05  GWL_STATUS_COMM             FIXED BIN(31),
                  05  GWL_STATUS_RETURN_CODE      FIXED BIN(31),
                  05  GWL_STATUS_SUBCODE          FIXED BIN(31),
                  05  GWL_INFPGM_TDS_VERSION      FIXED BIN(31),
                  05  GWL_INFPGM_LONGVAR          FIXED BIN(31),
                  05  GWL_INFPGM_ROW_LIMIT        FIXED BIN(31),
                  05  GWL_INFPGM_REMOTE_TRACE     FIXED BIN(31),
                  05  GWL_INFPGM_CORRELATOR       FIXED BIN(31),
                  05  GWL_INFPGM_DB2GW_OPTION     FIXED BIN(31),
                  05  GWL_INFPGM_DB2GW_PID        FIXED BIN(31),
                  05  GWL_INFPGM_TYPE_RPC         FIXED BIN(31),
                  05  GWL_INFLOG_GLOBAL           FIXED BIN(31),
                  05  GWL_INFLOG_API              FIXED BIN(31),
                  05  GWL_INFLOG_TDS_HEADER       FIXED BIN(31),
                  05  GWL_INFLOG_TDS_DATA         FIXED BIN(31),
                  05  GWL_INFLOG_TRACE_ID         FIXED BIN(31),
                  05  GWL_INFLOG_FILENAME         CHAR(08),
                  05  GWL_INFLOG_TOTAL_RECS       FIXED BIN(31),
                  05  GWL_SETSPT_TRACE_LEVEL      FIXED BIN(31),
                  05  GWL_SETSPT_RPC_NAME         CHAR(04) INIT('SYL1'),
                  05  GWL_SETSPT_RPC_NAME_L       FIXED BIN(31) INIT(4);
 
          DCL
              01  LANGUAGE_FIELDS,
                  05  LANG_BUFFER_PTR       PTR,
                  05  LANG_MAX_L            FIXED BIN(31),
                  05  LANG_ACTUAL_L         FIXED BIN(31),
                  05  LANG_TEXT_SS          FIXED BIN(15) INIT(1);
 
          DCL
              01  LANG_BUFFER_DB2           CHAR(1024) VAR;
 
          DCL
              01  LANG_BUFFER_LL_TEXT       BASED(LANG_BUFFER_PTR),

                 05  LANG_BUFFER_LL        FIXED BIN(15),
                  05  LANG_BUFFER_TEXT      CHAR(1024);
 
          DCL
              01  PARSESQL_BUFFER           BASED(LANG_BUFFER_PTR),
                  05  PARSESQL_TEXT_LL      FIXED BIN(15),
                  05  PARSESQL_TEXT_CHARS(1024)
                                            CHAR(01);
 
          DCL
              01  SNA_FIELDS,
                  05  SNA_SUBC              FIXED BIN(31),
                  05  SNA_CONNECTION_NAME   CHAR(08) INIT(' ');
 
          DCL
              01  PARSE_FIELDS,
                  05  PARSE_BYTES           FIXED BIN(31),
                  05  PARSE_SS              FIXED BIN(15) INIT(0),
                  05  PARSE_ACTION          CHAR(06);
 
          DCL
              01  XLATE_FIELDS              STATIC,
                  05  XLATE_LOWER           CHAR(07) INIT('dehlrtw'),
                  05  XLATE_UPPER           CHAR(07) INIT('DEHLRTW');
 
          DCL
              01  WORK_FIELDS,
                  05  WRK_DONE_STATUS       FIXED BIN(31),
                  05  WRK_XLATE_WHERE       CHAR(06);
 
          DCL
              01  MESSAGE_FIELDS,
                  05  MSG_TYPE              FIXED BIN(31),
                  05  MSG_SEVERITY          FIXED BIN(31),
                  05  MSG_SEVERITY_OK       FIXED BIN(31) INIT(9),
                  05  MSG_SEVERITY_ERROR    FIXED BIN(31) INIT(11),
                  05  MSG_NR                FIXED BIN(31),
                  05  MSG_NR_OK             FIXED BIN(31) INIT(1),
                  05  MSG_NR_ERROR          FIXED BIN(31) INIT(2),
                  05  MSG_RPC               CHAR(04)      INIT('SYL1'),
                  05  MSG_RPC_L             FIXED BIN(31)
                      INIT(STG(MSG_RPC)),
                  05  MSG_TEXT              CHAR(50),
                  05  MSG_TEXT_L            FIXED BIN(31),
                  05  MSG_SQL_ERROR,
                      10  MSG_SQL_ERROR_T   CHAR(31)
                          INIT('Invalid sql request, sqlcode = '),
                      10  MSG_SQL_ERROR_C   PIC '---9',
                  05  MSG_SELECT            CHAR(24)
                          INIT('SQL select not supported'),
                  05  MSG_NOT_LANG          CHAR(35)
                          INIT('SYL1 not begun via language request'),
                  05  MSG_BAD_LEN           CHAR(31)
                          INIT('Request has too many characters'),
                  05  MSG_NO_WHERE          CHAR(26)
                          INIT('Delete has no where clause'),
                  05  MSG_OK                CHAR(22)
                          INIT('Execute was successful'),
                  05  MSG_NOT_OK,
                      10  FILLER1           CHAR(26)
                          INIT('Execute failed, sqlcode = '),
                      10  MSG_NOT_OK_C      PIC '---9',
                      10  FILLER2           CHAR(18)
                          INIT(', ROLLBACK issued.');
          DCL
              01  CICS_FIELDS,
                  05  CICS_RESPONSE         FIXED BIN(31);
 
          DCL
               01  SWITCHES,
                   05  TRACING_SET_SW       BIT(01) INIT('0'B),
                   05  TRACING_RESET        BIT(01) INIT('0'B),
                   05  TRACING_SET          BIT(01) INIT('1'B),
                   05  ALL_DONE             BIT(01) INIT('0'B),
                   05  ALL_DONE_YES         BIT(01) INIT('1'B),
                   05  SEND_DONE            BIT(01) INIT('1'B),
                   05  SEND_DONE_ERROR      BIT(01) INIT('0'B),
                   05  SEND_DONE_OK         BIT(01) INIT('1'B);
 
  /*------------------------------------------------------------------*/
  /*        DECLARE STATEMENT AND CURSOR                              */
  /*------------------------------------------------------------------*/
            EXEC SQL DECLARE S1 STATEMENT;
            EXEC SQL DECLARE C1 CURSOR FOR S1;
 
 
 
  /*------------------------------------------------------------------*/
  INITIALIZE_PROGRAM:
 
  /*------------------------------------------------------------------*/
 
  /*      ------------------------------------------------------------*/
  /*      reset db2 error handlers                                    */
  /*      ------------------------------------------------------------*/
          EXEC SQL WHENEVER SQLWARNING CONTINUE;
          EXEC SQL WHENEVER SQLERROR   CONTINUE;
          EXEC SQL WHENEVER NOT FOUND  CONTINUE;
 
  /*      ------------------------------------------------------------*/
  /*      establish gateway environment                               */
  /*      ------------------------------------------------------------*/
          CALL TDINIT (DFHEIBLK, GWL_RC, GWL_INIT_HANDLE);
 
  /*      ------------------------------------------------------------*/
  /*      turn on local tracing if not on globally or locally         */
  /*      ------------------------------------------------------------*/
          CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
                         GWL_INFLOG_GLOBAL,
                         GWL_INFLOG_API,
                         GWL_INFLOG_TDS_HEADER,
                         GWL_INFLOG_TDS_DATA,
                         GWL_INFLOG_TRACE_ID,
                         GWL_INFLOG_FILENAME,
                         GWL_INFLOG_TOTAL_RECS);
 
          IF GWL_INFLOG_GLOBAL ^= TDS_TRACE_ALL_RPCS &
             GWL_INFLOG_GLOBAL ^= TDS_TRACE_SPECIFIC_RPCS THEN
          DO;
              TRACING_SET_SW = TRACING_SET;
              CALL LOCAL_TRACING;
          END;
 
  /*      ------------------------------------------------------------*/
  /*      accept client request                                       */
  /*      ------------------------------------------------------------*/
          CALL TDACCEPT (GWL_PROC, GWL_RC, GWL_INIT_HANDLE,
                         SNA_CONNECTION_NAME,
                         SNA_SUBC);
 
  /*      ------------------------------------------------------------*/
  /*      ensure kicked off via language request                      */
  /*      (this could be handled more reasonably by TDRESULT)         */
  /*      ------------------------------------------------------------*/
          CALL TDINFPGM (GWL_PROC, GWL_RC,
                         GWL_INFPGM_TDS_VERSION,
                         GWL_INFPGM_LONGVAR,
                         GWL_INFPGM_ROW_LIMIT,
                         GWL_INFPGM_REMOTE_TRACE,
                         GWL_INFPGM_CORRELATOR,
                         GWL_INFPGM_DB2GW_OPTION,
                         GWL_INFPGM_DB2GW_PID,
                         GWL_INFPGM_TYPE_RPC);
 
          IF GWL_INFPGM_TYPE_RPC ^= TDS_START_SQL THEN
          DO;
              MSG_TEXT   = MSG_NOT_LANG;
              MSG_TEXT_L = STG(MSG_NOT_LANG);
              CALL SEND_ERROR_MESSAGE;
              GO TO END_PROGRAM;
          END;
 
  /*------------------------------------------------------------------*/
  READ_IN_SQL_TEXT:
  /*------------------------------------------------------------------*/
 
  /*      ------------------------------------------------------------*/
  /*      prepare for receive                                         */
  /*      ------------------------------------------------------------*/
          CALL TDRESULT (GWL_PROC, GWL_RC);
 
  /*      ------------------------------------------------------------*/
  /*      load ptr to redefined sql text                              */
  /*      ------------------------------------------------------------*/
          LANG_BUFFER_PTR = ADDR(LANG_BUFFER_DB2);
 
  /*      ------------------------------------------------------------*/
  /*      get len of language text, ensure not too big for us         */
  /*      (this could be handled without TDSQLLEN by checking         */
  /*      LANG_ACTUAL_LEN doesn't exceed LANG_MAX_L in TDRCVSQL call) */
  /*      ------------------------------------------------------------*/
          CALL TDSQLLEN (GWL_PROC, GWL_SQLLEN);
 
          LANG_MAX_L = STG(LANG_BUFFER_TEXT);
 
          IF GWL_SQLLEN > LANG_MAX_L THEN
          DO;
              MSG_TEXT   = MSG_BAD_LEN;
              MSG_TEXT_L = STG(MSG_BAD_LEN);
              CALL SEND_ERROR_MESSAGE;
              GO TO END_PROGRAM;
          END;
 
  /*      ------------------------------------------------------------*/
  /*      get language text                                           */
  /*      ------------------------------------------------------------*/
          CALL TDRCVSQL (GWL_PROC, GWL_RC,
                         LANG_BUFFER_TEXT,
                         LANG_MAX_L,
                         LANG_ACTUAL_L);
 
          LANG_BUFFER_LL = LANG_ACTUAL_L;
 
  /*------------------------------------------------------------------*/
  EDIT_TEXT:
  /*------------------------------------------------------------------*/
 
  /*      ------------------------------------------------------------*/
  /*      ensure line feeds, low-values, etc. translated to blanks    */
  /*      ------------------------------------------------------------*/
          DO WHILE (LANG_TEXT_SS <= PARSESQL_TEXT_LL);
              IF  PARSESQL_TEXT_CHARS(LANG_TEXT_SS) < ' ' THEN
              DO;
                  PARSESQL_TEXT_CHARS(LANG_TEXT_SS) = ' ';
              END;
 
              ELSE
              DO;
                  IF PARSE_SS = 0 &
                     PARSESQL_TEXT_CHARS(LANG_TEXT_SS) > ' ' THEN
                  DO;
                      PARSE_SS    = LANG_TEXT_SS;
                      PARSE_BYTES = PARSESQL_TEXT_LL - LANG_TEXT_SS;
                  END;
              END;
 
              LANG_TEXT_SS = LANG_TEXT_SS +1;
          END;
 
  /*      ------------------------------------------------------------*/
  /*      let DB2 edit and tell us if SELECT                          */
  /*      ------------------------------------------------------------*/
          EXEC SQL PREPARE S1 INTO SQLDA FROM :LANG_BUFFER_DB2;
 
          IF SQLD ^= 0 THEN
          DO;
              MSG_TEXT   = MSG_SELECT;
              MSG_TEXT_L = STG(MSG_SELECT);
              CALL SEND_ERROR_MESSAGE;
              GO TO END_PROGRAM;
          END;
 
          IF SQLCODE < 0 THEN
          DO;
              MSG_SQL_ERROR_C = SQLCODE;
              MSG_TEXT        = STRING(MSG_SQL_ERROR);
              MSG_TEXT_L      = STG(MSG_SQL_ERROR);
              CALL SEND_ERROR_MESSAGE;
              GO TO END_PROGRAM;
          END;
 
 
 
  /*      ------------------------------------------------------------*/
  /*      parse and handle special case of DELETE without WHERE clause*/
  /*      ------------------------------------------------------------*/
          PARSE_ACTION = TRANSLATE(SUBSTR(LANG_BUFFER_TEXT,
                                          PARSE_SS,
                                          STG(PARSE_ACTION)),
                                   XLATE_UPPER,
                                   XLATE_LOWER);
 
          IF PARSE_ACTION ^= 'DELETE' THEN
          DO;
              GO TO EXECUTE_SQL;
          END;
 
          ELSE DO;
  /*          --------------------------------------------------------*/
  /*          skip past delete to from                                */
  /*          --------------------------------------------------------*/
              CALL SKIP_TO_BLANK;
              CALL SKIP_BLANKS;
 
  /*          --------------------------------------------------------*/
  /*          skip past from to tableid                               */
  /*          --------------------------------------------------------*/
              CALL SKIP_TO_BLANK;
              CALL SKIP_BLANKS;
 
  /*          --------------------------------------------------------*/
  /*          skip past tableid to correlator or where                */
  /*          --------------------------------------------------------*/
              CALL SKIP_TO_BLANK;
              CALL SKIP_BLANKS;
 
              IF PARSE_BYTES > STG(WRK_XLATE_WHERE) THEN
              DO;
                  WRK_XLATE_WHERE =
                      TRANSLATE(SUBSTR(LANG_BUFFER_TEXT,
                                       PARSE_SS,
                                       STG(WRK_XLATE_WHERE)),
                                XLATE_UPPER,
                                XLATE_LOWER);
 
                  IF WRK_XLATE_WHERE = 'WHERE ' THEN
                  DO;
                      GO TO EXECUTE_SQL;
                  END;
 
  /*              ----------------------------------------------------*/
  /*              skip correlator                                     */
  /*              ----------------------------------------------------*/
                  CALL SKIP_TO_BLANK;
 
                  IF PARSE_BYTES > 0 THEN
                  DO;
                      CALL SKIP_TO_BLANK;
 
                      IF PARSE_BYTES > 0 THEN
                      DO;
                          GO TO EXECUTE_SQL;
                      END;
                  END;
              END;
          END;
 
          MSG_TEXT   = MSG_NO_WHERE;
          MSG_TEXT_L = STG(MSG_NO_WHERE);
          CALL SEND_ERROR_MESSAGE;
 
          GO TO END_PROGRAM;
 
  /*------------------------------------------------------------------*/
  SKIP_TO_BLANK: PROC;
  /*------------------------------------------------------------------*/
          DCL J                             FIXED BIN(15) INIT(0);
 
          IF PARSE_SS < LANG_BUFFER_LL THEN
          DO;
              J = INDEX(SUBSTR(LANG_BUFFER_TEXT,
                               PARSE_SS,
                               PARSE_BYTES),
                        ' ');
          END;
 
          IF J = 0 THEN
          DO;
              PARSE_SS    = LANG_BUFFER_LL +1;
              PARSE_BYTES = -1;
          END;
 
          ELSE DO;
              PARSE_SS    = PARSE_SS    +J -1;
              PARSE_BYTES = PARSE_BYTES -J +1;
          END;
 
          RETURN;
 
  END SKIP_TO_BLANK;
 
  /*------------------------------------------------------------------*/
  SKIP_BLANKS: PROC;
  /*------------------------------------------------------------------*/
          DCL J                             FIXED BIN(15) INIT(0);
 
          IF PARSE_SS < LANG_BUFFER_LL THEN
          DO;
              J = VERIFY(SUBSTR(LANG_BUFFER_TEXT,
                                PARSE_SS,
                                PARSE_BYTES),
                         ' ');
          END;
 
          IF J = 0 THEN
          DO;
              PARSE_SS    = LANG_BUFFER_LL +1;
              PARSE_BYTES = -1;
          END;
 
          ELSE DO;
              PARSE_SS    = PARSE_SS    +J -1;
              PARSE_BYTES = PARSE_BYTES -J +1;
          END;
 
          RETURN;
 
  END SKIP_BLANKS;
 
  /*------------------------------------------------------------------*/
  EXECUTE_SQL:
  /*------------------------------------------------------------------*/
          EXEC SQL EXECUTE S1;
 
          IF SQLCODE < 0 THEN
          DO;
              CALL CICS_ROLLBACK;
              MSG_NOT_OK_C = SQLCODE;
              MSG_TEXT     = STRING(MSG_NOT_OK);
              MSG_TEXT_L   = STG(MSG_NOT_OK);
              CALL SEND_ERROR_MESSAGE;
              GO TO END_PROGRAM;
          END;
 
          MSG_TEXT   = MSG_OK;
          MSG_TEXT_L = STG(MSG_OK);
          CALL SEND_CONFIRM_MESSAGE;
          GO TO END_PROGRAM;
 
  /*------------------------------------------------------------------*/
  SEND_CONFIRM_MESSAGE: PROC;
  /*------------------------------------------------------------------*/
          MSG_SEVERITY = MSG_SEVERITY_OK;
          MSG_NR       = MSG_NR_OK;
          MSG_TYPE     = TDS_INFO_MSG;
          CALL SEND_MESSAGE;
 
          RETURN;
 
  END SEND_CONFIRM_MESSAGE;
 
  /*------------------------------------------------------------------*/
  SEND_ERROR_MESSAGE: PROC;
  /*------------------------------------------------------------------*/
          SEND_DONE    = SEND_DONE_ERROR;
          MSG_SEVERITY = MSG_SEVERITY_ERROR;
          MSG_NR       = MSG_NR_ERROR;
          MSG_TYPE     = TDS_ERROR_MSG;
          CALL SEND_MESSAGE;
 
          RETURN;
 
  END SEND_ERROR_MESSAGE;
 
  /*------------------------------------------------------------------*/
  SEND_MESSAGE: PROC;
  /*------------------------------------------------------------------*/
 
  /*      ------------------------------------------------------------*/
  /*      ensure we're in right state to send a message               */
  /*      ------------------------------------------------------------*/
          CALL TDSTATUS (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 THEN
          DO;
              IF GWL_STATUS_COMM = TDS_RECEIVE THEN
 
              CALL TDSNDMSG (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;
 
          RETURN;
 
  END SEND_MESSAGE;
 
  /*------------------------------------------------------------------*/
  LOCAL_TRACING: PROC;
  /*------------------------------------------------------------------*/
          CALL TDSETSPT (GWL_INIT_HANDLE, GWL_RC,
                         TRACING_SET_SW,
                         GWL_SETSPT_TRACE_LEVEL,
                         GWL_SETSPT_RPC_NAME,
                         GWL_SETSPT_RPC_NAME_L);
 
          RETURN;
 
  END LOCAL_TRACING;
 
  /*------------------------------------------------------------------*/
  CICS_ROLLBACK: PROC;
  /*------------------------------------------------------------------*/
          EXEC CICS SYNCPOINT
                    ROLLBACK
                    RESP(CICS_RESPONSE);
 
          RETURN;
 
  END CICS_ROLLBACK;
 
  /*------------------------------------------------------------------*/
  END_PROGRAM:
  /*------------------------------------------------------------------*/
          IF (TRACING_SET_SW) THEN
          DO;
              TRACING_SET_SW = TRACING_RESET;
              CALL LOCAL_TRACING;
          END;
 
          IF SEND_DONE = SEND_DONE_OK THEN
              WRK_DONE_STATUS = TDS_DONE_COUNT;
 
          ELSE
          DO;
              WRK_DONE_STATUS = TDS_DONE_ERROR;
              SQLERRD(3)      = 0;
          END;
 
          CALL TDSNDDON (GWL_PROC, GWL_RC,
                         WRK_DONE_STATUS,
                         SQLERRD(3),
                         TDS_ZERO,
                         TDS_ENDRPC);
 
          CALL TDFREE (GWL_PROC, GWL_RC);
          EXEC CICS RETURN;
 
  END SYSAMP1;




Copyright © 2005. Sybase Inc. All rights reserved. Appendix D: Sample RPC Application for IMS TM (Explicit)

View this book as PDF