Sample program EYULAPI4

Program EYULAPI4 is written in COBOL for the CICS® environment.

EYUxAPI4
This program does the following: Commands Used: CONNECT, CREATE, GET, PERFORM OBJECT, FEEDBACK, FETCH, TERMINATE, TRANSLATE

       IDENTIFICATION DIVISION.
       PROGRAM-ID. EYULAPI4
      *****************************************************************
      *                                                               *
      * MODULE NAME = EYULAPI4                                        *
      *                                                               *
      * DESCRIPTIVE NAME = CPSM SAMPLE API PROGRAM 4                  *
      *                    (SAMPLE COBOL VERSION)                     *
      *                                                               *
      *  COPYRIGHT = Licensed Materials - Property of IBM             *
      *              5695-081                                         *
      *              (C) Copyright IBM Corp. 1995, 1997               *
      *              All Rights Reserved                              *
      *                                                               *
      *              US Government Users Restricted Rights - Use,     *
      *              duplication or disclosure restricted by GSA ADP  *
      *              Schedule Contract with IBM Corp.                 *
      *                                                               *
      * STATUS = %CP00                                                *
      *                                                               *
      * FUNCTION =                                                    *
      *                                                               *
      * TO PROVIDE AN EXAMPLE OF THE USE OF THE FOLLOWING EXEC CPSM   *
      * COMMANDS: CONNECT, CREATE, FEEDBACK, FETCH, GET,              *
      *           PERFORM OBJECT, TERMINATE.                          *
      *                                                               *
      * WHEN INVOKED, THE PROGRAM DEPENDS UPON THE VALUES HELD IN THE *
      * W-CONTEXT AND W-SCOPE DECLARATIONS WHEN ESTABLISHING A        *
      * CONNECTION WITH CICSPLEX SM. THEY MUST TAKE THE FOLLOWING     *
      * VALUES:                                                       *
      *                                                               *
      * W-CONTEXT  = THE NAME OF A CMAS OR CICSPLEX. REFER TO THE     *
      *              DESCRIPTION OF THE EXEC CPSM CONNECT COMMAND     *
      *              FOR FURTHER INFORMATION REGARDING THE CONTEXT    *
      *              OPTION.                                          *
      *                                                               *
      * W-SCOPE    = THE NAME OF A CICSPLEX, CICS SYSTEM, OR CICS     *
      *              SYSTEM GROUP WITHIN THE CICSPLEX. REFER TO THE   *
      *              DESCRIPTION OF THE EXEC CPSM CONNECT COMMAND     *
      *              FOR FURTHER INFORMATION REGARDING THE SCOPE      *
      *              OPTION.                                          *
      *                                                               *
      * THIS SAMPLE REQUIRES NO PARAMETERS AT INVOCATION TIME.        *
      *                                                               *
      * WHEN CREATING THE BAS DEFINITION THE PROGRAM DEPENDS UPON THE *
      * VALUES HELD IN THE W-DEFNAME AND W-DEFPREFIX DECLARATIONS.    *
      * THEY MUST TAKE THE FOLLOWING VALUES:                          *
      *                                                               *
      * W-DEFNAME  = THE NAME OF THE CREATED BAS DEFINITION. A        *
      *              1 TO 8 CHARACTER VALUE.                          *
      *                                                               *
      * W-DEFPFIX  = THE MODEL PREFIX OF THE CREATED BAS DEFINITION.  *
      *              A 1 TO 16 CHARACTER VALUE.                       *
      *                                                               *
      *                                                               *
      * WHEN INSTALLING THE BAS DEFINITION THE PROGRAM USES THE       *
      * VALUE HELD IN THE W-TSCOPE DECLARATION AS THE TARGET FOR      *
      * THE INSTALL OPERATION. IT MUST TAKE THE FOLLOWING VALUE :     *
      *                                                               *
      * W-TSCOPE   = THE NAME OF A CICS SYSTEM, OR CICS               *
      *              SYSTEM GROUP WITHIN THE CICSPLEX. REFER TO THE   *
      *              DESCRIPTION OF THE TARGET PARAMETER OF AN        *
      *              INSTALL ACTION IN THE RESOURCE TABLE REFERENCE   *
      *              FOR FURTHER INFORMATION REGARDING THE TARGET     *
      *              SCOPE VALUE.                                     *
      *                                                               *
      *                                                               *
      * THE SAMPLE ESTABLISHES AN API CONNECTION AND ISSUES A CREATE  *
      * COMMAND TO CREATE A BAS DEFINITION. A GET COMMAND IS ISSUED   *
      * TO OBTAIN A RESULT SET CONTAINING THE CREATED BAS DEFINITION. *
      *                                                               *
      * USING THE PERFORM OBJECT ACTION(INSTALL) COMMAND EACH RECORD  *
      * IN THE RESULT SET IS INSTALLED INTO THE TARGET SCOPE          *
      * IDENTIFIED BY THE W-SCOPE DECLARATION.                        *
      *                                                               *
      * FINALLY, THE API CONNECTION IS TERMINATED.                    *
      *                                                               *
      * ANY BAS ERRORS ARE REPORTED USING THE BINCONRS, BINCONSC, AND *
      * BINSTERR RESOURCE TABLES.                                     *
      *                                                               *
      * NOTES :                                                       *
      *   DEPENDENCIES = S/390, CICS                                  *
      *   RESTRICTIONS = NONE                                         *
      *   REGISTER CONVENTIONS =                                      *
      *   MODULE TYPE  = EXECUTABLE                                   *
      *   PROCESSOR    = COBOL                                        *
      *   ATTRIBUTES   = READ ONLY, SERIALLY REUSABLE                 *
      *                                                               *
      * ------------------------------------------------------------- *
      * ENTRY POINT = EYULAPI4                                        *
      *                                                               *
      * PURPOSE = ALL FUNCTIONS.                                      *
      *                                                               *
      * LINKAGE = FROM CICS EITHER WITH EXEC CICS LINK OR AS A CICS   *
      *           TRANSACTION.                                        *
      *                                                               *
      * INPUT   = NONE.                                               *
      *                                                               *
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
      *-------------------------------------------------------------*
      *    CHANGE W-CONTEXT AND W-SCOPE TO MATCH YOUR INSTALLATION  *
      *    CHANGE W-DEFNAME AND W-DEFPFIX FOR THE CREATE COMMAND.   *
      *    CHANGE W-TSCOPE FOR THE PERFORM OBJECT COMMAND.          *
      *-------------------------------------------------------------*
       01 W-CONTEXT         PIC X(8) VALUE 'RTGA    '.
       01 W-SCOPE           PIC X(8) VALUE 'RTGA    '.
       01 W-DEFNAME         PIC X(8) VALUE 'EYULAPI4'.
       01 W-DEFPFIX         PIC X(16) VALUE 'EYUL*           '.
       01 W-TSCOPE          PIC X(8) VALUE 'RTGF    '.
      *-------------------------------------------------------------*
       01 W-RESPONSE        PIC S9(8) USAGE BINARY.
       01 W-REASON          PIC S9(8) USAGE BINARY.
       01 W-BUFFER          PIC X(32767).
       01 W-BUFFERLEN       PIC S9(8) COMP.
       01 W-FBBUFF          PIC X(248).
       01 W-FBTTKN          PIC S9(8) COMP.
       01 W-THREAD          PIC S9(8) USAGE BINARY.
       01 W-RESULT          PIC S9(8) USAGE BINARY.
       01 W-RECCNT          PIC S9(8) USAGE BINARY.
       01 W-CRITERIA        PIC X(80) VALUE SPACES.
       01 W-CRITERIALEN     PIC S9(8) USAGE BINARY.
       01 W-PARM            PIC X(80) VALUE SPACES.
       01 W-PARMLEN         PIC S9(8) USAGE BINARY.
       01 W-MSG-TEXT.
         02 W-TEXT          PIC X(80) VALUE SPACES.
         02 W-LINECTL       PIC X(1) VALUE X'13'.
       01 ARRAYS.
         02 CH8ARR          OCCURS 20 TIMES PIC X(8).
         02 FULLARR         OCCURS 60 TIMES PIC S9(8) COMP.
       01 III               PIC S9(8) VALUE ZERO.
       01 CODEV             PIC S9(8) COMP.
       01 CHARV             PIC X(12).
       01 LASTCMD           PIC X(20).
       01 LASTTHR           PIC S9(8) COMP.
       01 LASTRES           PIC S9(8) COMP VALUE 0.
       01 BINZERO           PIC X(1)  VALUE X'00'.
       01 BLNKPAD           PIC X(40)
           VALUE '                                        '.
       01 FBCHAR2           PIC X(2).
       01 FBHALF4           REDEFINES FBCHAR2.
         02 FBHALF          PIC S9(4) COMP.
       01 PICZZZ9A          PIC ZZZ9.
       01 PICZZZ9B          PIC ZZZ9.
       01 PICZZZ9           PIC ZZZ9.
       01 PYCZZZ9           PIC ZZZ9.
       01 PIKZZZ9           PIC ZZZ9.
       01 PYKZZZ9           PIC ZZZ9.
       01 PICZZZZZZZ9       PIC ZZZZZZZ9.
       01 CHR8              PIC X(8).
       01 CHR12             PIC X(12).
       01 CHAR6             PIC X(6).
       01 CHAR12            PIC X(12).
      * Include the resource table copybooks...
       COPY TSMDEF.
       COPY FEEDBACK.
       COPY BINCONRS.
       COPY BINCONSC.
       COPY BINSTERR.
 
      ****************************
      * Start of LINKAGE section *
      ****************************
       LINKAGE SECTION.
 
       PROCEDURE DIVISION.
       EYULAPI4-START SECTION.
       EYULAPI4-00.
 
      *-------------------------------------------------------------*
      *    OBTAIN A CPSM API CONNECTION.                            *
      *                                                             *
      *    THE API WILL RETURN A TOKEN IDENTIFYING THE THREAD IN    *
      *    VARIABLE W-THREAD.                                       *
      *-------------------------------------------------------------*
           MOVE 'Establishing Connection...' TO W-TEXT.
      *    DISPLAY W-TEXT.
           EXEC CICS SEND FROM(W-TEXT) LENGTH(81) ERASE END-EXEC.
           EXEC CPSM CONNECT
                     CONTEXT(W-CONTEXT)
                     SCOPE(W-SCOPE)
                     VERSION('0140')
                     THREAD(W-THREAD)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
           IF W-RESPONSE NOT = EYUVALUE(OK) GO TO NO-CONNECT.
 
      *-------------------------------------------------------------*
      *    CREATE A TS MODEL DEFINITION (TSMDEF)                    *
      *                                                             *
      *    A TSMDEF is created with a version of 1.                 *
      *-------------------------------------------------------------*
           INITIALIZE TSMDEF.
           MOVE X'01' TO DEFVER OF TSMDEF.
           MOVE W-DEFNAME TO NAME-R OF TSMDEF.
           MOVE W-DEFPFIX TO PREFIX OF TSMDEF.
           MOVE DFHVALUE(AUXILIARY) TO LOCATION OF TSMDEF.
           MOVE EYUVALUE(NO) TO RECOVERY OF TSMDEF.
           MOVE EYUVALUE(NO) TO SECURITY-R OF TSMDEF.
           MOVE 'Sample TSMDEF definition' TO DESCRIPTION OF TSMDEF.
      * Copy the definition into our buffer...
           MOVE TSMDEF TO W-BUFFER.
           MOVE TSMDEF-TBL-LEN TO W-BUFFERLEN.
           MOVE 'Creating TSMDEF...' TO W-TEXT.
      *    DISPLAY W-TEXT.
           EXEC CICS SEND FROM(W-TEXT) LENGTH(81) WAIT END-EXEC.
           EXEC CPSM CREATE
                     OBJECT('TSMDEF')
                     FROM(W-BUFFER)
                     LENGTH(W-BUFFERLEN)
                     THREAD(W-THREAD)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
           MOVE 'CREATE' TO LASTCMD.
           MOVE W-THREAD TO LASTTHR.
           MOVE 0 TO LASTRES.
           IF W-RESPONSE NOT = EYUVALUE(OK) GO TO UNEXPECTED.
 
      *-------------------------------------------------------------*
      *    GET THE TSMDEF RESOURCE TABLE.                           *
      *                                                             *
      *    CREATE A RESULT SET CONTAINING ENTRIES FOR ALL TSMDEFS   *
      *    WITH NAMES EQUAL TO THE VALUE OF W-DEFNAME. .            *
      *    THE NUMBER OF ENTRIES MEETING THE CRITERIA IS RETURNED   *
      *    IN VARIABLE W-RECCNT.                                    *
      *-------------------------------------------------------------*
           MOVE 'Get the created TSMDEF Resource Table...' TO W-TEXT.
      *    DISPLAY W-TEXT.
           EXEC CICS SEND FROM(W-TEXT) LENGTH(81) WAIT END-EXEC.
           STRING 'NAME=' DELIMITED BY SIZE
                  W-DEFNAME DELIMITED BY SIZE
                  '.' DELIMITED BY SIZE
                  INTO W-CRITERIA.
           MOVE LENGTH OF W-CRITERIA TO W-CRITERIALEN.
           MOVE BINZERO TO W-RESULT.
           EXEC CPSM GET OBJECT('TSMDEF')
                         CRITERIA(W-CRITERIA)
                         LENGTH(W-CRITERIALEN)
                         COUNT(W-RECCNT)
                         RESULT(W-RESULT)
                         THREAD(W-THREAD)
                         RESPONSE(W-RESPONSE)
                         REASON(W-REASON)
           END-EXEC.
           IF W-RESPONSE NOT = EYUVALUE(OK) GO TO NO-GET.
      *-------------------------------------------------------------*
      *    INSTALL EACH RECORD INTO THE SCOPE IDENTIFIED BY THE     *
      *    VALUE OF W-TSCOPE.                                       *
      *-------------------------------------------------------------*
           MOVE W-RECCNT TO PICZZZZZZZ9.
           STRING 'Installing ' DELIMITED BY SIZE
                  PICZZZZZZZ9 DELIMITED BY SIZE
                  ' TSMDEF Entries...' DELIMITED BY SIZE
                  INTO W-TEXT.
      *    DISPLAY W-TEXT
           EXEC CICS SEND FROM(W-TEXT) LENGTH(81) WAIT END-EXEC.
           STRING '(USAGE(LOCAL) TARGET(' DELIMITED BY SIZE
                  W-TSCOPE DELIMITED BY SIZE
                  ')).' DELIMITED BY SIZE
                  INTO W-PARM.
           MOVE LENGTH OF W-PARM TO W-PARMLEN.
 
           EXEC CPSM PERFORM OBJECT('TSMDEF')
                     ACTION('INSTALL')
                     PARM(W-PARM)
                     PARMLEN(W-PARMLEN)
                     RESULT(W-RESULT)
                     THREAD(W-THREAD)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
           MOVE 'PERFORM OBJECT' TO LASTCMD.
           MOVE W-THREAD TO LASTTHR.
           MOVE W-RESULT TO LASTRES.
           IF W-RESPONSE NOT = EYUVALUE(OK) GO TO UNEXPECTED.
 
           MOVE 'Completed. Remove TSMDEF to re-run.' TO W-TEXT.
           GO TO SCRNLOG2.
 
      **************************************************
      * Branch here if an unexpected CPSM error occurs *
      **************************************************
       UNEXPECTED.
           MOVE W-RESPONSE TO PICZZZ9.
           STRING '*** RESPONSE=' DELIMITED BY SIZE PICZZZ9
           DELIMITED BY SIZE BLNKPAD DELIMITED BY SIZE INTO W-TEXT.
           PERFORM SCRNLOG2.
           MOVE W-REASON TO PICZZZ9.
           STRING '*** REASON=' DELIMITED BY SIZE PICZZZ9
           DELIMITED BY SIZE BLNKPAD DELIMITED BY SIZE INTO W-TEXT.
           PERFORM SCRNLOG2.
           MOVE '*** Unexpected error condition arose' TO W-TEXT.
           PERFORM SCRNLOG2.
      * Obtain FEEDBACK information
           IF LASTCMD = 'DISCONNECT' GO TO NOFEED.
           IF LASTCMD = 'FEEDBACK' GO TO NOFEED.
           IF LASTCMD = 'TERMINATE' GO TO NOFEED.
           STRING
           '*** Getting FEEDBACK data for ' DELIMITED BY SIZE
           LASTCMD DELIMITED BY SIZE
           INTO W-TEXT.
           PERFORM SCRNLOG2.
           STRING
           BLNKPAD DELIMITED BY SIZE
           BLNKPAD DELIMITED BY SIZE
           INTO W-TEXT.
      * Get the FEEDBACK data
       GETFEED.
      * Clear error result set count
           MOVE 0 TO FULLARR(1).
           PERFORM GETFB THROUGH EGETFB
      * Display FEEDBACK information
      * Display information
           IF W-RESPONSE = EYUVALUE(OK)
             PERFORM DISPFEED
             IF FULLARR(1) NOT = 0 PERFORM GETFERT THROUGH EGETFER END-I
      -F
             IF LASTRES NOT = 0 GO TO GETFEED END-IF
             MOVE '*** End of FEEDBACK data' TO W-TEXT
             PERFORM SCRNLOG2
             GO TO NOFEED
           END-IF.
           MOVE W-RESPONSE TO PICZZZ9.
           MOVE W-REASON TO PYCZZZ9.
           STRING '*** FEEDBACK not available (' DELIMITED BY SIZE
           PICZZZ9 DELIMITED BY SIZE ',' DELIMITED BY SIZE
           PYCZZZ9 DELIMITED BY SIZE ')' DELIMITED BY SIZE
           BLNKPAD DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
       NOFEED.
           EXEC CICS DELAY FOR SECONDS(10) END-EXEC.
      * Exit from test case
           EXEC CICS RETURN END-EXEC.
           GOBACK.
           EXIT.
 
      *********************************************
      * This subroutine obtains the FEEDBACK data *
      *********************************************
       GETFB.
      * Use exact buffer size
           MOVE FEEDBACK-TBL-LEN TO W-BUFFERLEN.
           IF LASTRES = 0 GO TO NORESULT.
       RESULT.
           EXEC CPSM FEEDBACK
                     INTO(W-FBBUFF) LENGTH(W-BUFFERLEN)
                     RESULT(LASTRES)
                     THREAD(LASTTHR)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
 
      * If command didn't execute, get FEEDBACK no result set
      * Command didn't execute?
           IF W-RESPONSE = EYUVALUE(NODATA)
             MOVE 0 TO LASTRES
             GO TO NORESULT
           END-IF.
           GO TO ENDFBACK.
       NORESULT.
      * Use exact buffer size
           MOVE FEEDBACK-TBL-LEN TO W-BUFFERLEN.
           EXEC CPSM FEEDBACK
                     INTO(W-FBBUFF) LENGTH(W-BUFFERLEN)
                     THREAD(LASTTHR)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
 
       ENDFBACK.
       EGETFB.
           EXIT.
 
      ********************************************************
      * Branch here if FEEDBACK Error Result Token available *
      ********************************************************
       GETFERT.
           MOVE ERR-OBJECT OF FEEDBACK TO CH8ARR(1).
           STRING
           '*** Getting ' DELIMITED BY SIZE
           CH8ARR(1) DELIMITED BY SIZE
           ' error result set data for FEEDBACK' DELIMITED BY SIZE
           INTO W-TEXT.
           PERFORM SCRNLOG2.
       FERTRES.
      * Use largest buffer size
           MOVE FEEDBACK-TBL-LEN TO W-BUFFERLEN.
           EXEC CPSM FETCH
                     INTO(W-BUFFER) LENGTH(W-BUFFERLEN)
                     RESULT(ERR-RESULT OF FEEDBACK)
                     THREAD(LASTTHR)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
 
      * Display FEEDBACK Error Result Token information
      * Display information
           IF W-RESPONSE = EYUVALUE(OK)
             IF CH8ARR(1)= 'FEEDBACK'
               MOVE W-BUFFER TO W-FBBUFF
               PERFORM DISPFEED
             END-IF
             IF CH8ARR(1)= 'BINSTERR'
               PERFORM DISPBIER
             END-IF
             IF CH8ARR(1)= 'BINCONRS'
               PERFORM DISPBIRS
             END-IF
             IF CH8ARR(1)= 'BINCONSC'
               PERFORM DISPBISC
             END-IF
             GO TO FERTRES
           END-IF.
           MOVE W-RESPONSE TO PICZZZ9.
           MOVE W-REASON TO PYCZZZ9.
           STRING '*** FEEDBACK not available (' DELIMITED BY SIZE
           PICZZZ9 DELIMITED BY SIZE ',' DELIMITED BY SIZE
           PYCZZZ9 DELIMITED BY SIZE ')' DELIMITED BY SIZE
           BLNKPAD DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
       EGETFER.
           EXIT.
 
      *************************************************
      * This subroutine displays FEEDBACK information *
      *************************************************
       DISPFEED.
           MOVE W-FBBUFF TO FEEDBACK.
           STRING BINZERO COMMAND OF FEEDBACK DELIMITED BY SIZE
           INTO FBCHAR2.
           MOVE FBHALF TO PICZZZ9.
           MOVE RESPONSE OF FEEDBACK TO PYCZZZ9.
           MOVE REASON OF FEEDBACK TO PIKZZZ9.
           MOVE RSLTRECID OF FEEDBACK TO PYKZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING 'Cmd=' PICZZZ9 ' Attr=' ATTRDATAVAL OF
           FEEDBACK ' Eib=' CEIBDATAVAL OF FEEDBACK ' Err='
           ERRCODEVAL OF FEEDBACK ' Rspn=' PYCZZZ9 ' Reas='
           PIKZZZ9 ' ResId=' PYKZZZ9
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE ERROR-CODE OF FEEDBACK TO PICZZZ9.
           MOVE CEIBRESP OF FEEDBACK TO PYCZZZ9.
           MOVE CEIBRESP1 OF FEEDBACK TO PIKZZZ9.
           MOVE CEIBFN OF FEEDBACK TO PYKZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING '  ECode=' PICZZZ9 ' RESP=' PYCZZZ9
           ' RESP1=' PIKZZZ9 ' EibFn=' PYKZZZ9 ' Obj='
           OBJECT-A OF FEEDBACK ' OAct=' OBJECT-ACT OF FEEDBACK
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE SPACES TO W-TEXT.
           STRING '  Att1=' ATTR-NM1 OF FEEDBACK ' 2='
           ATTR-NM2 OF FEEDBACK ' 3=' ATTR-NM3 OF FEEDBACK
           ' 4=' ATTR-NM4 OF FEEDBACK ' 5=' ATTR-NM5 OF
           FEEDBACK DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE ERR-COUNT OF FEEDBACK TO PICZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING '  FObj=' ERR-OBJECT OF FEEDBACK
           '  FCnt=' PICZZZ9
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE ERR-COUNT OF FEEDBACK TO FULLARR(1).
           EXIT.
 
      *************************************************
      * This subroutine displays BINSTERR information *
      *************************************************
       DISPBIER.
           MOVE W-BUFFER TO BINSTERR.
           MOVE SPACES TO W-TEXT.
           STRING 'CMAS=' CMASNAME OF BINSTERR ' Plex='
           PLEXNAME OF BINSTERR ' CSys=' CICSNAME OF BINSTERR
           ' ResName=' RESNAME OF BINSTERR
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE RESVER OF BINSTERR TO PICZZZ9.
           MOVE ERRCODE OF BINSTERR TO PYCZZZ9.
           MOVE CRESP1 OF BINSTERR TO PIKZZZ9.
           MOVE CRESP2 OF BINSTERR TO PYKZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING '  ResVer=' PICZZZ9 ' ECode=' PYCZZZ9
           ' RESP=' PIKZZZ9 ' RESP1=' PYKZZZ9
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE CEIBFN OF BINSTERR TO PICZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING ' EibFn=' PICZZZ9
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           EXIT.
 
      *************************************************
      * This subroutine displays BINCONRS information *
      *************************************************
       DISPBIRS.
           MOVE W-BUFFER TO BINCONRS.
           MOVE ERROP OF BINCONRS TO PICZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING 'CMAS=' CMASNAME OF BINCONRS ' Plex='
           PLEXNAME OF BINCONRS ' CSys=' CICSNAME OF BINCONRS
           ' ResType=' RESTYPE OF BINCONRS ' EOp=' PICZZZ9
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE CANDVER OF BINCONRS TO PICZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING '  CandName=' CANDNAME OF BINCONRS
           ' CandVer=' PICZZZ9 ' CResGrp=' CANDRGRP OF BINCONRS
           ' CResAss=' CANDRASG OF BINCONRS ' CResDes='
           CANDRDSC OF BINCONRS
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE CANDUSAGE OF BINCONRS TO CODEV.
           MOVE 'BINCONRS' TO CHR8.
           MOVE 'CANDUSAGE' TO CHR12.
           PERFORM XCV2CH
           MOVE CHARV TO CHAR6.
           MOVE CANDTYPE OF BINCONRS TO CODEV.
           MOVE 'BINCONRS' TO CHR8.
           MOVE 'CANDTYPE' TO CHR12.
           PERFORM XCV2CH
           MOVE CHARV TO CHAR12.
           MOVE CANDASGOVR OF BINCONRS TO CODEV.
           MOVE 'BINCONRS' TO CHR8.
           MOVE 'CANDASGOVR' TO CHR12.
           PERFORM XCV2CH
           MOVE SPACES TO W-TEXT.
           STRING '  CandUsa=' CHAR6
           ' CandSGrp=' CANDSGRP OF BINCONRS
           ' CandSTyp=' CHAR12 ' CandAssO=' CHARV
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE EXISTVER OF BINCONRS TO PICZZZ9.
           MOVE EXISTUSAGE OF BINCONRS TO CODEV.
           MOVE 'BINCONRS' TO CHR8.
           MOVE 'EXISTUSAGE' TO CHR12.
           PERFORM XCV2CH
           MOVE SPACES TO W-TEXT.
           STRING '  ExistName=' EXISTNAME OF BINCONRS
           ' ExistVer=' PICZZZ9 ' EResGrp=' EXISTRGRP OF
           BINCONRS ' EResAss=' EXISTRASG OF BINCONRS
           ' EResDes=' EXISTRDSC OF BINCONRS ' ExistUsa=' CHARV
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE EXISTTYPE OF BINCONRS TO CODEV.
           MOVE 'BINCONRS' TO CHR8.
           MOVE 'EXISTTYPE' TO CHR12.
           PERFORM XCV2CH
           MOVE CHARV TO CHAR12.
           MOVE EXISTASGOVR OF BINCONRS TO CODEV.
           MOVE 'BINCONRS' TO CHR8.
           MOVE 'EXISTASGOVR' TO CHR12.
           PERFORM XCV2CH
           MOVE SPACES TO W-TEXT.
           STRING '  ExistSGrp=' EXISTSGRP OF BINCONRS
           ' ExistSTyp=' CHAR12 ' ExistAssO=' CHARV
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           EXIT.
 
      *************************************************
      * This subroutine displays BINCONSC information *
      *************************************************
       DISPBISC.
           MOVE W-BUFFER TO BINSTERR.
           MOVE ERROP OF BINCONSC TO PICZZZ9.
           MOVE ERRCODE OF BINCONSC TO PYCZZZ9.
           MOVE SPACES TO W-TEXT.
           STRING 'CMAS=' CMASNAME OF BINCONSC ' Plex='
           PLEXNAME OF BINCONSC ' EOp=' PICZZZ9 ' ECode='
           PYCZZZ9 ' TScope=' TARGSCOPE OF BINCONSC
           ' TAssgn=' TARGRASG OF BINCONSC
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           MOVE SPACES TO W-TEXT.
           STRING '  TDesc=' TARGRDSC OF BINCONSC ' RScope='
           RELSCOPE OF BINCONSC ' RAssgn=' RELRASG OF BINCONSC
           ' RDesc=' RELRDSC OF BINCONSC ' CSys=' CICSNAME OF
           BINCONSC
           DELIMITED BY SIZE INTO W-TEXT END-STRING.
           PERFORM SCRNLOG2.
           EXIT.
 
      ************************************************************
      * This subroutine converts coded value to character string *
      ************************************************************
       XCV2CH.
      * Use new thread for TRANSLATE
           EXEC CPSM CONNECT
                     VERSION('0140')
                     THREAD(W-FBTTKN)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
 
      * Translate internal coded value to character value
           EXEC CPSM TRANSLATE
                     OBJECT(CHR8)
                     ATTRIBUTE(CHR12)
                     FROMCV(CODEV) TOCHAR(CHARV)
                     THREAD(W-FBTTKN)
                     RESPONSE(W-RESPONSE)
                     REASON(W-REASON)
           END-EXEC.
           EXIT.
 
      *-------------------------------------------------------------*
      *    PROCESSING FOR API FAILURES.                             *
      *-------------------------------------------------------------*
       NO-CONNECT.
           MOVE 'ERROR CONNECTING TO API.' TO W-MSG-TEXT.
           GO TO SCRNLOG.
       NO-CREATE.
           MOVE 'ERROR CREATING DEFINITION.' TO W-MSG-TEXT.
           GO TO SCRNLOG.
       NO-GET.
           MOVE 'ERROR GETTING RESOURCE TABLE.' TO W-MSG-TEXT.
           GO TO SCRNLOG.
       NO-INSTALL.
           MOVE 'ERROR INSTALLING RESULT SET.' TO W-MSG-TEXT.
           GO TO SCRNLOG.
       NO-TRANSLATE.
           MOVE 'ERROR TRANSLATING ATTRIBUTE.' TO W-MSG-TEXT.
           GO TO SCRNLOG.
       SCRNLOG.
      *    DISPLAY W-MSG-TEXT.
           EXEC CICS SEND FROM(W-MSG-TEXT) LENGTH(81) WAIT END-EXEC.
           MOVE W-RESPONSE TO PICZZZ9A.
           MOVE W-REASON TO PICZZZ9B.
           STRING 'RESPONSE=' DELIMITED BY SIZE
                  PICZZZ9A DELIMITED BY SIZE
                  ' REASON= ' DELIMITED BY SIZE
                  PICZZZ9B DELIMITED BY SIZE
                  INTO W-MSG-TEXT.
       SCRNLOG2.
      *    DISPLAY W-MSG-TEXT.
           EXEC CICS SEND FROM(W-MSG-TEXT) LENGTH(81) WAIT END-EXEC.
 
       ENDIT.
      *-------------------------------------------------------------*
      *    TERMINATE API CONNECTION.                                *
      *-------------------------------------------------------------*
           EXEC CPSM TERMINATE RESPONSE(W-RESPONSE) REASON(W-REASON)
           END-EXEC.
           EXEC CICS RETURN END-EXEC.
      *    GOBACK
           EXIT.
       EYULAPI4-END.
 

The COBOL version of EYUxAPI4 is written for the CICS environment and can be converted to run in the MVS/ESA batch environment by commenting the EXEC CICS SEND commands, and uncommenting the preceding language specific output statement.

[[ Contents Previous Page | Next Page Index ]]