!                                                                             
!     This utility rebuilds Autoexepanding Sort and Direct files.             
!     This utility allows you to build a file list using *BPSD,               
!     then will rebuild all files in that list.                               
!                                                                             
00010 REM &REM&                                                               
00020 CALL"*BPSD"                      ! Create file list                     
00030 SETERR 8900                      ! Set error trap branch                
00040 FL=UNT                           ! Get next channel                     
00050 OPEN(FL)"*SR"+FID(0)             ! Open file list                       
00060 PRINT 'CS'                       ! Clear screen                         
00100 FILE$=KEY(FL,END=9999)           ! Get next file name                   
                                       ! Go quit if at end of file list       
00110 C=UNT;                           ! Get next channel                     
      OPEN(C,ERR=8840)FILE$            ! Open file                            
00115 LOCK(C,ERR=8800)                 ! File must be locked                  
00120 F$=FID(C);                       ! File info                            
      FREC$=XFD(C,10)                  ! # of recs in use                     
00130 IF F$(10,1)<>$02$ OR             ! If file not direct or sort           
         DEC(F$(12,3))<>0              ! or autoexpanding                     
         CLOSE(C);                     ! Close file                           
         READ(FL);                     ! Move file list pointer               
         GOTO 100                      ! Get next file                        
00140 IF DEC(F$(15,2))>0               ! If rec. siz > 0                      
         FT$="D"                       ! file is direct                       
      ELSE                             ! else                                 
         FT$="S"                       ! file is sort                         
00150 IF FT$="D"                       ! If file direct                       
         DIM MSG$[7];                  ! Set elements to 7                    
           MSG$[5]=STR(DEC(F$(15,2))),   ! set record size                    
         MSG$[6]=STR(DEC(F$(20,1))),   ! directory #                          
         MSG$[7]="0"                   ! sector 0                             
      ELSE                             ! else file is sort                    
         DIM MSG$[6];                  ! Set elements to 7                    
         MSG$[5]=STR(DEC(F$(20,1))),   ! directory #                          
         MSG$[6]="0"                   ! sector 0                             
      FI;                              ! Fi                                   
      MSG$[1]=FT$,                     ! Set file type                        
      MSG$[2]="**TMP"+FID(0);          ! Set file name                        
      IF DEC(FREC$)>32767              ! If # of recs > 32k                   
         MSG$[3]=STR(DEC(F$(11,1))-6)  ! Key size is fid info - 6             
      ELSE                             ! Else                                 
         MSG$[3]=STR(DEC(F$(11,1))-4)  ! Key size is fid info - 4             
      FI;                              ! Fi                                   
      MSG$[4]="0";                     ! Set # of recs (autoexpand)           
      CALL "OOU3",MSG$[ALL]            ! Create temp file                     
00160 TC=UNT;                          ! Open temp file                       
      OPEN(TC)"**TMP"+FID(0)                                                  
00165 PRINT @(5,5),'CL',"REBUILDING FILE "+FILE$                              
00170 IF FT$="D"                       ! If direct file                       
         CLEAR ERC;                    ! Clear erc flag                       
         WHILE ERC=0;                  ! While no error                       
            K$=KEY(C,ERC=1);           ! Get next key                         
            IF ERC                     ! If err                               
               IF ERR<>2               ! If not eof                           
                  EXITTO 8900          ! Goto error trap                      
               FI                      ! Fi                                   
            ELSE                       ! Else                                 
               READRECORD(C,KEY=K$)R$;    ! Read it from orig                 
               WRITERECORD(TC,KEY=K$)R$   ! Write it to temp                  
           FI;                                                                
         WEND                          ! End while                            
      ELSE                             ! Else file is sort                    
         CLEAR ERC;                    ! Clear erc flag                       
         WHILE ERC=0;                  ! While no error                       
            K$=KEY(C,ERC=1);           ! Get next key                         
            IF ERC                     ! If err                               
               IF ERR<>2               ! If not eof                           
                  EXITTO 8900          ! Goto err trap                        
               FI                      ! Fi                                   
            ELSE                       ! Else                                 
               READ(C,KEY=K$);         ! Move pointer to next key             
               WRITE(TC,KEY=K$)        ! Write key to temp                    
            FI;                        ! Fi                                   
         WEND                          ! End while                            
      FI                               ! Fi                                   
00180 CLOSE(C);                        ! Close orig file                      
      CLOSE(TC)                        ! Close temp file                      
00190 ERASE FILE$                      ! Erase orig file                      
00200 RENAME "**TMP"+FID(0), FILE$     ! Rename temp to orig                  
00210 READ(FL)                         ! Move file list pointer               
00220 GOTO 100                         ! Go get next file                     
08800 IF ERR=0                         ! Check to see if file busy            
         INPUT @(5,5),CVT(FILE$,128)+                                         
         " IS IN USE,                                                         
         PRESS F1 FOR RETRY,                                                  
         F2 TO SKIP,                                                          
         F4 TO QUIT",*                                                        
08810 IF CTL=1                         ! If F1 retry file lock                
         RETRY                                                                
      ELSE                             ! else                                 
         IF CTL=2                      ! If F2                                
           CLOSE(C);                   ! close file                           
           GOTO 210                    ! get next file                        
         ELSE                          ! else                                 
            IF CTL=4                   ! If F4                                
               GOTO 9999               ! Go quit                              
            ELSE                       ! else                                 
               GOTO 8800               ! Ask busy file question again         
            FI                                                                
         FI                                                                   
       FI                                                                     
08840    INPUT @(5,5),"AN ERROR ",     ! Err opening auto file                
         ERR," OCCURED OPENING FILE ",                                        
         CVT(FILE$,128),                                                      
         ",PRESS F2 TO SKIP OR                                                
         F4 TO QUIT",*                                                        
08850 IF CTL=2                         ! If press F2                          
         GOTO 210                      ! Go get next file                     
      ELSE                             ! Else                                 
         IF CTL=4                      ! If press F4                          
            GOTO 9999                  ! Go quit                              
         ELSE                          ! Else                                 
            GOTO 8840                  ! Ask question again                   
         FI                            ! Fi                                   
      FI                               ! Fi                                   
08900 PRINT 'CS';                      ! Clear screen                         
      PRINT "An error ",ERR,           ! Show err info                        
      " has occured at line ",                                                
      TCB(5)," of program ",                                                  
      PGN                              ! Quit                                 
09999 END