Powered By Blogger

Sunday, March 27, 2011

COBOL: Key based search on a KSDS


000100*SEARCHES FOR A SPECIFIC KSDS RECORD BASED ON AN INPUT KEY      
000200 IDENTIFICATION DIVISION.                                        
000300 PROGRAM-ID. CBLKSDS2.                                          
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 FS.                                          
001200 DATA DIVISION.                                                  
001300 FILE SECTION.                                                  
001400 FD INPUT-FILE.                                                  
001500 01 INPUT-REC.                                                  
001600     02  EMP-ID      PIC X(06).                                  
001700     02  FIRST-NAME  PIC X(20).                                  
001800     02  MIDDLE-NAME PIC X(20).                                  
001900     02  LAST-NAME   PIC X(20).                                  
002000     02  FILLER      PIC X(14).                                  
002100 WORKING-STORAGE SECTION.                                        
002200 01 FS PIC X(2).                                                
002300     88  RECORDFOUND VALUE '00'.                                
002400 01 WS-INPUT-REC.                                                
002500     02  WS-EMP-ID      PIC X(06).                              
002600     02  WS-FIRST-NAME  PIC X(20).                              
002700     02  WS-MIDDLE-NAME PIC X(20).                              
002800     02  WS-LAST-NAME   PIC X(20).                              
002900     02  FILLER         PIC X(14).                              
003000 PROCEDURE DIVISION.                                            
003100 MAINLINE SECTION.                                              
003200     OPEN INPUT INPUT-FILE.                                      
003300     DISPLAY 'ENTER EMPLOYEE ID: ' WITH NO ADVANCING.            
003400     ACCEPT EMP-ID.                                              
003410     DISPLAY 'SEARCHING FOR EMPID= ' EMP-ID.                    
003500     READ INPUT-FILE                                            
003600         KEY IS EMP-ID                                          
003700         INVALID KEY DISPLAY 'BAD EMPID GIVEN, FILE STATUS ' FS  
003800     END-READ.                                                  
003900     IF RECORDFOUND THEN                                        
004000         MOVE EMP-ID      TO WS-EMP-ID                          
004100         MOVE FIRST-NAME  TO WS-FIRST-NAME                      
004200         MOVE MIDDLE-NAME TO WS-MIDDLE-NAME                      
004300         MOVE LAST-NAME   TO WS-LAST-NAME                        
004310         DISPLAY ' '                                            
004400         DISPLAY 'EMP_ID       ' WS-EMP-ID                      
004500         DISPLAY 'FIRST_NAME   ' WS-FIRST-NAME                  
004600         DISPLAY 'MIDDLE_NAME  ' WS-MIDDLE-NAME                  
004700         DISPLAY 'LAST_NAME    ' WS-LAST-NAME                    
004900     END-IF.                                                    
005000     CLOSE INPUT-FILE.                                          
005100     STOP RUN.                                                  

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=CBLKSDS2,                
//             SRCELIB=R01029.COBOL.PGM,                
//             LOADLIB=R01029.COBOL.LOADLIB,            
//             COPYLIB1=R01029.COBOL.DCLGEN,            
//             PARM.COBOL='LIB,CODEPAGE(37)'            
//RUN##PGM EXEC PGM=CBLKSDS2                            
//READER   DD   DSN=R01029.KSDS.CLUS,DISP=SHR          
//STEPLIB  DD   DSN=R01029.COBOL.LOADLIB,DISP=SHR      
//SYSPRINT DD   SYSOUT=*                                
//SYSOUT   DD   SYSOUT=*                                
//SYSIN    DD   *                                      
051029                                                  
/*                                                      

No comments:

Post a Comment