Código para saber numero de registos de um ficheiro indexado:

COBOL Código:
  1.  @OPTIONS NOALPHA                                                                              
  2. *****************************************************************                              
  3. *  Copyright (c) 2008 R.P.S.                                                                   
  4. *  Created      :    Jun 2008                                                                  
  5. *  Last Modified:    Jun 2008                                                                  
  6. *****************************************************************                              
  7.  IDENTIFICATION DIVISION.                                                                      
  8.  PROGRAM-ID.    RECORDCOUNT.                                                                   
  9.  AUTHOR.        Rui Pinto.                                                                     
  10. *-----------------------------------------------------------------                             
  11.  ENVIRONMENT DIVISION.                                                                         
  12.  CONFIGURATION SECTION.                                                                        
  13.  SPECIAL-NAMES.                                                                                
  14.  INPUT-OUTPUT SECTION.                                                                         
  15.  FILE-CONTROL.                                                                                 
  16.      SELECT RCFILE ASSIGN TO FICHRC                                                            
  17.         ORGANIZATION SEQUENTIAL                                                                
  18.              FILE STATUS FS-RCFILE.                                                            
  19. *-----------------------------------------------------------------                             
  20.  DATA DIVISION.                                                                                
  21.  FILE SECTION.                                                                                 
  22.  FD  RCFILE.                                                                                   
  23.  01  REGRCFILE.                                                                                
  24.      03  RCBYTE             PIC X(001).                                                        
  25. *-----------------------------------------------------------------                             
  26.  WORKING-STORAGE SECTION.                                                                      
  27.  01  FICHRC                 PIC X(256).                                                        
  28.  01  FS-RCFILE.                                                                                
  29.      03 FS-RCFILE-A         PIC X(001).                                                        
  30.      03 FS-RCFILE-B         PIC X(001).                                                        
  31.  01  CONTADOR               PIC 9(003).                                                        
  32.  01  XNRRECORDS             PIC X(004).                                                        
  33.  01  NRRECORDS REDEFINES XNRRECORDS PIC S9(009) COMP-4.                                        
  34.  LINKAGE SECTION.                                                                              
  35.  01  RC-PATHFILE           PIC X(256).                                                         
  36.  01  RC-NRRECORDS          PIC S9(009)   COMP-5.                                               
  37.  01  RC-RESULT             PIC X(001).                                                         
  38.  PROCEDURE DIVISION USING RC-PATHFILE RC-NRRECORDS RC-RESULT.                                  
  39.  MAIN SECTION.                                                                                 
  40.  MAIN-00.                                                                                      
  41.      MOVE ZERO TO RC-NRRECORDS.                                                                
  42.      MOVE LOW-VALUES TO XNRRECORDS.                                                            
  43.      MOVE "N"  TO RC-RESULT.                                                                   
  44.      IF RC-PATHFILE = SPACE GO TO MAIN-99.                                                     
  45.  MAIN-05.                                                                                      
  46.      MOVE RC-PATHFILE TO FICHRC.                                                               
  47.      OPEN INPUT RCFILE.                                                                        
  48.      IF FS-RCFILE-A NOT = "0" GO TO MAIN-90.                                                   
  49.  MAIN-10.                                                      
  50.      MOVE 0 TO CONTADOR.                                       
  51.  MAIN-20.                                                      
  52.      READ RCFILE NEXT RECORD AT END GO TO MAIN-90.             
  53.      IF CONTADOR NOT = 50 ADD 1 TO CONTADOR GO TO MAIN-20.     
  54.      MOVE RCBYTE TO XNRRECORDS(1:1).                           
  55.      MOVE 2 TO CONTADOR.                                       
  56.  MAIN-30.                                                      
  57.      READ RCFILE NEXT RECORD AT END GO TO MAIN-90.             
  58.      MOVE RCBYTE TO  XNRRECORDS(CONTADOR:1).                   
  59.      IF CONTADOR NOT = 4 ADD 1 TO CONTADOR GO TO MAIN-30.      
  60.      MOVE NRRECORDS TO RC-NRRECORDS.                           
  61.      MOVE "Y" TO RC-RESULT.                                    
  62.  MAIN-90.                                                      
  63.      CLOSE  RCFILE.                                            
  64.      MOVE "00" TO FS-RCFILE.                                   
  65.      MOVE ALL SPACE TO FICHRC.                                 
  66. *     CLOSE RCFILE.                                            
  67.  MAIN-99.                                                      
  68.  END PROGRAM RECORDCOUNT.                                      

Parâmetros a passar:

COBOL Código:
  1. CALL "RECORDCOUNT" USING RC-PATHFILE RC-NRRECORDS RC-RESULT

Input :RC-PATHFILE
Output: RC-NRRECORDS
Output: RC-RESULT

Saludos,
Rui Pinto