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