Rebuild auto-expanding Sort and Direct files

!
!     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