SORT: Adding numeric fields within a record

The blow example illustrates how to add two numeric fields in a record 

Following is the i/p file

 111 222
 333 444
 000 111
 222 000

 O/p file should look as follows

 333 ( i.e, 111 + 222)
 777 
 111
 222


Here is the simplest way it can be done:

//STEP020 EXEC PGM=SORT
//SYSOUT DD SYSOUT=*    
//SORTIN DD *          
111 222                
333 444                
001 111                
222 000                
//SORTOUT DD SYSOUT=*  
//SYSIN DD *            
INREC FIELDS=(1,3,ZD,ADD,
              5,3,ZD)  
SORT FIELDS=COPY      
/*                        
The output will be:

           333
           777
           112
           222

You might notice that there are a few SPACES before the results. If you want to avoid them you could code it as follows: (Note that I made it four characters to avoid possible overflows)

//STEP020 EXEC PGM=SORT          
//SYSOUT DD SYSOUT=*              
//SORTIN DD *                    
111 222                          
333 444                          
001 111                          
222 000                          
//SORTOUT DD SYSOUT=*            
//SYSIN DD *                      
INREC FIELDS=((1,3,ZD,ADD,      
               5,3,ZD),EDIT(TTTT))
SORT FIELDS=COPY                
/*                                  

Now, the output will be:

0333
0777
0112
0222



Here is the round about way using Synctool.

//STEP020 EXEC PGM=SYNCTOOL                            
//IN      DD *
111222
333444
//TEMP1   DD DSN=&&TEMP1,                    
//           DISP=(,CATLG),SPACE=(TRK,1),LRECL=6,RECFM=FB
//TEMP2   DD DSN=&&TEMP2,                    
//           DISP=(,CATLG),SPACE=(TRK,1),LRECL=6,RECFM=FB
//OUT     DD SYSOUT=*                                  
//SSMSG   DD SYSOUT=*                                  
//TOOLMSG DD SYSOUT=*                                  
//TOOLIN DD *                                          
 COPY FROM(IN) TO(TEMP1) USING(CTL1)                    
 SORT FROM(TEMP1) USING(CTL2)                          
 COPY FROM(TEMP2) TO(OUT) USING(CTL3)                  
//CTL1CNTL DD *                                        
 INREC FIELDS=(1,6,SEQNUM,3,ZD)                        
 OUTFIL OUTREC=(7,3,1,3,/,                              
               7,3,4,3)                                
//CTL2CNTL DD *                                        
 SORT FIELDS=(1,3,CH,A)                                
 SUM FIELDS=(4,3,ZD)  
 OUTFIL FNAMES=TEMP2  
//CTL3CNTL DD *        
 OUTREC FIELDS=(4,3,3X)
//*   

JCL: To check if a sequential file is empty

Below is an easy way to check if a sequential file is empty.

//STEP010   EXEC PGM=IDCAMS                
//SYSPRINT  DD  SYSOUT=*                  
//INFILE    DD DSN=xxxxxxx.xxxx,DISP=SHR  
//SYSIN     DD  *                          
 PRINT INFILE(INFILE) CHARACTER COUNT(1)  
/*                                        

This step sets RC as follows :

SETS RC=0000 IF DATASET HAS RECORDS  
SETS RC=0004 IF DATASET IS EMPTY      
SETS RC=0012 IF DATASET IS NOT CATALOGED


If the file is not cataloged you would get a JCL error if the IDCAMS is coded with a DD statement and the PRINT command referencing the INFILE as shown.

What you would need to avoid this would be to remove the DD statement and use INDATASET(xxxxxxx.xxxx) on the PRINT command. Then you can check if the file is cataloged:

//STEP010   EXEC PGM=IDCAMS                
//SYSPRINT  DD  SYSOUT=*                  
//SYSIN     DD  *                          
 PRINT INDATASET(xxxxxxx.xxxx) CHARACTER COUNT(1)  
/*        

COBOL:Subtract 6 months from a date

The below code snippet subtracts six months from a given date.


....Working Storage....
01 MONTH-END-DD PIC X(24) VALUE '312831303130313130313031'.
01 TBL-MONTH-END REDEFINES MONTH-END-DD.
   03 TBL-MONTH-END-DAY OCCURS 12 TIMES.
      05 TBL-MONTH-END-DD PIC 9(02).

01 WS-DATE.
   02 YYYY PIC 9(4).
   02 MM   PIC 99.
   02 DD   PIC 99.

....Procedure Division....
ACCEPT WS-DATE

IF MM > 6 THEN
   SUBTRACT 6 FROM MM
ELSE
   ADD      6 TO   MM
   SUBTRACT 1 FROM YYYY
END-IF.

* Leap year Check
IF ( FUNCTION MOD (YYYY, 400) = 0) OR    
   ( FUNCTION MOD (YYYY, 4) = 0 AND      
     FUNCTION MOD (YYYY, 100) NOT = 0 )  
   MOVE '29' TO MONTH-END-DD (3:2)
ELSE
   MOVE '28' TO MONTH-END-DD (3:2)
END-IF

IF DD > TBL-MONTH-END-DD (MM)
   MOVE TBL-MONTH-END-DD (MM) TO DD
END-IF

Sort to different output files

 I have a input file which I want to sort and put it in 2 output files. I want this in  a single step using sort.


Here is an example:

//STEP010 EXEC PGM=SORT                             
//SYSUDUMP  DD SYSOUT=*                             
//SYSOUT    DD SYSOUT=*                             
//SORTIN   DD  DSN=INPUT.XXXX.SOMETHING.KSDF,   
//             DISP=SHR                             
//SORTOF1   DD DSN=userid.TSTS.XXXX.HEADER,        
//             DISP=(NEW,CATLG,DELETE),             
//             DCB=(LRECL=270,RECFM=FB),            
//             SPACE=(CYL,(50,50),RLSE)             
//SORTOF2   DD DSN=userid.TSTS.XXXX.COMPLETE,        
//             DISP=(NEW,CATLG,DELETE),             
//             DCB=(LRECL=270,RECFM=FB),            
//             SPACE=(CYL,(50,50),RLSE)             
//SYSIN     DD *                                    
SORT FIELDS=COPY                                   
OUTFIL FILES=1,INCLUDE=(6,2,CH,EQ,C'01') ==> Copies based on condition...
OUTFIL FILES=2   ========> Simply copies
/*                   
(Alternately, instead of FILES=1, you could also use FNAMES=TEMP1 and use
that DDNAME - TEMP1 - instead of SORTOF1)

SORT - Writing Duplicate records into a file

Do you know how to write the duplicate records into a separate file while eliminating the duplicate records in SORT?

Here is the way to do that..

Special DD name SORTXSUM is available in SYNCSORT.

In this you need to specify the file name in which you need the duplicates to be get stored.

Then in the sysin card you need to specify as below mentioned,

SUM FIELDS=NONE,XSUM


 To achieve the same in DFSORT, you need to use ICETOOL:

//S1    EXEC  PGM=ICETOOL
//TOOLMSG   DD  SYSOUT=*
//DFSMSG    DD  SYSOUT=*
//IN DD DSN=...  input file
//OUT1 DD DSN=...  output file 1
//OUT2 DD DSN=...  output file 2
//TOOLIN DD *
 SELECT FROM(IN) TO(OUT1) DISCARD(OUT2) ON(1,4,CH) FIRST
/*

SORT : Selecting first and last record

If you have got FILEAID, you can do it quite easily:

//STEP002  EXEC PGM=FILEAID                              
//SYSPRINT DD SYSOUT=*                                  
//DD01     DD DSN=userid.input.file,DISP=SHR
//DD01O    DD DSN=userid.output.file,      
//            DISP=(NEW,CATLG,DELETE),                  
//            SPACE=(CYL,(1,1),RLSE),                    
//            DCB=(RECFM=FB,LRECL=82)                    
//DD02     DD DSN=*.DD01,DISP=SHR                        
//DD02O    DD DSN=*.DD01O,DISP=(MOD,KEEP,KEEP),          
//            VOL=REF=*.DD01O                            
//SYSIN    DD  *                                        
$$DD01 COPY OUT=1                                        
$$DD02 COPYBACK OUT=1                                    
/*               


If you don't have FILEAID, SYNCTOOL (or ICETOOL) too can be used, taking advantage of the FIRST and LAST options for duplicates:

//STEP0100 EXEC PGM=SYNCTOOL                                      
//TOOLMSG DD SYSOUT=*                                              
//SSMSG  DD SYSOUT=*                                              
//IN1     DD DSN=userid.input.file,DISP=SHR
//TEMP1   DD DSN=&TEMP1,DISP=(,PASS),SPACE=(CYL,(2,2),RLSE)        
//TEMP2   DD DSN=&TEMP2,DISP=(,PASS),SPACE=(CYL,(2,2),RLSE)        
//TEMP3   DD DSN=&TEMP3,DISP=(,PASS),SPACE=(CYL,(2,2),RLSE)        
//TEMP4   DD DSN=*.TEMP2,DISP=(OLD,PASS),VOL=REF=*.TEMP2
//        DD DSN=*.TEMP3,DISP=(OLD,PASS),VOL=REF=*.TEMP3
//OUT1    DD SYSOUT=*                                              
//TOOLIN  DD  *                                                    
     COPY FROM(IN1)   USING(CNT1)                              
     SELECT FROM(TEMP1) TO(TEMP2) ON(601,1,CH) FIRST
     SELECT FROM(TEMP1) TO(TEMP3) ON(601,1,CH) LAST
     COPY FROM(TEMP4) USING(CNT2)                              
//CNT1CNTL DD *
*  Adding a constant at the end of the record structure, on which
*  we can sort the entire file; ensuring duplicates. Now we just
*  need to extract the first and the last duplicates!
  OUTFIL FNAMES=TEMP1,OUTREC=(1,600,C'1')
//CNT2CNTL DD *                        
*  Remove the constant that was temporarily added.
  OUTFIL FNAMES=OUT1,OUTREC=(1,600)
/*               

Extract records from File1 which are not available in File2

Assume there are two files, whose keys (unique) are the first 12 bytes. File1 has record length (say) 600 and File2 has record length (say) 150. What we need is to Extract records from File1 which are not available in File2, where Field2 in File2 matches with Field1 in File1.

i.e. if we put it in SQL it would be something like :
Select * from File1
Where File1.Field1 NOT in 
(Select File2.Field2 from File2) 


Here are two methods we know:
A. In four steps using SORT :
i. To file1, concatenate an identifier (say) '1' to the end of the output record structure.
ii. Extract all records from file2; make the output file length = the length of the file1; Concatenate an identifier(say) '2' to the end of the output record structure.
iii.Sort the two files generated in steps ii. and iii. above : 
SORT by the key(first 12 bytes), and SUM the new identifier field added. Now : 
a. The Sum is 1, if the record is available only in file1
b. The Sum is 2, if the record is available only in file2
c. The Sum is 3, if the record is available in both files.
iv. Extract all the records having the SUM '1' from this output file - they satisfy our requirement. 

B. In a single step using SYNCTOOL/ICETOOL :


//STEP010 EXEC PGM=SYNCTOOL
//SSMSG DD SYSOUT=*
//TOOLMSG DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//IN1 DD DISP=SHR,DSN=userid.tsts.file1
//IN2 DD DISP=SHR,DSN=userid.tsts.file2
//OUT1 DD DSN=&&TEMP1,
// DISP=(NEW,DELETE,DELETE),
// SPACE=(CYL,(5,5),RLSE),
// DCB=(RECFM=FB,LRECL=601)
//OUT2 DD DSN=&&TEMP2,
// DISP=(NEW,DELETE,DELETE),
// SPACE=(CYL,(5,5),RLSE),
// DCB=(RECFM=FB,LRECL=601)
//*------------------------------------------------------------------*
//* NOTE : THE FOLLOWING TEMPORARY FILE NEEDS TO HAVE DISP = MOD *
//* SINCE IT IS REQUIRED TO CONCATENATE TWO DATASETS -
//* OUT1 and OUT2
//*------------------------------------------------------------------*
//OUT3 DD DSN=&&TEMP3,
// DISP=(MOD,DELETE,DELETE),
// SPACE=(CYL,(5,5),RLSE),
// DCB=(RECFM=FB,LRECL=601)
//OUT4 DD DSN=&&TEMP4,
// DISP=(NEW,DELETE,DELETE),
// SPACE=(CYL,(5,5),RLSE),
// DCB=(RECFM=FB,LRECL=601)
//OUT5 DD DSN=DSN=userid.tsts.output,
// DISP=(NEW,CATLG,DELETE),
// SPACE=(CYL,(5,5),RLSE),
// DCB=(RECFM=FB,LRECL=600)
//SYSOUT DD SYSOUT=*
//TOOLIN DD *
COPY FROM(IN1) USING(CTL1)
COPY FROM(IN2) USING(CTL2)
COPY FROM(OUT1) USING(CTL3)
COPY FROM(OUT2) USING(CTL3)
SELECT FROM(OUT3) TO(OUT4) ON(1,12,CH) NODUPS
COPY FROM(OUT4) USING(CTL4)
/*
//CTL1CNTL DD *
* ADD IDENTIFIER '1' TO THE END OF THE FILE1 RECORD
OUTFIL FNAMES=OUT1,OUTREC=(1,600,C'1')
/*
//CTL2CNTL DD *
* MAKE THE RECORD LENGTH EQUAL TO THAT OF FILE1 BY PADDING WITH
* SPACES, AND ADD IDENTIFIER '2' TO THE END OF THE RECORD
OUTFIL FNAMES=OUT2,OUTREC=(1,12,588X,C'2')
/*
//CTL3CNTL DD *
* DIRECT COPY FROM INPUT TO OUTPUT;USED TO CONCATENATE THE TWO
* FILES OUT1 and OUT2 to OUT3
OUTFIL FNAMES=OUT3
/*
//CTL4CNTL DD *
* KEEP ONLY THOSE RECORDS IN DS1 THAT AREN'T IN DS2(i.e. WITH
* IDENTIFIER '1')AND REMOVE THE '1' IDENTIFIER FROM THE RECORD
OUTFIL FNAMES=OUT5,INCLUDE=(601,1,CH,EQ,C'1'),OUTREC=(1,600)
/*
//*

SORT - Extract records 1,5,9,13,...

I have got a sequential file in which every set of 4 records forms one unit of data - say, the first line contains student name and Date of birth, second line contains address, third line contains percentage of marks scored in 10 subjects and fourth line contains extra-curricular activities. 
  
  Student Id will be available on all four records, to help in identification. Each and every student WILL have the four records mentioned - you won't have a student with (say) the first three records alone.

  Now I need to extract ONLY the first record for each student. That will be the records 1,5,9,13,17, etc till the end of the file. 


Solution


//STEP010  EXEC PGM=SORT                    
//SYSOUT   DD SYSOUT=*                      
//SYSPRINT DD SYSOUT=*                      
//SORTIN   DD  DSN=USERID.TSTS.INPUT,
//             DISP=SHR                    
//SORTOUT  DD  DSN=USERID.TSTS.OUTPUT,
//             DISP=(NEW,CATLG,DELETE),    
//             SPACE=(CYL,(1,1),RLSE)
//SYSIN    DD *                                
 INREC FIELDS=(SEQNUM,6,ZD,START=25,INCR=25,1,80)
 SORT FIELDS=COPY                              
 OUTFIL FNAMES=SORTOUT,INCLUDE=(5,2,CH,EQ,C'25'),
        OUTREC=(7,80)                          
/*                                               
Or a slightly simpler approach using SPLIT:
//STEP010  EXEC PGM=SORT                    
//SYSOUT   DD SYSOUT=*                      
//SYSPRINT DD SYSOUT=*                      
//SORTIN   DD  DSN=USERID.TSTS.INPUT,
//             DISP=SHR                    
//SORTOF1  DD  DSN=USERID.TSTS.OUTPUT,
//             DISP=(NEW,CATLG,DELETE),    
//             SPACE=(CYL,(1,1),RLSE)
//SORTOF2  DD  DUMMY
//SORTOF3  DD  DUMMY
//SORTOF4  DD  DUMMY
//SYSIN    DD  *                            
 SORT FIELDS=COPY                          
 OUTFIL FILES=(1,2,3,4),SPLIT                  
//*         

JCL : Merging files

Question
"I have 2 files which have 1:1 records....so I don't need any match between them....

What I want to do is....extract a few columns from file A and a few from File B, and put them into file3. That's it.


Option1
a. Assume the record length is 80 for both files. Add seq no to both of them - say first 5 bytes is seq no.
b. SORT on SEQ NO, with these two files concatenated. Option EQUALS preferred. Now we have the records as follows 
       00001AAAAAAAAAAAAAAAAAAAAA1
       00001BBBBBBBBBBBBBBBBBBBBB1
       00002AAAAAAAAAAAAAAAAAAAAA2
       00002BBBBBBBBBBBBBBBBBBBBB2, etc    (Remember LRECL will be 85 now - SEQ no. + old 80 bytes)

c. Now SORT (COPY will do) this output into another dataset, by giving LRECL=170 instead of 85, in the input file's definition (a simple attempt to trick MVS). Now you should get the file as follows:
       00001AAAAAAAAAAAAAAAAAAAAA100001BBBBBBBBBBBBBBBBBBBBB1
       00002AAAAAAAAAAAAAAAAAAAAA200002BBBBBBBBBBBBBBBBBBBBB2, etc
d. Now you should be able to extact only the columns required, and of course remove the sequence number

Note: One more thing - for this option to work, BLKSIZE of the input file should be an EVEN multiple of the actual LRECL. Otherwise it may abend. So while creating the dataset, you can give a blocksize that is an even multiple of LRECL.

Option2:
I have two files with a key in bytes 1-3 and data in bytes 5-9.

File A has the following records: 
000 $$$$$
001 AAAAA
002 CCCCC
003 EEEEE
004 GGGGG
and File B has the following records: 
001 BBBBB
003 DDDDD
004 FFFFF
005 HHHHH
I want to join the data fields for pairs of records with the same key to get the following output: 
001 AAAAA BBBBB
003 EEEEE DDDDD
004 GGGGG FFFFF
Here's an ICETOOL job that can do it. The trick is to reformat the fields of the IN1 and IN2 files so you can do a BI SUM of the IN2 "join" fields with binary zeros in the corresponding IN1 fields. Since the reformatted IN1 file is first in the concatenation, all of its fields will be kept except those that you SUM (the "join" fields).

Note: For this example, the key and data fields are in the same locations in both files. But this same technique can be used if the key and/or data fields are in different locations in the files by reformatting the two files appropriately. 
//DFSORT  EXEC PGM=ICETOOL
//TOOLMSG  DD SYSOUT=*
//DFSMSG   DD SYSOUT=*
//IN1  DD DSN=... file 1
//IN2  DD DSN=... file 2
//TMP1 DD DSN=&&TEMP1,DISP=(,PASS),SPACE=(TRK,(5,5)),UNIT=SYSDA
//TMP2  DD DSN=&&TEMP2,DISP=(,PASS),SPACE=(TRK,(5,5)),UNIT=SYSDA
//CONCAT DD DSN=*.TMP1,VOL=REF=*.TMP1,DISP=(OLD,PASS)
//       DD DSN=*.TMP2,VOL=REF=*.TMP2,DISP=(OLD,PASS)
//TMP3  DD DSN=&&TEMP3,DISP=(,PASS),SPACE=(TRK,(5,5)),UNIT=SYSDA
//OUT   DD SYSOUT=*
//TOOLIN   DD *
* FOR THIS EXAMPLE, FIELDS (P,L) ARE AS FOLLOWS:
*   IN1:  SORT KEY - 1,3
*         FIELD1   - 5,5
*   IN2:  SORT KEY - 1,3
*         FIELD2   - 5,5
*
* WARNING: BI SUM FIELDS CAN ONLY BE 2, 4 OR 8 BYTES.
* IN THIS EXAMPLE, THE 5-BYTE FIELD2 IS PADDED TO 8 BYTES
* SO IT CAN BE SUMMED.
*
* REFORMAT THE IN1 DATA SET SO IT CAN BE JOINED
  COPY FROM(IN1) TO(TMP1) USING(CPY1)

* REFORMAT THE IN2 DATA SET SO IT CAN BE JOINED
  COPY FROM(IN2) TO(TMP2) USING(CPY2)

* SELECT ONLY RECORDS WITH MATCHING IN1/IN2 KEYS
  SELECT FROM(CONCAT) TO(TMP3) -
    ON(1,3,CH) ALLDUPS

* JOIN THE RECORDS
  SORT FROM(TMP3) USING(SRT1)
/*
//CPY1CNTL DD *
*  USE OUTREC TO CREATE: KEY FIELD1 ZEROS
 OUTREC FIELDS=(1:1,3,4:5,5,9:8Z)
//CPY2CNTL DD *
*  USE OUTREC TO CREATE: KEY FILLER FIELD2
 OUTREC FIELDS=(1:1,3,9:5,5,3Z)
/*
//SRT1CNTL DD *
*  SORT ON THE KEY AND SUM WITH BI TO JOIN FIELD2 IN EACH IN2
*  DUPLICATE RECORD WITH ZEROS IN EACH IN1 DUPLICATE RECORD.
*  ALL OF THE NON-SUMMED FIELDS FROM EACH IN1 DUPLICATE RECORD
*  WILL BE KEPT.
*  USE OUTFIL OUTREC TO REARRANGE THE FIELDS FOR FINAL OUTPUT.
 SORT FIELDS=(1,3,CH,A)
 OPTION EQUALS
 SUM FIELDS=(9,8),FORMAT=BI
 OUTFIL FNAMES=OUT,OUTREC=(1,3,X,4,5,X,9,5)
/*

COBOL - Gregorian Date to Julian

Do you know any easy ways (COBOL) to convert:

1. A Gregorian Date to Julian (20021231 ==> 2002365)
2. A Julian Date to Gregorian (2002365  ==> 20021231)


Solution 1


Here is the COBOL snippet which would serve the purpose.

IDENTIFICATION DIVISION.
PROGRAM-ID.  DATCONV.  
DATA DIVISION.

WORKING-STORAGE SECTION.                                  
01  WS-WORK-AREA.                                        
    05 MONTH-END-DD                  PIC  X(24)          
                VALUE '312831303130313130313031'.        
    05 TBL-MONTH-END         REDEFINES MONTH-END-DD.      
       10 TBL-MONTH-END-DAY  OCCURS    12 TIMES.          
          15 TBL-MONTH-END-DD        PIC  9(02).          
                                                         
    05 WS-GREG-DATE.                                      
       10 GYYY                       PIC  9(04).          
       10 MM                         PIC  9(02).        
       10 DD                         PIC  9(02).        

    05 WS-JULN-DATE.                                    
       10 JYYY                       PIC  9(04).        
       10 DOY                        PIC  9(03).        
    05 TEMP                          PIC  9(03).        
    05 I                             PIC  9(02).

PROCEDURE DIVISION.                                    
                                                       
0000-MAIN-PARA.        
** Gregorian to Julian **                                    
    ACCEPT WS-GREG-DATE                                      
    IF ( FUNCTION MOD ( GYYY, 400 ) = 0) OR          
       ( FUNCTION MOD ( GYYY, 4 ) = 0   AND          
         FUNCTION MOD ( GYYY, 100 ) NOT = 0 )        
       MOVE '29' TO MONTH-END-DD (3:2)              
    ELSE                                            
       MOVE '28' TO MONTH-END-DD (3:2)              
   END-IF
    MOVE GYYY                       TO JYYY                  
    MOVE DD                         TO DOY                  
    PERFORM ADD-MONTHDAYS                                    
        VARYING I FROM 1 BY 1                                
        UNTIL   I >= MM
    DISPLAY 'GREGORIAN DATE         : '  WS-GREG-DATE        
    DISPLAY 'JULIAN    DATE         : '  WS-JULN-DATE        

** Julian to Gregorian **                                    
    ACCEPT WS-JULN-DATE                                      
    IF ( FUNCTION MOD ( JYYY, 400 ) = 0) OR          
       ( FUNCTION MOD ( JYYY, 4 ) = 0   AND          
         FUNCTION MOD ( JYYY, 100 ) NOT = 0 )        
       MOVE '29' TO MONTH-END-DD (3:2)              
    ELSE                                            
       MOVE '28' TO MONTH-END-DD (3:2)              
   END-IF            
    MOVE JYYY                       TO GYYY                  
    MOVE DOY                        TO TEMP                  
    PERFORM SUB-MONTHDAYS                                    
        VARYING I FROM 1 BY 1                                
        UNTIL  TEMP <= TBL-MONTH-END-DD (I)            
    MOVE I                          TO MM              
    MOVE TEMP                       TO DD              
    DISPLAY 'JULIAN    DATE         : '  WS-JULN-DATE  
    DISPLAY 'GREGORIAN DATE         : '  WS-GREG-DATE  
                                                       
    STOP RUN.                                          
                                                       
ADD-MONTHDAYS.                                          
    ADD TBL-MONTH-END-DD (I)        TO DOY.            
                                                       
SUB-MONTHDAYS.                                          
    SUBTRACT TBL-MONTH-END-DD (I)   FROM TEMP. 


Solution 2


There is an easy way out also. It can be achieved by using COBOL intrinsic functions described below.

  FUNCTION                    Description
 ---------------             ---------------------------------------------
 DATE-OF-INTEGER          Gregorian date equivalent (YYYYMMDD) of integer date
 DAY-OF-INTEGER           Julian date equivalent (YYYYDDD) of integer date
 INTEGER-OF-DATE          Integer date equivalent of Gregorian date (YYYYMMDD)    
 INTEGER-OF-DAY           Integer date equivalent of Julian date(YYYYDDD)

  Here integer date is a seven-digit integer with a range from 1 to 3,067,671. (corresponding to dates ranging from January 1, 1601 through December 31, 9999).
  The Gregorian date is obtained from the calculation
               (YYYY * 10,000) + (MM * 100) + DD.
o   YYYY represents the year. It must be an integer greater than 1600, but not greater than 9999.    
o   MM represents a month and must be a positive integer less than 13.    
o   DD represents a day and must be a positive integer less than 32, provided that it is valid for the specified month and year combination.

 The returned value of INTEGER-OF-DATE/DAY functions is an integer that is the number of days the date represented by given input, succeeds December 31, 1600 in the Gregorian calendar.

  Here is the program....

IDENTIFICATION DIVISION.
PROGRAM-ID.  DDCONV.

 DATA DIVISION.                                  
                                                 
 WORKING-STORAGE SECTION.                        
 01 WS-WORK-AREA.                                
     05 WS-GREG-DATE                  PIC  9(08).
     05 WS-JULN-DATE                  PIC  9(07).
     05 WS-INT-DATE                   PIC  9(07).

 PROCEDURE DIVISION.                                          
                                                               
 0000-MAIN-PARA.                                              
     ACCEPT  WS-GREG-DATE                                      
** Gregorian To Julian **                                      
     COMPUTE WS-INT-DATE  = FUNCTION INTEGER-OF-DATE(WS-GREG-DATE)
     COMPUTE WS-JULN-DATE = FUNCTION DAY-OF-INTEGER(WS-INT-DATE)
     DISPLAY 'GREGORIAN DATE        : '  WS-GREG-DATE          
     DISPLAY 'JULIAN    DATE        : '  WS-JULN-DATE          
                                                               
     ACCEPT  WS-JULN-DATE                                      
** Julian To Gregorian **                                      
     COMPUTE WS-INT-DATE  = FUNCTION INTEGER-OF-DAY(WS-JULN-DATE)
     COMPUTE WS-GREG-DATE = FUNCTION DATE-OF-INTEGER(WS-INT-DAY)
     DISPLAY 'JULIAN    DATE        : '  WS-JULN-DATE          
     DISPLAY 'GREGORIAN DATE        : '  WS-GREG-DATE          

     STOP RUN.  

COBOL: Determining length of a string

The below code snippet explains how to find the length of a string.


Assume the field definitions are as follows :                    
                                                                     
    05 WS-STRING    PIC X(100).                                  
    05 WS-COUNT     PIC 9(4).                                      
    05 WS-LENGTH    PIC 9(4).                                      
                                                                   
a. MOVE    0 TO WS-COUNT                                            
b. INSPECT WS-STRING REPLACING ALL LOW-VALUE BY SPACE              
c. INSPECT FUNCTION REVERSE(WS-STRING)                              
          TALLYING WS-COUNT FOR LEADING SPACE                      
d. COMPUTE WS-LENGTH = LENGTH OF WS-STRING - WS-COUNT                 
                                                                     
NOTE:                                                                 
   A. Step a. above is very important, as the inspect function does not initialize the field before Tallying.                      
   B. Step b. above is optional, and may be used only if it is possible that the string contains trailing low-values, instead of spaces.                          

Easytrieve: How to delete records in KSDS file?

Here is how you can perform the Delete


Deleting a Record
-=-=-=-=-=-=-=-=-=

   You can use the WRITE statement to delete individual records from an INDEXED file.  The deleted record is the file's current input record.

            FILE KSDS INDEXED UPDATE
            %PERSNL
            FILE KEYS
            WHO 1 5 N
            JOB INPUT KEYS NAME MYPROG
              READ KSDS KEY WHO STATUS
              IF FILE-STATUS NE 0
                DISPLAY 'READ FAILED...KEY= ' WHO
                STOP
              END-IF
              WRITE KSDS DELETE STATUS
              IF FILE-STATUS NE 0
                DISPLAY 'DELETE FAILED'
                STOP
              END-IF
Similarly, here is how you can UPDATE a record

Updating a Record
=-=-=-=-=-=-=-=-=-

   You can modify and rewrite the current input record by using the WRITE statement.

            FILE KSDS INDEXED UPDATE
            %PERSNL
            FILE KEYS
            WHO      1  5 N
            PHONE    6 10 N
            JOB INPUT KEYS NAME MYPROG
              READ KSDS KEY WHO STATUS
              IF FILE-STATUS NE 0
                DISPLAY 'READ FAILED...KEY= ' WHO
                STOP
              END-IF
              MOVE PHONE TO TELEPHONE
              WRITE KSDS UPDATE STATUS
              IF FILE-STATUS NE 0
                DISPLAY 'UPDATE FAILED...KEY= ' WHO
                STOP
              END-IF

Utilities: Delete member of a PDS using JCL

Problem
Is it possible using JCL, to delete a member of a PDS, when other users are making use of the dataset ?

That is, without getting EXCLUSIVE ownership of the dataset, is it possible to delete a member from the dataset ?

The following code does not work, since IDCAMS requires exclusive access on the PDS :

//IDCAMS EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=* 
//SYSIN DD *
DELETE 'YOUR.PDS(MEMBER)'
/*


Solution
Here is how it could be done :

//IDCAMS   EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//DD1   DD DISP=SHR,DSN=YOUR.PDS
DELETE 'YOUR.PDS(MEMBER)' FILE(DD1)
/*
Note that it is NOT the DISP parameter which helps to delete the member. The option FILE is the one which deletes the member.

SORT : Convert zoned decimal to packed decimal

Problem
I am having a file in which a particular column is in Zoned decimal. In my  output I want to store the same in packed decimal. My input file length is 9(4)  and the output should be in 9(4) comp-3.  


Solution
Lets assume that both fields are not signed. Assuming the field is at the end of the record structure, all we have to do is:

//SYSIN DD *
 SORT FIELDS=COPY
 OUTREC FIELDS=(1,80,                 * First 80 bytes kept as such
                81,4,ZD,PD,LENGTH=3)  * Numeric converted to packed decimal
Note that this conversion will cause a change in record length, as 9(04) occupies 4 bytes and 9(04) COMP-3 occupies just 3 bytes. I hope that is the requirement.

Now, if you have got a signed zoned decimal, it is not as easy as this. However, Nothing is Impossible!

Copy a program from one DDIO file to another DDIO file

"I want to copy some members from an existing DDIO to a new DDIO of mine. "


Solution


If you have got Abend-aid, you could do it easily. The screens are quite self-explanatory, you can select the members you need to copy. It prepares a job for you. The step generated looks like this:
//CXUTIL    EXEC PGM=CWDDSUTL            
//STEPLIB   DD DISP=SHR,DSN=SYS3.COMPWARE.MLCX780.SLCXLOAD
//*              Could be some other library at your site...
//ABNLREPT  DD SYSOUT=*
//CWUT0001  DD  DISP=SHR,DSN=userid.TSTS.DDIO
//CWUT0002  DD  DISP=SHR,DSN=userid.TSTS.DDIO.TEMP
//ABNLPARM  DD *      
*  
* COPY FROM DDIO FILE:  userid.TSTS.DDIO
*        TO DDIO FILE:  userid.TSTS.DDIO.TEMP
*
 COPY FROMDD=CWUT0001,
   PROGRAM=B*,
   EXEC=SUMMARY,
   TODD=CWUT0002
/*
  This just copies all programs with prefix B. You can just repeat the control card if you need to copy more programs, or do the selection in the screens provided for the same.

COBOL: COPY REPLACING

I have a copybook, in which i need to change the first three characters of the variables. All the copy book variables start with M1E. I need to change it to I1E.

For eg. the variables look like this
M1ENAME PIC X(20)
M1EADD PIC X(30)

and I need it like this  

I1ENAME PIC X(20)
I1EADD PIC X(30)

The copy command I used is

copy copybook replacing ==M1E== BY ==I1E== .
But it's not working..
So what can be done?


Solution
The REPLACING option is WORD oriented not SUB-STRING oriented. If you want to do SUB-STRING replacement, you have to use colons as prefix/suffix in the copybook ( e.g. :M1E:NAME, :M1E:ADD, etc. ) and specify REPLACING ==:M1E:== by ==I1E==.

Otherwise we have to say :
REPLACING M1ENAME BY I1ENAME
         M1EADD BY I1EADD....etc 
(i.e. use the entire WORD. But this won't be feasible, when we have too many fields.)

COBOL : Concatenating of two strings

The below code snippet explains how to concatenate two strings.


Suppose we have the variables which is declared below    
                                                        
VAR1      PIC X(33) VALUE 'VALUE 1'.                    
VAR2      PIC X(33) VALUE 'VALUE 2'         
                                                        
I need to String this as 'VALUE 1*VALUE 2'
and not as 'VALUE 1                         *VALUE  2'


Solution
INSPECT FUNCTION REVERSE(VAR1)                 
         TALLYING WS-COUNT FOR LEADING SPACE. 

COMPUTE WS-LENGTH = LENGTH OF VAR1 - WS-COUNT. 
                
STRING VAR1(1:WS-LENGTH)

            '*'
      VAR2                               
      DELIMITED BY SIZE                       
      INTO WS-RESULT                            
END-STRING.          

COBOL : Difference beteen dates

Do you know any easy ways (COBOL) to find:

1. The difference between two Gregorian dates
2. The difference between two Julian dates 


Well, it is quite simple if you use COBOL instrinsic functions. Here's how you can do it:

The difference between two Gregorian dates

Working-Storage Section.
01 WS-DIFFERENCE PIC 9(08).
01 WS-DATE-1     PIC 9(08) VALUE 19981223.
01 WS-DATE-2     PIC 9(08) VALUE 19990104.
Procedure Division.
COMPUTE WS-DIFFERENCE = FUNCTION INTEGER-OF-DATE (WS-DATE-2)
                      - FUNCTION INTEGER-OF-DATE (WS-DATE-1)

The difference between two Julian dates

Working-Storage Section.
01 WS-DIFFERENCE PIC 9(08).
01 WS-DATE-1 PIC 9(07) VALUE 1998357.
01 WS-DATE-2 PIC 9(07) VALUE 1999004.
Procedure Division.
COMPUTE WS-DIFFERENCE = FUNCTION INTEGER-OF-DAY (WS-DATE-2)
                      - FUNCTION INTEGER-OF-DAY (WS-DATE-1).
 So easy, right?

Link for youtube videos from dummies.com

click on this to go to youtube vidoes from dummies.com

Easytrieve : control breaks

An AFTER-BREAK procedure is invoked following the printing of summary lines for a control break.  It can be used to produce special annotation on control reports.

   The AFTER-BREAK procedure is invoked once for each level of break. For example, assume two control fields are specified.  When the minor field causes a control break, the AFTER-BREAK procedure is invoked only once. When the major field causes a control break, AFTER-BREAK is invoked twice.

   The value of LEVEL (a system-defined field) can be used to determine which control break is being processed. TALLY (a system-defined field) contains the number of records in a particular control group.

   In the following example, the total line for the control field STATE receives special annotation.
        Statements:

         FILE FILE1
         LAST-NAME  1  5 A
         STATE      6  2 A
         ZIP        8  5 N
         PAY-NET    13 5 N 2
         JOB INPUT FILE1 NAME MYPROG
           PRINT REPORT1
         *
         REPORT REPORT1 LINESIZE 65 +
           SUMMARY  SUMCTL DTLCOPY
           SEQUENCE STATE ZIP LAST-NAME
           CONTROL  STATE ZIP
           LINE 01  LAST-NAME STATE ZIP PAY-NET
         *
         AFTER-BREAK. PROC
           IF LEVEL EQ 2
             DISPLAY 'END OF DETAILS FOR THE STATE OF ' STATE
           END-IF
         END-PROC

         Data:

        BROWNIL6007612345
         BROWNIL6007667890
         JONESIL6007709876
         JONESIL6007754321
         SMITHTX7521811111
         SMITHTX7521866666

        Results:

                      LAST-NAME   STATE    ZIP      PAY-NET

                        BROWN      IL     60076       802.35
                        JONES      IL     60077       641.97
                                   IL                1444.32
         END OF DETAILS FOR THE STATE OF IL

                        SMITH      TX     75218       777.77
                                   TX                 777.77
         END OF DETAILS FOR THE STATE OF TX
                                                     2222.09





   Similarly, a BEFORE-BREAK procedure is invoked before printing the summary lines for a control break.  For example, it can be used to calculate percentages and average totals.  These values must be calculated immediately before printing.

   The BEFORE-BREAK procedure too is invoked once for each level of break.  For example, assume two control fields are specified.  When the minor field causes a control break, the BEFORE-BREAK procedure is invoked only once. When the major field causes a control break, BEFORE-BREAK is invoked twice.

    The usage of LEVEL and TALLY too, are the same as in AFTER-BREAK.

Example: Consider the following percentage calculation, paying special attention to when and how PERCENT is calculated:
        FILE FILE1 FB(80 8000)
        LAST-NAME  1  5 A
        STATE      6  2 A
        ZIP        8  5 N
        PAY-NET   13  5 N 2
        *
        PERCENT    W  2 N 2
        TOTAL-NET  S  8 N 2
        *
        JOB INPUT FILE1 NAME MYPROG
        *
          TOTAL-NET = TOTAL-NET + PAY-NET
          PRINT REPORT1
        *
        REPORT REPORT1 LINESIZE 80 +
          SUMMARY  SUMCTL DTLCOPY
          SEQUENCE STATE ZIP LAST-NAME
          CONTROL  STATE ZIP
          LINE 01 LAST-NAME STATE ZIP PAY-NET PERCENT
        *
        BEFORE-BREAK. PROC
          PERCENT = PAY-NET * 100 / TOTAL-NET
        END-PROC

        Data:

        BROWNIL6007612345
        BROWNIL6007667890
        JONESIL6007709876
        JONESIL6007754321
        SMITHTX7521811111
        SMITHTX7521866666

        Results:

        LAST-NAME   STATE    ZIP     PAY-NET     PERCENT

          BROWN      IL     60076      802.35     36.10
          JONES      IL     60077      641.97     28.89
                     IL               1444.32     64.99

          SMITH      TX     75218      777.77     35.00
                     TX                777.77     35.00

                                      2222.09    100.00
   The BEFORE-BREAK procedure computes the percentage for each control break by multiplying the sum of PAY-NET by 100 and then dividing by TOTAL-NET.

   Note: TOTAL-NET is a static (S) working storage field summed in the JOB activity processing.

Assembler: A simple way to display the varible using WTO

The below simple trick will route the message to JESLOG


        MVC   WRITE+8(L'OUTMSG),OUTMSG  
WRITE   WTO   'THIS IS THE MSG AREA',ROUTCDE=(11)

CICS: Scrolling logic for a KSDS file

This article explains how to implement a scrolling logic for KSDS (VSAM) file. Though this article looks pretty lengthy, if you remove the comments from the logic, it will look much simpler.

Assumptions :-

There is a menu program which accepts the full or partial key thru a screen and the program validates that the key is valid and there exists at least one record in the file for the key entered. The key is passed to the program which handles the scroll logic. The number records to be displayed in the screen is 20. The screen supports only PF4, PF5, PF7 and PF8 keys. As usual PF7, PF8 keys provides scroll backward, forward mechanisms respectively. PF4 key displays first 20 matching records and PF5 displays last 20 matching records.

Implemention


01 This-programs-commarea.

   05 Control-tracking-indicator Pic X(04).

   05 Key-passed Pic X(10).

   05 Last-key PIC X(10).

   05 First-key PIC X(10).

/* populate the commarea to the working storage field */

Move Dfhcommarea to This-prgrams-commarea

/* To find out the length of the key passed, we need to count the number of spaces present at the end of the key and subtract it from the maximum size of the key. The below code does this calculation*/

Move zeros to Ws-count

Inspect function reverse(key-passed) tallying Ws-count for all leading spaces.

Ws-passed-key-length = Length of key-passed - Ws-count

/* when control comes from the menu program, the value of the control tracking indicator will be MENU, so the program can execute the logic for first time process */

If control-tracking-indicator = 'MENU'

   Perform First-time-para

Else

   Perform Subsequent-process-para

End-if

/* Send-data-only-with-no-erase is set when user is already in the first/last page and the user pressed PF7 or PPF8 key */

If Send-data-only-with-no-erase is set

   Send map with data only and no erase option

Else

   Send map with erase option

End-if

/* pass the This-programs-commarea to the Dfhcommarea, so the program can keep track of its data */

Return control to CICS with This-programs-commarea

First-time-para

/* change the value of the indicator, so the program can execute the subsequent

process para when control enters next time*/

Move "CURP" to Control-tracking-indicator

/* we need to apply scroll forward logic during the first time process. Last-key is the starting point for the scroll forward logic. So, populate the passed key to the Last-key */

Move Key-passed to Last-key

/* key length is calculated at the beginning of the program. Fill remaining positions of the key with low-values, so we can position the record pointer just prior to the first matching record */

Move Low-values to Last-key((Ws-passed-key-length+1):)

/* set Sw-PF8-key-pressed as we are going to apply scroll forward logic for first time processing */

Set Sw-PF8-key-pressed to true

Perform Main-process

Perform Populate-data-to-screen

Subsequent-process-para

Set valid-key-pressed to true

Evaluate EIBAID

  When PF4

/* We need to apply the scroll forward logic (PF8 logic) when PF4 key is pressed. Last-key is the starting point for the scroll forward logic. key length is calculated at the beginning of the program. Fill remaining positions of the key with low-values, so we can position the record pointer just prior to the first matching record. Populate appropriate message to the message field to communicate to the user that this is the first screen */

    Set Sw-PF4-key-pressed to true

    Move Key-passed to Last-key

    Move Low-values to Last-key((Ws-passed-key-length+1):)

    Move 'Top of the data reached” to message field

  When PF5

/* We need to apply the scroll backward logic (PF7 logic) when PF5 key is pressed. First-key is the starting point for the scroll backward logic. key length is calculated at the beginning of the program. Fill remaining positions of the key with high-values, so we can position the record pointer right next to the last matching record. Populate appropriate message to the message field to communicate to the user that this is the Last screen */

    Set Sw-PF5-key-pressed to true

    Move Key-passed to First-key

    Move High-values to First-key((Ws-passed-key-length+1):)

    Move 'Bottom of the data reached” to message field

  When PF7

    Set Sw-PF7-key-pressed to true

  When PF8

    Set Sw-PF8-key-pressed to true

  When other

/* when any other key is pressed, we need to communicate to the user with appropriate message. Switch Send-data-only-with-no-erase is set to not to erase the current screen, as we are supposed send the same screen with a message to inform that the user has pressed invalid key */

    Set Sw-invalid-key to true

    Populate error message to the message field

    Set Send-data-only-with-no-erase to true

End-evaluate

Move zeros to Number-of-records-processed

/* execute main-process only when valid-key-pressed is pressed */

If valid-key-pressed

   Perform Main-process

/* during PF7 processing it is possible that there are less than 20 records to display. In this situation set Sw-PF4-key-pressed to true to invoke the PF4 key processing, so, we can display first 20 matching record of the key passed and set appropriate message to inform that the user has reached the first page */

   If Number-of-records-processed > 0 and < 20 and Sw-PF7-key-pressed

      Move 'Top of the data reached” to message field

      Set Sw-PF4-key-pressed to true

      Perform Main-process

   End-if

/* During PF7 processing, it is possible that the current screen is already displaying the first matching record of the key passed.

During PF8 processing, it is possible that the current screen is already displaying the last matching record of the key passed.

In these situations Number-of-records-processed will be zeros and we will be displaying appropriate message to the user that first/page last page was reached without erasing the current detail lines in the screen. So, the below “IF” condition was introduced to not to execute the Populate-data-to-screen para in this situation */

   If Number-of-records-processed > 0

      Perform Populate-data-to-screen

   End-if

End-if

Main-process

/*

For PF7 processing, we always need to use the First record key of the current screen as the starting point.

For PF5 processing, before control comes to this para, the First-key will be populated with the Key-passed and if the key-passed is a partial key, the remaining positions will be populated with high-values so we can position the record pointer right next to the last matching record.

The Else part of the below IF condition takes care of PF8 and PF4 logic.

For PF8 processing, we always need to use the Last record key of the current screen as the starting point.

For PF4 processing, before control comes to this para, the Last-key will be populated with the Key-passed and if the key-passed is a partial key, the remaining positions will be populated with low-values so we can position the record pointer right prior to the first matching record.

*/

If Sw-PF5-key-pressed or Sw-PF7-key-pressed

   Move First-key to File-key

Else

   Move Last-key to File-key

End-if

/* Issue STARTBR against the file using the File-key with Greater than or equal to option */

STARTBR the file using File-key

/* During PF5 processing, it is possible to get record not found condition during STARTBR. Assume that the key passed from the menu program is “5555” which is partial key and the last record in the file is “5555123456”. So, the File-key will be populate with “5555......”, where “.” (dot) represents the high-values. In this case, File-key is greater than the record key of the last record present in the file. So, this will generate NOTFOUND condition. To handle this situation, entire File-key is populated with high-values and when we do STARTBR with this key, the record pointer will be positioned right next to the last record of the file and the immediate READ PREV will fetch the last record */

If EIBRESP = NOTFND

   Move High-values to File-key

   STARTBR the file using File-key

   READ PREV file, set End-of-file-reached if EIBRESP = ENDFILE

End-if

/* Process-record-para issues READ PREV during its each iteration to read the file backwards for PF7 key processing. The below extra READ PREV is issued to skip the first record of the current screen */

If EIBAID = PF7

   READ PREV file, set End-of-file-reached if EIBRESP = ENDFILE

End-if

/* Process-record-para issues READ NEXT during its each iteration to read the file in forward direction for PF8 key processing. The below extra READ NEXT is issued to skip the last record of the current screen */

If EIBAID = PF8

   READ NEXT file, set End-of-file-reached if EIBRESP = ENDFILE

End-if

Move zeros to Number-of-records-processed

Perform Process-record-para until End-of-file-reached

                               or Number-of-records-processed = 20

/* During PF7 processing, it is possible that the current screen is already displaying the first matching record of the key passed. In this situation Process-record-para will set the End-of-file-reached switch and exits out its loop and we should send the current screen without erasing it and populate a message to the screen to communicate that the user is already at the first screen.

During PF8 processing, it is possible that the current screen is already displaying the last matching record of the key passed. In this situation Process-record-para will set the End-of-file-reached switch and exits out its loop and we should send the current screen without erasing it and populate a message to the screen to communicate that the user is already at the last screen.

Switch Send-data-only-with-no-erase is set to not to erase the current screen, as we are supposed send the same screen with a message to inform that the user is in first/last page.

*/

If End-of-file-reached and number-of-records-processed = 0

   If EIBAID = PF7

      Populate 'Top of the data reached' to the message field

   Else

      Populate 'Bottom of the data reached' to the message field

   End-if

   Set Send-data-only-with-no-erase to true

End-if

Process-record-para

/* For both PF5 and PF7 processing, we need to read the file backwards.

The ELSE part in the below IF condition handles the PF8 & PF4 processing. During PF8 & PF4 processing we need to read the file in forward direction. */

If Sw-PF5-key-pressed or Sw-PF7-key-pressed

   READ PREV file, set End-of-file-reached if EIBRESP = ENDFILE

Else

   READ NEXT file, set End-of-file-reached if EIBRESP = ENDFILE

End-if

/* It is possible to reach “end of file” situation during READ NEXT/PREV. Note that READ PREV also generates “end of file” condition when it tries read past the first record of the file. So, the below “If” condition is included to confirm the successful read*/

If read prev/next is successful

/* In the case of the partial key, Ws-passed-key-length will have the length of the partial key. If full key is passed, the Ws-passed-key-length will have maximum length of the key. The below IF condition is issued to make sure we are processing the records matching the passed key. */

   If Current-record-key (1:Ws-passed-key-length)

        = Key-passed (1:Ws-passed-key-length)

/* During PF5, PF7 processing, the program is reading the file in backward direction. So, we need to populate the First-key with the current-record-key, so this can be as the starting point for the PF7 processing, if PF7 key is pressed next time. The ELSE handles the PF4 & PF8 processing and it populates the current-record-key to the Last key, so this can be used as starting point for the PF8 processing, if PF8 key is pressed next time */

      If Sw-PF5-key-pressed or Sw-PF7-key-pressed

         Move Current-record-key to First-key

      Else

         Move Current-record-key to Last-key

      End-if

/* Keep tract how many matching records are retrieved */

      
      Add 1 to Number-of-records-processed

/* We need to store the record key of the first matching record. For PF5 and PF7 processing, we read the file in backward direction. So, the first record need to be stored to that Last-key, and this can be used as starting point if PF8 key is pressed next time.

The ELSE part handles the PF4 and PF8 processing. For PF4 and PF8 processing, we read the file in forward direction. So, the first record need to be stored to that First-key, and this can be used as starting point if PF7 key is pressed next time. */

      If Number-of-records-processed = 1

         If Sw-PF5-key-pressed or Sw-PF7-key-pressed

            Move Current-record-key to Last-key

         Else

            Move Current-record-key to First-key

         End-if

      End-if

/* Store the current record in a working storage table, so this can be used to populate the detail lines in the screen */

      Store the current-record to

           the working-storage table(number-of-records-processed)

   Else

/* If there is no more matching record for the key passed, then set End-of-file-reached switch*/

     Set End-of-file-reached to true

   End-if

End if

Populate-data-to-screen

Initialize all the 20 detail lines in the screen

/* During PF5 and PF7 processing, we read the file in backward direction. The retrieved records are stored in the working storage table from the first occurrence. So, the first record from the table need to be populated to the last detail line of the screen, 2^nd record from the table need to be populated to the preceding detail line of the last detail line and so on. Thus for PF5 and PF7 processing, the records from the working storage table need to be populated to the screen in reverse order. The “ELSE” part in the below “IF” condition handles the PF4 and PF8 processing and we do not need reverse the order of the working storage table for this. */

If Sw-PF5-key-pressed or Sw-PF7-key-pressed

   Move number-of-records-processed to Ws-Init-pos

   Move -1 Ws-increment

Else

   Move 1 to Ws-Init-pos

   Move +1 Ws-increment

End-if

Move zeros to Ws-count

Perform varying WS-IX from Ws-Init-pos by Ws-increment

   until Ws-count = number-of-records-processed

   Add +1 to Ws-count

   Populate data from working-storage table (WS-IX)

         to detail line (Ws-count) of screen

End-perform