How to read through a PDS from Cobol 1

[MrStar]

Does anybody know how I can read through all the members a PDS, and retreive then membername and some information from each member ?
An example with JCL would be nice.

I have coded Cobol for about 20 years, but newer managed to figure out how to do the above. I have always found an other solution such as converting PDS to a sequential dataset via IBM utilities.

 

[Dimandja]

Try thread209-406493

 

[MrStar]

Thanks for your answer, but that is not what I'm looking for. I know that it is possible to address ISPF from Cobol (like in Rexx), so I guess that it somehow is possible open one member at a time through ISPF.
But how ??

 

[MarcLodge]

You can write a Cobol program to access ISPF Dialog manager services which, by use of the LMINIT, LMMLIST and LMOPEN parameters which will bring each member name into a program, thereby enabling you to open each member. Have a look at thread209-436033 for an example of this type of thing, although you'll have to look up the exact parms in a manual.
Hope this helps.
Marc

 

[slade]

Hi Mr. Star,

You can access the directory of a PDS by defining it in your JCL as DSN=your.pdsname but with no member name. Specify the file DCB as RECFM=U and BLKSIZE=256.

In your COBOL pgm treat the file as an undefined sequential file. The following link shows the layout of the directory blks of a PDS. You can use these to determine all the member names in the PDS.

http://publibz.boulder.ibm.com/cgi-bin/bookmgr_OS390/BOOKS/DGT1D405/3.8.2?DT=19990106110554

If Enterprise COBOL is available in your shop you can use a new facility called "environment(al?) variables" which you can use to repeatedly open and close the same FD (that defines the PDS, not the directory) and change the member name before each OPEN. See the following link for some info:

http://publibz.boulder.ibm.com/cgi-.../IGY3LR00/4.2.3.1?DT=20011206182158#HDRIOSASE

There are techniques available to use the same FD to process more than one dataset using earlier COBOL compilers, unfortunately I don't recall where I saw them.

Maybe someone else may know. If not I'll try to hunt them down.

Regards, Jack.

 

[Crox]

Hi,

It would be nice to have such a solution with source in the FAQ. It would certainly give you some stars.

Regards,

Crox

 

[slade]

Hi Crox,

I haven't tried the environment variable trick yet, but, as you know Crox, MVSHELP has covered this topic ad nauseum.

I have traveled the DPS directory years ago but no longer have the code. No big deal; as I recall, the member name is the 1st 8 bytes in each entry, each entry contains its own length (you have to total the peices and get rid of some hi order bits in the # of user halfwords byte) and the last entry in the dir has a hi-vals (all X'FF') name.

Don't remember if a seq read of a dir blk gives you the key and data or just the data. A simple test should confirm that either way.

Regards, Jack.

 

[Crox]

Hi Jack,

True, MVSHELP has a lot. What both sides don't have is an up- and download place. A program like COBFD should be there. Also an other program that creates WORKING-STORAGE definitions based on a layout would be nice. Of course, we can MIME the files and put them in a FAQ but I am afraid that big brother Murphy doesn't like that.

Regards,

Crox

 

[MrStar]

Hi Slade
I have tried to read the directory of a PDS, but I did'nt succeed very well.
I used the parameters you wrote in my JCL, but my Cobol program refused to read anything else than 80 byte (The exact length of my pds).
I can see that th eprogram reads the directory because I could see all the member names, but nothing else. Where are the data ?

Can you give me smore detailed informations ?

Regards
Lars

 

[slade]

Hi Lars,

Can't help unless you show the pgm code and the invoking JCL. It's better to cut and paste it than to type it. Also include OS and Compiler versions and anything else you feel may be helpful.

Click the "Preview Post" button and check out how to use the "code tags". This will align the JCL and pgm code to make it more readable.

Thanx, Jack.

 

[MrStar]

Hi Jack
I have tried to red my PDS in several ways, but no matter what I do, Cobol will only accept to read my PDS as 80 bytes.
I have included the program, jcl, PDS and the result.
I hope you can help me.

Program:

     */*1**********************************************************1*/ 
      */*2**********************************************************2*/ 
      */*3**********************************************************3*/ 
      *-----------------------------------------------------------------
       identification division.                                         
      *-----------------------------------------------------------------
       program-id.               XYB0T1B0.                              
       author.                   lars kinger.                           
       date-written.             11.11.2003.                            
       date-compiled.                                                   
                                                                        
      *-----------------------------------------------------------------
      *beskrivelse:                                                     
      *                                                                 
      *   Read through a whole PDS extracting membername and some       
      *   information from some of the members.                         
      *-----------------------------------------------------------------
       environment division.                                            
      *-----------------------------------------------------------------
       configuration section.                                           
      *-----------------------------------------------------------------
       source-computer.  ibm-370.                                       
       object-computer.  ibm-370.                                       
       special-names.                                                   
           decimal-point is comma.                                      
                                                                        
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
           SELECT inpData ASSIGN TO inpData.                            
                                                                        
      *-----------------------------------------------------------------
       data division.                                                   
      *-----------------------------------------------------------------
       FILE SECTION.                                                    
       FD inpData                                                       
           BLOCK CONTAINS  256 characters                               
           RECORDING MODE IS f.                                         
       01  inpData-record.                                              
           03  inpData-rec                 pic x(080).                  
      *    03  inpData-rec                 pic x(256).                  
      *    03  inpData-rec                 pic x(001) occurs 252        
      *      depending on wInpDataLgd.                                  
      *                                                                 
      **************************************************************    
       working-storage section.                                         
      **************************************************************    
      *                                                                 
       01  ws-inpData-rec.                                              
           03 inpDataWholeRec              pic x(254).                  
                                                                        
       77  wInpDataLgd                     pic 9(008) comp.             
       01  MiscFields.                                                  
           03 wInpDataLgdDisp              pic 9(8).                    
                                                                        
       01  inpDataEofSw                    pic 9   value 0.             
           88 inpDatNotEOF                         value 0.             
           88 inpDatEOF                            value 1.             
                                                                        
      ******************************************************************
      *** Copybook needed at my installation                        ****
      *** Can be excluded. No fields are referred to.               ****
      ******************************************************************
-INC LBSLATCZ                                                           
                                                                        
                                                                        
      **************************************************************    
       procedure division.                                              
      **************************************************************    
       main.                                                            
      *                                                                 
           perform open-inpData                                         
           perform read-inpData                                         
                                                                        
           perform until inpDatEOF                                      
      *       move wInpDataLgd to wInpDataLgdDisp                       
      *       display 'Length of inputrecord=' wInpDataLgdDisp          
      *       display ws-inpData-rec(1:wInpDataLgd)                     
              display ws-inpData-rec                                    
              perform read-inpData                                      
           end-perform                                                  
           close inpData                                                
                                                                        
                                                                        
           stop run                                                     
           .                                                            
                                                                        
      *-----------------------------------------------------------------
       open-inpData.                                                    
                                                                     
           open input inpData                                           
                                                                        
           .                                                            
                                                                        
      *-----------------------------------------------------------------
       read-inpData.                                                    
                                                                        
           read inpData into ws-inpData-rec                             
             at end                                                     
                set inpDatEOF      to true                              
           end-read                                                     
                                                                        
           .                                                            
                                                                           


JCL:
//L58502S  JOB ,NOTIFY=&SYSUID,  TIME=3,                             
//            MSGCLASS=H,REGION=0M,CLASS=T,                          
//            SCHENV=EGET0                                           
/*JOBPARM S=MVSB                                                     
//*                                                                  
//*****************************************************************' 
//*****************************************************************' 
//XYB0T1B0 EXEC PGM=XYB0T1B0                                         
//STEPLIB  DD  DSN=SUPG.PROG,DISP=SHR                                
//         DD  DSN=SUPG.PROG2,DISP=SHR                               
//         DD  DSN=SUPG.PROG3,DISP=SHR                               
//         DD  DSN=SUPG.PROG4,DISP=SHR                               
//         DD  DSN=SUPG.PROG5,DISP=SHR                               
//         DD  DSN=SUPG.PROG6,DISP=SHR                               
//SYSPRINT DD SYSOUT=*                                               
//SYSUDUMP DD SYSOUT=*                                               
//INPDATA  DD DSN=L58502.TSO.CNTL,DCB=(RECFM=U,BLKSIZE=256),DISP=SHR 
//* PDS ALLOCATED AS LRECL=80,RECFM=FB,BLKSIZE=27920                 
//SYSOUT   DD SYSOUT=*,DCB=(RECFM=FBA,LRECL=256)                     

Result with hex info (with 80 bytes in program):
..AA      ...........^...^...`.`..L58502    COMPMULT...................<....L585
0FCC444444000000000025002515070700DFFFFF4444CDDDDEDE000000010022002010040200DFFF
0E11000000045F1004139F139F68191900358502000036474433041F1802133F139F000C0B003585
 -------------------------------------------------------------------------------
..LIBRUDJC........................L58502    LIBRUDJD...........&quot;...&quot;........L585
0FDCCDECDC000000010020002112080300DFFFFF4444DCCDECDC000000040027002710040400DFFF
0E3929441303BF1402138F138F160C050035850200003929441403FF1109138F138F200107003585
 -------------------------------------------------------------------------------
..LIBRX   ...............!........L58502    MCO200  ...........?...?........L585
0FDCCDE444000000010021002412030800DFFFFF4444DCDFFF44000000020026002601050300DFFF
0E39297000043F1505138F139F700A0C00358502000043620000023F1104137F137F950400003585
 -------------------------------------------------------------------------------
..PRINT   ...............&quot;........L58502    RECV    ........................L585
0FDDCDE444000000010001000711010000DFFFFF4444DCCE4444000000050001000115010100DFFF
0E79953000015F1405135F139F09040F0035850200009535000000CF1003135F135F540000003585
 -------------------------------------------------------------------------------
..REXXISPF........................L58502    RKOMMUN ........................L585
0FDCEECEDC000000000021002111030100DFFFFF4444DDDDDED4001000040002000212030300DFFF
0E95779276039F1208138F138F060B0F00358502000092644450002F1106135F135F490B0B003585
 -------------------------------------------------------------------------------
..USCOPY  ...............&quot;........L58502    XYB0T1B0...........^...^........L585
0FEECDDE44000001050029002714010100DFFFFF4444EECFEFCF000000020035003501010100DFFF
0E42367800048F1203135F139F780A0400358502000078203120053F1101131F131F940302003585

PDS: (only the first part)
AA                      377  2003/10/22  2003/10/22 16:58:04  L58502 
COMPMULT                 76  2003/08/20  2003/10/17 10:00:12  L58502 
DSNTEP2                  21  2003/02/21  2003/02/21 11:05:21  L58502 
JCB00389                 41  2003/08/11  2003/08/11 15:19:57  L58502 
JCO00910                 22  2003/05/14  2003/05/14 17:40:11  L58502 
KNBSGBX3                 78  2003/04/07  2003/06/24 17:14:03  L58502 
LIBRUDJC                140  2003/10/07  2003/10/08 11:26:12  L58502 
LIBRUDJD                 65  2003/10/14  2003/10/14 12:00:49  L58502 
LIBRUDJF                 71  2003/10/07  2003/10/07 19:19:44  L58502 
LIBRUDJG                 53  2003/10/07  2003/10/07 18:38:07  L58502 
LIBRUDTR                 49  2003/09/17  2003/10/08 11:52:02  L58502 
LIBRUDT2                226  2003/09/25  2003/09/25 18:10:47  L58502 
LIBRX                    58  2003/10/08  2003/10/21 17:20:15  L58502 
MCO200                   84  2003/10/03  2003/10/03 09:15:24  L58502 
MCO300                  114  2003/10/03  2003/10/03 09:18:13  L58502 
MCS200                   65  2003/10/03  2003/10/03 09:19:25  L58502 
MCS300                   83  2003/10/03  2003/10/03 09:20:43  L58502 
MC800                    66  2003/10/03  2003/10/03 10:52:26  L58502 
PRINT                    20  2003/02/20  2003/04/07 10:19:15  L58502 
RECV                     16  2003/02/20  2003/02/20 15:54:53  L58502 
REFORBHO                 59  2003/03/12  2003/03/13 15:56:05  L58502 
REJERLAV                 59  2003/02/20  2003/02/21 14:34:21  L58502 
REJERSYN                 59  2003/02/21  2003/02/21 11:45:57  L58502 
REXX                     31  2003/10/07  2003/10/07 16:52:59  L58502 
REXXISPF                 59  2003/10/08  2003/10/08 10:16:08  L58502 
RKOMMUN                  59  2003/02/21  2003/02/21 14:29:46  L58502 
RPOSTKNV                 59  2003/02/21  2003/02/21 15:10:41  L58502

 

[slade]

Hi Lars,

The corrected code is contained below. The recording mode is U; the rec len is 256. There are no cntl chars (RDW/BDW) in the rec. It’s all data. Give this a try.

Remember you need 2 DD/FD stmts. One for the directory (256); one for the members (80). You have to use the “environment variable” approach to get at the member data.

BTW, what version of COBOL are you using?

Regards, Jack.

FILE SECTION. 
FD inpData 
BLOCK CONTAINS 256 characters 
RECORDING MODE IS U. 
01 inpData-record     pic x(256).  

************************************************************** 
working-storage section. 
************************************************************** 
* 
01 ws-inpData-rec. 
03 inpDataWholeRec pic x(256).

 

[MrStar]

Hi Jack
I have just tried to read with the length of 256, and if I also put 256 in my jcl, I can read the whole directory.
But how do I get the data, and what do you mean by another fd to the member data ?
What name shall I put i my jcl for the socond dataset, and how do i position in this dataset.
What do you mean by 'environment variable' approach ?

As I write earlier, it is totally new for me to read PDS in this way.

Lars

 

[slade]

Hi Lars,

The 2nd link of my 1st post will explain a bit about "environment variables". You haven't let us know what compilers you have available at your shop. This will dictate whether or not you can use the "environment variable" approach.

Here's how the directory read and the member read routines connect:

For every member name you find in the directory you have to perform a routine that reads the PDS data for that member. The 2nd FD defines the member you must read. You use an "environment variable" (I'll call it an EV from now on) with this FD because you must change the member name of the DSN for every member you process. The logic goes something like this:

open the PDS directory FD
get a member name from the directory
change the member name in the EV of the PDS data FD
open the member data FD
read and process the member data until EOF
close the member data FD
repeat until EOF on directory FD
close the PDS directory FD

Regards, Jack.

 

[MrStar]

I'm working with IBM Enterprise COBOL for z/OS and OS/390 3.2.0.
OK, now I understand what you are saying. I have to use 'dynamic alloction' of each member in my pds.
I thought that this only was an option if it's Cobol on a PC.
I think I have an example of using dynamic allocation somewhere at home.

First I thought that I should use a pointer from the directory to find the members data on the diskdrive. That's why I was confused.

 

[MrStar]

Hi again
I have now solved my problem.
I have coded a program that reads all records in the directory and extract all the member names.
For each member name I use the new ENVIR feature to open it, and read all the records it contains.

I have tried to include the program here and as a FAQ, but I got a timeout from tek-tips.
If you can tell me how to do it, I will publish my program.

Thanks to slade for pointing me in the right direction.

 

[slade]

Hi Lars,

Sorry I couldn't ans sooner; couldn't make contact w/Tech-Tips till now.

Happy to hear you were successful!

Till you figure out the FAQ thing, you can try cut & pasting the code to your post and send it.

Regards, Jack.

 

[WMK]

I *strongly* suggest that anyone attempting to use the
Recording Mode U
solution CAREFULLY read:

"Change in file handling for COBOL programs with RECORDING MODE U under OS/390, Version 2 Release 10"

at:

http://publibz.boulder.ibm.com/cgi-bin/bookmgr_OS390/BOOKS/IGY3MG10/3.5.3

I don't know whether that "approach" will or will NOT work under LE for OS/390 V2R10 or latter - but I sure think you need to understand what you are doing if you try it (and possible future migration problems).

Bill Klein

 

[slade]

Bill,

There shouldn't be a problem in this case since:

The JCL recfm and the pgm recording mode both should specify U.

The pgm READ should retrieve a directory blk and pgm logic should extract the multiple member names in each blk.

Jack

 

[MrStar]

I don't know what went wrong, but Tek-Tips did'nt receive the whole program.
I try again.

*/*1**********************************************************1*/ 
*/*2**********************************************************2*/ 
*/*3**********************************************************3*/ 
*-----------------------------------------------------------------
 identification division.

*-----------------------------------------------------------------
 program-id.               XYB0T1B0.                              
 author.                   lars kinger.                           
 date-written.             11.11.2003.                            
 date-compiled.                                                   
                                                                  
*-----------------------------------------------------------------
*Description:                                                     
*   Reads the directory of a PDS.                                 
*   For each member in the directory the program opens the member 
*   and read all records in it.                                   
*                                                                 
*   The program uses the new ENVIR variable i Cobol Enterprise    
*   to make dynamic allocation of members in input PDS.           
*                                                                 
* JCL used to run this program:                                   
* //L58502S  JOB ,NOTIFY=&SYSUID,  TIME=3,                        
* //            MSGCLASS=H,REGION=0M,CLASS=T,SCHENV=EGET0         
* /*JOBPARM S=MVSB                                                
* //*                                                             
* //XYB0T1B0 EXEC PGM=XYB0T1B0,                                   
* //       PARM=('/ENVAR ("DYNFILE=DSN(X.X) SHR")')               
* //STEPLIB  DD  DSN=SUPG.PROG,DISP=SHR                           
* //         DD  DSN=SUPG.PROG2,DISP=SHR                          
* //         DD  DSN=SUPG.PROG3,DISP=SHR                          
* //         DD  DSN=SUPG.PROG4,DISP=SHR                          
* //         DD  DSN=SUPG.PROG5,DISP=SHR                          
* //         DD  DSN=SUPG.PROG6,DISP=SHR                          
* //SYSPRINT DD SYSOUT=*                                          
* //SYSUDUMP DD SYSOUT=*                                          
* //DIRDATA  DD DSN=L58502.TSO.CNTL,DISP=SHR,                     
* //            DCB=(RECFM=U,BLKSIZE=256,LRECL=256)               
* //SYSOUT   DD SYSOUT=*,DCB=(RECFM=FBA,LRECL=256)                
* //SYSIN    DD *                                                 
* L58502.TSO.CNTL                                                 
* //*                                                             
*-----------------------------------------------------------------
 environment division.                                            
*-----------------------------------------------------------------
 configuration section.                                           
*-----------------------------------------------------------------
 source-computer.  ibm-370.                                       
 object-computer.  ibm-370.                                       
 special-names.                                                   
     decimal-point is comma.                                      
                                                                  
 input-output section.                                            
 file-control.                                                    
     select directoryData assign to dirData.                      
     select memberData    assign to DYNFILE                       
                                 file status is memberDataStatus. 
                                                                  
*-----------------------------------------------------------------
 data division.                                                   
*-----------------------------------------------------------------
 file section.                                                    
 fd directoryData                                                 
     record contains 256                                          
     recording mode is U.                                         
 01  directoryData-record            pic x(256).                  
                                                                  
 fd  memberData                                                   
     recording mode F                                             
     block contains 0 records                                     
     label record is standard.                                    
 01  memberData-record               pic X(080).                  
                                                                  
**************************************************************    
 working-storage section.                                         
**************************************************************    
*                                                                 
 01  ws-DirectoryData-rec.                                        
     02  DirectoryData-rec.                                       
      03  DirectoryDataLgd          pic s9(04) comp.              
      03  DirectoryDataOccurs occurs 6 times.                     
       05  DirectoryDataName        pic  x(08).                   
       05  filler                   pic  x(04).                   
       05  vv                       pic  x(01).                   
       05  mm                       pic  x(01).                   
       05  filler                   pic  x(01).                   
       05  SecChanged               pic  x(01).                   
       05  DteCreate                pic  x(04).                   
       05  DteChanged               pic  x(04).                   
       05  TimeChangedH             pic  x(01).                   
       05  TimeChangedM             pic  x(01).                   
       05  MemberSize               pic s9(04) comp.              
       05  MemberInit               pic s9(04) comp.              
       05  filler                   pic  x(02).                   
       05  MemberUser               pic  x(10).                   
                                                                  
 01  ws-memberData-rec.                                           
     02  memberData-rec             pic  x(80).                   
                                                                  
                                                                  
 01 bitByteWorkAreas.                                             
    03 charWork.                                                  
       05 char1                     pic  x(01).                   
       05 char2                     pic  x(01).                   
    03 binWork redefines charWork   pic S9(04) binary.            
                                                                  
    03 bitNo                        pic S9(04) binary.            
    03 J                            pic S9(04) binary.            
    03 firstHalfByteValue           pic  9(02).                   
    03 secondHalfByteValue          pic  9(02).                   
                                                                  
    03 oneByte                      pic  x(01).                   
    03 SingleBits-tbl.                                            
       05 SingleBits                pic  9(01) occurs 8.          
                                                                  
                                                                  
 01  MiscFields.                                                  
     03 ix                          pic s9(08) comp.              
     03 memberDataStatus            pic  9(02) display.           
     03 note9dm                     pic  x(08).                   
     03 wDispfelt01                 pic  9(02).                   
     03 wDispfelt02                 pic  9(04).                   
     03 wVVdotMM.                                                 
        05 wVV                      pic  9(02).                   
        05 filler                   pic  x(01) value '.'.         
        05 wMM                      pic  9(02).                   
     03 wChangeTime.                                              
        05 wHour                    pic  9(02).                   
        05 filler                   pic  x(01) value ':'.         
        05 wMin                     pic  9(02).                   
        05 filler                   pic  x(01) value ':'.         
        05 wSec                     pic  9(02).                   
     03 wDirectoryDataName          pic  x(08).                   
     03 wMemberSize                 pic s9(04) comp.              
     03 wMemberInit                 pic s9(04) comp.              
     03 wMemberUser                 pic x(10).                    
                                                                  
*  Workareas for filehandling.                                    
 01  directoryDataEofSw             pic  9(01) value 0.           
     88 directoryDataNotEOF                    value 0.           
     88 directoryDataEOF                       value 1.           
 01  memberDataEofSw                pic  9(01) value 0.           
     88 memberDataNotEOF                       value 0.           
     88 memberDataEOF                          value 1.           
                                                                  
* Workareas used for dynamic allocation of pds                    
 01  dynAllocationWork.                                           
     03 extractPDS                  pic  X(300).                  
     03 statusMessage               pic  X(120).                  
     03 sourcelibr                  pic  X(045).                  
     03 memberName                  pic  X(008).                  
     03 RC                          pic  9(009) binary.           
     03 RC-EDIT                     pic  ------9.                 
     03 extractPDS-PTR              pointer.                      
                                                                  
******************************************************************
*** Installation specific copybook.                           ****
*** Can be excluded. No fields are referred to.               ****
******************************************************************
BSLATCZ                                                           
                                                                  
                                                                  
**************************************************************    
 procedure division.                                              
**************************************************************    
 main.                                                            
     accept sourcelibr    from sysin                              
                                                                  
     perform openDirectoryData                                    
     perform readDirectoryData                                    
                                                                  
     perform until directoryDataEOF                               
*       display ws-DirectoryData-rec                              
        perform readThroughPDSMembers                             
        perform readDirectoryData                                 
     end-perform                                                  
                                                                  
     close directoryData                                          
     perform StopProgram                                          
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 StopProgram.                                                     
                                                                  
     stop run                                                     
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 readThroughPDSMembers.                                           
                                                                  
     perform until directoryDataEOF                               
        display ws-DirectoryData-rec                              
                                                                  
        perform varying tally from 1 by 1                         
                  until tally > 6 or                              
                        directoryDataEOF                          
                                                                  
           if directoryDataName (tally) = high-values             
              set directoryDataEOF to true                        
           else                                                   
                                                                  
              perform storeDirectoryData                          
*             perform dispDirectoryData                           
              perform extractFromMemberData                       
           end-if                                                 
        end-perform                                               
                                                                  
        perform readDirectoryData                                 
     end-perform                                                  
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 storeDirectoryData.                                              
*    Store member informations from directory in working-storage  
                                                                  
* Store membername                                                
     move DirectoryDataName (tally) to wDirectoryDataName         
                                                                  
* Store version/level of member                                   
     move vv(tally)                 to oneByte                    
     perform findBinValue                                         
     move firstHalfByteValue(2:1)   to wVV(1:1)                   
     move secondHalfByteValue(2:1)  to wVV(2:1)                   
                                                                  
     move mm(tally)                 to oneByte                    
     perform findBinValue                                         
     move firstHalfByteValue(2:1)   to wMM(1:1)                   
     move secondHalfByteValue(2:1)  to wMM(2:1)                   
                                                                  
* Store time of last change of member                             
     move TimeChangedH(tally)       to oneByte                    
     perform findBinValue                                         
     move firstHalfByteValue(2:1)   to wHour(1:1)                 
     move secondHalfByteValue(2:1)  to wHour(2:1)                 
                                                                  
     move TimeChangedM(tally)       to oneByte                    
     perform findBinValue                                         
     move firstHalfByteValue(2:1)   to wMin(1:1)                  
     move secondHalfByteValue(2:1)  to wMin(2:1)                  
                                                                  
     move SecChanged(tally)         to oneByte                    
     perform findBinValue                                         
     move firstHalfByteValue(2:1)   to wSec(1:1)                  
     move secondHalfByteValue(2:1)  to wSec(2:1)                  
                                                                  
* Store other information                                         
     move MemberSize  (tally)       to wMemberSize                
     move MemberInit  (tally)       to wMemberInit                
     move MemberUser  (tally)       to wMemberUser                
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 extractFromMemberData.                                           
*    Reads through a membername extracted form the directory      
                                                                  
     perform openMemberData                                       
     display ' '                                                  
     display 'reading ' extractPDS(1:80)                          
                                                                  
     perform readMemberData                                       
                                                                  
*    perform until memberDataEOF                                  
     perform varying ix from 1 by 1                               
               until ix > 3                                       
                  or memberDataEOF                                
                                                                  
        perform doSomethingWithMember                             
        perform readMemberData                                    
     end-perform                                                  
                                                                  
     close memberData                                             
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 doSomethingWithMember.                                           
                                                                  
* In this section you can whatever you want with the data from    
* a member.                                                       
        display ws-memberData-rec                                 
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 findBinValue.                                                    
*    Find the eight bits in one byte (1 and 0 values)             
                                                                  
     move zero         to binWork                                 
     move oneByte      to CHAR2                                   
                                                                  
     move 256          to J                                       
                                                                  
     perform varying bitNo from 1 by 1                            
               until bitNo > 8                                    
        compute J = J / 2                                         
                                                                  
        if binWork >= J then                                      
           move  1     to singleBits(bitNo)                       
           subtract J  from binWork                               
        else                                                      
           move  0     to singleBits(bitNo)                       
        end-if                                                    
     end-perform                                                  
                                                                  
     perform findHalfBytevalues                                   
*    display 'singlebits ' singleBits-tbl                         
     .                                                            
                                                                  
*-----------------------------------------------------------------
 findHalfBytevalues.                                              
                                                                  
* Find the value of the first four bits of a byte                 
     compute firstHalfByteValue =                                 
             ((singleBits(1) * 8) +                               
              (singleBits(2) * 4) +                               
              (singleBits(3) * 2) +                               
              (singleBits(4) * 1) )                               
                                                                  
* Find the value of the last four bits of a byte                  
     compute secondHalfByteValue =                                
             ((singleBits(5) * 8) +                               
              (singleBits(6) * 4) +                               
              (singleBits(7) * 2) +                               
              (singleBits(8) * 1) )                               
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 dispDirectoryData.                                               
*    Display informations from PDS directory for each member      
                                                                  
     display 'Name        ' DirectoryDataName (tally)             
     display 'vv.mm       ' wVVdotMM                              
     display 'DteCreate   ' dteCreate   (tally)                   
     display 'DteChanged  ' dteChanged  (tally)                   
     display 'ChangeTime  ' wChangeTime                           
     display 'MemberSize  ' MemberSize  (tally)                   
     display 'MemberInit  ' MemberInit  (tally)                   
     display 'MemberUser  ' MemberUser  (tally)                   
     display '------------'                                       
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 openDirectoryData.                                               
                                                                  
     open input DirectoryData                                     
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 readDirectoryData.                                               
                                                                  
     read DirectoryData into ws-DirectoryData-rec                 
       at end                                                     
          set directoryDataEOF to true                            
     end-read                                                     
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 openMemberData.                                                  
                                                                  
     perform setEnvirVariable                                     
                                                                  
     open input memberData                                        
                                                                  
     if memberDataStatus not = '00'                               
        move spaces   to statusMessage                            
                                                                  
        string 'ERROR, write to DSN '     delimited by size       
               extractPDS                 delimited by space      
               ' FAILED WITH status = '   delimited by size       
               memberDataStatus           delimited by size       
               into statusMessage                                 
        end-string                                                
                                                                  
        perform ErrorHandling                                     
     end-if                                                       
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 setEnvirVariable.                                                
                                                                  
     move wDirectoryDataName to memberName                        
     move spaces             to extractPDS                        
                                                                  
     string 'DYNFILE='         delimited by size                  
            'DSN('             delimited by size                  
            sourcelibr         delimited by space                 
            '('                delimited by size                  
            memberName         delimited by space                 
            ')) SHR'           delimited by size                  
            into extractPDS                                       
     end-string                                                   
                                                                  
*    display extractPDS(1:80)                                     
                                                                  
     set  extractPDS-PTR to address of extractPDS                 
                                                                  
     call 'PUTENV' using by value extractPDS-PTR                  
                   returning RC                                   
     if RC not = zero                                             
        move RC         to RC-EDIT                                
        move spaces     to statusMessage                          
        string 'ERROR, PUTENV FAILED WITH RC = '                  
                RC-EDIT                                           
                delimited by size                                 
                into statusMessage                                
        end-string                                                
                                                                  
        perform ErrorHandling                                     
     end-if                                                       
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 readMemberData.                                                  
                                                                  
     read memberData into ws-memberData-rec                       
       at end                                                     
          set memberDataEOF   to true                             
     end-read                                                     
                                                                  
     .                                                            
                                                                  
*-----------------------------------------------------------------
 ErrorHandling.                                                   
                                                                  
     display statusMessage                                        
     move 16          to return-code                              
                                                                  
     perform StopProgram                                          
                                                                  
     .