|
August 2006 Technical Tip – Compress / Left-justify fields using Easytrieve
Not so very long ago I was searching the web for an Easytrieve solution to
a problem. I found what I was looking for. Now it's my turn to contribute to
the general body of knowledge. What follows is an Easytrieve program which will
accept an alphanumeric field and left-justify it, removing any extra spaces so that
there is one space only between each word or character string. I hope someone
finds this useful.
//* JOBCARD HERE
//********************************************
//* COMPRESS A FIELD (REMOVE EXTRA SPACES) *
//********************************************
//STEP010 EXEC PGM=EZTPA00
//MYINPUT DD *
*THEREARENOBLANKSHERE*
*TWO BLANKS BETWEEN*
* LEADING/TRAILING *
*NEXT RECORD IS BLANK*
* *
* THREE BLANKS *
*A *
* Z*
*A Z*
*A MN Z*
*THIS IS ALREADY GOOD*
//MYOUTPUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
FILE MYINPUT
STRING 2 20 A
FILE MYOUTPUT FB(80 0)
* "SOURCE" WORKING STORAGE AREA
DEFINE SOURCE-STRING W 20 A
DEFINE SOURCE-BYTE SOURCE-STRING 1 A OCCURS 20
DEFINE SOURCE-SUB W 2 N 0
DEFINE STRING-STARTED W 1 A
* "TARGET" WORKING STORAGE AREA
DEFINE TARGET-STRING W 20 A
DEFINE TARGET-BYTE TARGET-STRING 1 A OCCURS 20
DEFINE TARGET-SUB W 2 N 0
JOB INPUT MYINPUT
SOURCE-STRING = STRING
PERFORM COMPRESS-STRING
STRING = TARGET-STRING
MOVE MYINPUT TO MYOUTPUT
PUT MYOUTPUT
COMPRESS-STRING. PROC
SOURCE-SUB = 1
TARGET-SUB = 1
STRING-STARTED = 'N'
TARGET-STRING = ' '
DO UNTIL SOURCE-SUB GT 20
IF SOURCE-BYTE (SOURCE-SUB) EQ ' '
IF STRING-STARTED = 'Y'
TARGET-SUB = TARGET-SUB + 1
STRING-STARTED = 'N'
ELSE
SOURCE-SUB = SOURCE-SUB + 1
END-IF
ELSE
TARGET-BYTE (TARGET-SUB) = SOURCE-BYTE (SOURCE-SUB)
TARGET-SUB = TARGET-SUB + 1
SOURCE-SUB = SOURCE-SUB + 1
STRING-STARTED = 'Y'
END-IF
END-DO
END-PROC
|
Download file here.
Here is the output...
*THEREARENOBLANKSHERE*
*TWO BLANKS BETWEEN *
*LEADING/TRAILING *
*NEXT RECORD IS BLANK*
* *
*THREE BLANKS *
*A *
*Z *
*A Z *
*A MN Z *
*THIS IS ALREADY GOOD*
|
We hope you will consider Caliber Data Training when you are in need of high quality Easytrieve training.
Go to the articles index.
Written by Bill Qualls. Copyright © 2006 by Caliber Data Training 800.938.1222
|