PROGRAM EDREDIT
C
C EDR EDITTING ROUTINE
C
      CHARACTER DSN*50,ANS*1
      LOGICAL*1 REC(11280)
      INTEGER*2 RECLEN
C
C OPEN BINARY EDR INPUT DATASET
C
      WRITE(6,*)
      WRITE(6,*) '   This routine copies an user selected series'
      WRITE(6,*) '   of records based on record count.  Supply'
      WRITE(6,*) '   the record numbers of the first and last'
      WRITE(6,*) '   record of a desired record block.'
      WRITE(6,*)
      WRITE(6,*) 
      WRITE(6,*) '   ENTER EDR INPUT DSN '
      READ(5,'(Q,A)') LEN,DSN
      OPEN(50,FILE=DSN,STATUS='OLD',FORM='FORMATTED',
     &     RECORDTYPE='VARIABLE',RECL=8191,READONLY)
C
      WRITE(6,*) 
      WRITE(6,*) '   ENTER EDR OUTPUT DSN '
      READ(5,'(Q,A)') LEN,DSN
      OPEN(51,FILE=DSN,STATUS='NEW',FORM='FORMATTED',
     &     RECORDTYPE='VARIABLE',RECL=8191)
C
      WRITE(6,*)
      WRITE(6,*) '   ENTER BEGINNING SELECT RECORD'
      READ(5,*) IBEG
      WRITE(6,*)
      WRITE(6,*) '   ENTER ENDING SELECT RECORD'
      READ(5,*) IEND
      WRITE(6,*)
      WRITE(6,800) IBEG,IEND
      WRITE(6,*)
      WRITE(6,*) '   CONTINUE (Y/N)?'
      READ(5,'(A)') ANS
      IF ( ANS.NE.'Y' .AND. ANS.NE.'y' ) GOTO 100 
      NCNT = 0
      IWRITE = 0
   10 CONTINUE
       READ(50,'(Q,<RECLEN>A1)',END=100) RECLEN,(REC(I),I=1,RECLEN)
       NCNT = NCNT + 1
       IF ( NCNT.GE.IBEG .AND. NCNT.LE.IEND ) THEN
        WRITE(51,'(<RECLEN>A1)') (REC(I),I=1,RECLEN)
        IWRITE = IWRITE + 1
       END IF
      GOTO 10
  100 CONTINUE
      WRITE(6,*)
      WRITE(6,*) NCNT,' RECORDS READ'
      WRITE(6,*) IWRITE,' RECORDS WRITTEN'
      WRITE(6,*)
C
      STOP
  800 FORMAT (1X,'   EXTRACTING RECORDS ',I5,' THROUGH ',I5)
      END