Program EYULAPI4 is written in COBOL for the CICS® environment.
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 ]]