Powered By Blogger

Sunday, March 27, 2011

COBOL: Displaying all records in a KSDS by iterating thru the key.


000100*DISPLAYS ALL KSDS RECORDS BY ITERATING THRU THE KEY            
000200 IDENTIFICATION DIVISION.                                        
000300 PROGRAM-ID. CBLKSDS1.                                          
000400 ENVIRONMENT DIVISION.                                          
000500 INPUT-OUTPUT SECTION.                                          
000600 FILE-CONTROL.                                                  
000700     SELECT INPUT-FILE ASSIGN TO READER                          
000800     ORGANIZATION IS INDEXED                                    
000900     ACCESS MODE IS DYNAMIC                                      
001000     RECORD KEY IS EMP-ID                                        
001100     FILE STATUS IS FILE-STATUS.                                
001200 DATA DIVISION.                                                  
001300 FILE SECTION.                                                  
001400 FD INPUT-FILE.                                                  
001500 01 INPUT-REC.                                                  
001600     88  END-OF-FILE VALUE HIGH-VALUES.                          
001700     02  EMP-ID      PIC X(06).                                  
001800     02  FIRST-NAME  PIC X(20).                                  
001900     02  MIDDLE-NAME PIC X(20).                                  
002000     02  LAST-NAME   PIC X(20).                                  
002100     02  FILLER      PIC X(14).                                  
002200 WORKING-STORAGE SECTION.                                        
002300 01 FILE-STATUS PIC X(2).                                        
002400     88  RECORDFOUND VALUE '00'.                                
002500 01 WS-INPUT-REC.                                                
002600     02  WS-EMP-ID      PIC X(06).                              
002700     02  WS-FIRST-NAME  PIC X(20).                              
002800     02  WS-MIDDLE-NAME PIC X(20).                              
002900     02  WS-LAST-NAME   PIC X(20).                              
003000     02  FILLER         PIC X(14).                              
003100 PROCEDURE DIVISION.                                            
003200 DECLARATIVES.                                                  
003300 USE-PROCEDURE SECTION.                                          
003400     USE AFTER EXCEPTION PROCEDURE ON INPUT-FILE.                
003500 COPY-PROCEDURE.                                                
003600     COPY FILESTAT.                                              
003700 END DECLARATIVES.                                              
003800 MAINLINE SECTION.                                              
003900 100-MAIN-PARA.                                                  
004000     OPEN INPUT INPUT-FILE.                                      
004100     READ INPUT-FILE NEXT RECORD                                
004200         AT END SET END-OF-FILE TO TRUE                          
004300     END-READ.                                                  
004400     PERFORM UNTIL END-OF-FILE                                  
004500         MOVE EMP-ID      TO WS-EMP-ID                          
004600         MOVE FIRST-NAME  TO WS-FIRST-NAME                      
004700         MOVE MIDDLE-NAME TO WS-MIDDLE-NAME                      
004800         MOVE LAST-NAME   TO WS-LAST-NAME                        
004900         DISPLAY 'EMP_ID       ' WS-EMP-ID                      
005000         DISPLAY 'FIRST_NAME   ' WS-FIRST-NAME                  
005100         IF WS-MIDDLE-NAME EQUAL TO SPACES THEN                  
005200             MOVE '******' TO WS-MIDDLE-NAME                    
005300         END-IF                                                  
005400         DISPLAY 'MIDDLE_NAME  ' WS-MIDDLE-NAME                  
005500         DISPLAY 'LAST_NAME    ' WS-LAST-NAME                    
005600         DISPLAY ' '                                            
005700         READ INPUT-FILE NEXT RECORD                            
005800             AT END SET END-OF-FILE TO TRUE                      
005900         END-READ                                                
006000     END-PERFORM.                                                
006100     CLOSE INPUT-FILE.                                          
006200     STOP RUN.                                                  

KSDS Declare:

//VSAMDECL JOB (1111),'VSAMDECL',CLASS=A,NOTIFY=&SYSUID
//DECLARE  EXEC PGM=IDCAMS                             
//SYSPRINT DD SYSOUT=*                                 
//SYSOUT   DD SYSOUT=*                                 
//SYSIN    DD *                                        
  DEFINE CLUSTER               -                       
  (                            -                       
  NAME('R01029.KSDS.CLUS')     -                       
  CYLINDERS(1,1)               -                       
  CONTROLINTERVALSIZE(4096)    -                       
  FREESPACE(10,20)             -                       
  KEYS(6,0)                    -                       
  RECORDSIZE(80,80)            -                       
  )                            -                       
  DATA                         -                       
  (                            -                       
  NAME('R01029.KSDS.DATA')     -                       
  )                            -                       
  INDEX                        -                       
  (                            -                       
  NAME('R01029.KSDS.INDEX')   -                        
  CONTROLINTERVALSIZE(2048)    -                       
  )                                                    
/*                                                     

JCL for PROGRAM preparation and execution

//COBOLCOM JOB (0000),'COMPILE COBOL PGM',               
//        CLASS=A,MSGCLASS=0,MSGLEVEL=(1,1),NOTIFY=R01029
//PROCLIB  JCLLIB ORDER='SYS1.ADMIN.PROCLIB'             
//COB##COM EXEC  IGYWCL,MEMBER=CBLKSDS1,                 
//             SRCELIB=R01029.COBOL.PGM,                 
//             LOADLIB=R01029.COBOL.LOADLIB,             
//             COPYLIB1=R01029.COBOL.DCLGEN,             
//             PARM.COBOL='LIB,CODEPAGE(37)'             
//RUN##PGM EXEC PGM=CBLKSDS1                             
//READER   DD   DSN=R01029.KSDS.CLUS,DISP=SHR            
//STEPLIB  DD   DSN=R01029.COBOL.LOADLIB,DISP=SHR        
//SYSPRINT DD   SYSOUT=*                                 
//SYSOUT   DD   SYSOUT=*                                 

No comments:

Post a Comment