Using Easytrieve to achieve COBOL INSPECT … REPLACE functionality
search cancel

Using Easytrieve to achieve COBOL INSPECT … REPLACE functionality

book

Article ID: 56140

calendar_today

Updated On:

Products

Easytrieve Report Generator

Issue/Introduction

Have you ever asked the following questions....
Does Easytrieve Report Generator have the equivalent of the COBOL INSPECT...REPLACE statement?
Does Easytrieve Report Generator have a built in function that will do a search and replace?
Does Easytrieve Report Generator have a statement that will change lowercase to uppercase?

Please see the Resolution for two solutions to answer each of those questions.

 

Environment

Easytrieve Report Generator, release 11.6

Resolution

The uppercase/lowercase solution makes the change by adding +64 to each letter and the other one accomplishes the same end by "OR ing" a hex '40'. This solution performs a similar function to the COBOL INSPECT...REPLACE statement and can be altered to meet your individual needs.

This job makes the change by adding +64 to each letter:


//userid JOB (40200000),'EZT+ 6.2 ',
// MSGCLASS=A,MSGLEVEL=(1,1),REGION=2048K,
// CLASS=K,TIME=1439,NOTIFY=userid,USER=userid,PASSWORD=password
/*ROUTE PRINT xxxxx.xxxxxx
//EZT1 EXEC PGM=EZTPA00,REGION=512K
//STEPLIB DD DISP=SHR,DSN='your.easytrieve.CAILIB'
//SYSPRINT DD SYSOUT=A
//SYSSNAP DD SYSOUT=A
//SYSOUT DD SYSOUT=A
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,1)
//EZTVFM DD UNIT=SYSDA,SPACE=(4096,(100,100))
//SYSLIN DD UNIT=SYSDA,SPACE=(4096,(100,100)),DISP=(,PASS),
// DSN=&&SYSLIN
LIST ON MACROS
PARM LINK(EZUPPER R)
***********************************************************************
* THIS IS AN EXAMPLE OF INSPECTING EVERY BYTE FOR LOWERCASE LETTERS *
* AND REPLACES THAT LETTER WITH AN EQUIVALENT UPPERCASE LETTER *
* BY ADDING + 64 *
***********************************************************************
DEFINE FROM-FIELD W 40 A VALUE 'GOHN +
abcdefghijklmnopqrstuvwxyz'
DEFINE FROM-FIELD-BYTE FROM-FIELD 1 A OCCURS 40
DEFINE FROM-SUB W 2 N
***********************************************************************
* THE TO-FIELD ARRAY USES INDEXING *
***********************************************************************
DEFINE TO-FIELD W 40 A
DEFINE TO-FIELD-BYTE TO-FIELD 1 A OCCURS 40 INDEX TO-INDEX
DEFINE BINARY-LETTER TO-FIELD 1 B OCCURS 40 INDEX TO-INDEX
DEFINE FIND-FIELD W 1 A VALUE 'G'
DEFINE CHANGE-TO W 1 A VALUE 'J'
*
JOB INPUT NULL
*
PERFORM UP-CASE
PERFORM DISPLAY-RESULTS
STOP
*
UP-CASE. PROC

MOVE ' ' TO TO-FIELD FILL ' '
FROM-SUB = 1
TO-INDEX = 0

* LOOK FOR THE LETTER 'G' AND CHANGE IT TO THE LETTER 'J'

DO UNTIL FROM-SUB GT 40
IF FROM-FIELD-BYTE (FROM-SUB) = FIND-FIELD
TO-FIELD-BYTE (FROM-SUB) = CHANGE-TO
ELSE
TO-FIELD-BYTE = FROM-FIELD-BYTE (FROM-SUB)
END-IF

* NOW CONVERT LOWERCASE LETTERS TO UPPERCASE LETTERS

IF BINARY-LETTER EQ 129 THRU 137 OR -
BINARY-LETTER EQ 145 THRU 153 OR -
BINARY-LETTER EQ 162 THRU 169
BINARY-LETTER = BINARY-LETTER + 64
END-IF

TO-INDEX = TO-INDEX + 1
FROM-SUB = FROM-SUB + 1
END-DO
END-PROC

DISPLAY-RESULTS. PROC

* DISPLAY THE BEFORE AND AFTER RESULTS

DISPLAY 'RESULTS:'
DISPLAY ' '
DISPLAY '**********************************************************'
DISPLAY 'FROM-FIELD = ' FROM-FIELD
DISPLAY '*************0000000001111111111222222222233333333334*****'
DISPLAY ' 1234567890123456789012345678901234567890*****'
DISPLAY '**********************************************************'
DISPLAY 'TO-FIELD = ' TO-FIELD
DISPLAY '*************0000000001111111111222222222233333333334*****'
DISPLAY ' 1234567890123456789012345678901234567890*****'
DISPLAY '**********************************************************'

END-PROC

/*
//LKED EXEC PGM=IEWL
//SYSPRINT DD SYSOUT=A
//SYSLIN DD DSN=&&SYSLIN,DISP=(OLD,DELETE)
//SYSLMOD DD DISP=SHR,DSN='your.easytrieve.CAILIB'
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,5))
/*
//EZT1 EXEC PGM=EZUPPER,REGION=512K
//STEPLIB DD DISP=SHR,DSN='your.easytrieve.CAILIB'
//SYSPRINT DD SYSOUT=A
//SYSSNAP DD SYSOUT=A
//SYSOUT DD SYSOUT=A
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,1)
//EZTVFM DD UNIT=SYSDA,SPACE=(4096,(100,100))
//
.
.
.
Running this job produces the following display
.
.
.
Results:

**********************************************************
FROM-FIELD = GOHN abcdefghijklmnopqrstuvwxyz
*************0000000001111111111222222222233333333334*****
1234567890123456789012345678901234567890*****
**********************************************************
TO-FIELD = JOHN ABCDEFGHIJKLMNOPQRSTUVWXYZ
*************0000000001111111111222222222233333333334*****
1234567890123456789012345678901234567890*****
**********************************************************

This job accomplishes the same task by "ORing" a hex '40'.

//userid JOB (40200000),'EZT+ 6.2 ',
// MSGCLASS=A,MSGLEVEL=(1,1),REGION=2048K,
// CLASS=K,TIME=1439,NOTIFY=userid,USER=userid,PASSWORD=password
//EZT1 EXEC PGM=EZTPA00,REGION=512K
//STEPLIB DD DISP=SHR,DSN='your.easytrieve.CAILIB'
//SYSPRINT DD SYSOUT=A
//SYSSNAP DD SYSOUT=A
//SYSOUT DD SYSOUT=A
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,1)
//EZTVFM DD UNIT=SYSDA,SPACE=(4096,(100,100))
//SYSLIN DD UNIT=SYSDA,SPACE=(4096,(100,100)),DISP=(,PASS),
// DSN=&&SYSLIN
LIST ON MACROS
PARM LINK(EZUPPER R)
***********************************************************************
* THIS IS AN EXAMPLE OF INSPECTING EVERY BYTE FOR LOWERCASE LETTERS *
* AND REPLACES THAT LETTER WITH AN EQUIVALENT UPPERCASE LETTER *
* BY 'OR' ING A HEX 40 *
***********************************************************************
DEFINE FROM-FIELD W 40 A VALUE 'GOHN +
abcdefghijklmnopqrstuvwxyz'
DEFINE FROM-FIELD-BYTE FROM-FIELD 1 A OCCURS 40
DEFINE FROM-SUB W 2 N
***********************************************************************
* THE TO-FIELD ARRAY USES INDEXING *
***********************************************************************
DEFINE TO-FIELD W 40 A
DEFINE TO-FIELD-BYTE TO-FIELD 1 A OCCURS 40 INDEX TO-INDEX
DEFINE BINARY-LETTER TO-FIELD 1 B OCCURS 40 INDEX TO-INDEX
DEFINE FIND-FIELD W 1 A VALUE 'G'
DEFINE CHANGE-TO W 1 A VALUE 'J'
*
JOB INPUT NULL
*
PERFORM UP-CASE
PERFORM DISPLAY-RESULTS
STOP
*
UP-CASE. PROC

MOVE ' ' TO TO-FIELD FILL ' '
FROM-SUB = 1
TO-INDEX = 0

* LOOK FOR THE LETTER 'G' AND CHANGE IT TO THE LETTER 'J'

DO UNTIL FROM-SUB GT 40
IF FROM-FIELD-BYTE (FROM-SUB) = FIND-FIELD
TO-FIELD-BYTE (FROM-SUB) = CHANGE-TO
ELSE
TO-FIELD-BYTE = FROM-FIELD-BYTE (FROM-SUB)
END-IF

* NOW CONVERT LOWERCASE LETTERS TO UPPERCASE LETTERS

IF BINARY-LETTER EQ 129 THRU 137 OR -
BINARY-LETTER EQ 145 THRU 153 OR -
BINARY-LETTER EQ 162 THRU 169
BINARY-LETTER = BINARY-LETTER OR X'40'
END-IF

TO-INDEX = TO-INDEX + 1
FROM-SUB = FROM-SUB + 1
END-DO
END-PROC

DISPLAY-RESULTS. PROC

* DISPLAY THE BEFORE AND AFTER RESULTS

DISPLAY 'RESULTS:'
DISPLAY ' '
DISPLAY '**********************************************************'
DISPLAY 'FROM-FIELD = ' FROM-FIELD
DISPLAY '*************0000000001111111111222222222233333333334*****'
DISPLAY ' 1234567890123456789012345678901234567890*****'
DISPLAY '**********************************************************'
DISPLAY 'TO-FIELD = ' TO-FIELD
DISPLAY '*************0000000001111111111222222222233333333334*****'
DISPLAY ' 1234567890123456789012345678901234567890*****'
DISPLAY '**********************************************************'

END-PROC

/*
//LKED EXEC PGM=IEWL
//SYSPRINT DD SYSOUT=A
//SYSLIN DD DSN=&&SYSLIN,DISP=(OLD,DELETE)
//SYSLMOD DD DISP=SHR,DSN='your.easytrieve.CAILIB'
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,5))
/*
//EZT1 EXEC PGM=EZUPPER,REGION=512K
//STEPLIB DD DISP=SHR,DSN='your.easytrieve.CAILIB'
//SYSPRINT DD SYSOUT=A
//SYSSNAP DD SYSOUT=A
//SYSOUT DD SYSOUT=A
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,1)
//EZTVFM DD UNIT=SYSDA,SPACE=(4096,(100,100))
//
.
.
.
Running this job produces the following display
.
.
.
Results:

**********************************************************
FROM-FIELD = GOHN abcdefghijklmnopqrstuvwxyz
*************0000000001111111111222222222233333333334*****
1234567890123456789012345678901234567890*****
**********************************************************
TO-FIELD = JOHN ABCDEFGHIJKLMNOPQRSTUVWXYZ
*************0000000001111111111222222222233333333334*****
1234567890123456789012345678901234567890*****
**********************************************************