PROGRAM TAPE.TO.SEG
$INSERT COMMON
     COUNT = 0
LastUpdated... = "Rev: 12:45 09FEB89 MIS.ATM <DATA2>REP 48 Z <DATA2>REP>PROGS>TAPE.TO.SEG"
     BLOCK = ''
     CALL C.HEAD("Read Tape to Segmented File")
     ERROR = ''
     FORMATS.FILE = ''
     CALL OPEN('','FORMATS',FORMATS.FILE, ERROR)
     LOOP
        CRT @(5,4):'Enter format to use (? for list): ':
        INPUT FORMAT
     UNTIL FORMAT EQ ''OR FORMAT EQ 'END'
        IF FORMAT EQ '?' THEN
           GOSUB DISPLAY.FORMATS
           FORMAT = ''
        END ELSE
           READ FORMAT FROM FORMATS.FILE, FORMAT ELSE
              FORMAT = ''
              CRT @(0,23):'Format not found, please re-enter.':@(-4):
           END
        END
        IF FORMAT THEN
           POST.CODE = FORMAT<1>
           DEL FORMAT<1>
           ID.FORMAT = FORMAT<1>
           DEL FORMAT<1>
           LRECL = FORMAT<1,1>
           BLOCK = FORMAT<1,2>
           BLOCK.SIZE = BLOCK * LRECL
           DEL FORMAT<1>
           FORMATS = COUNT(FORMAT,@FM) + (FORMAT NE '')
           CRT @(5,5):@(-3):@(0,23):@(-4):
           GOSUB PROMPT.TAPE
           RETURN
        END
     REPEAT
     RETURN

PROMPT.TAPE:
     LOOP
        CRT @(5,6):'Enter tape unit to use: ':
        INPUT UNIT
     UNTIL UNIT EQ ''
        CALL !HUSHIT(1)
        EXECUTE 'ASSIGN MT':UNIT
        CALL !HUSHIT(0)
        IF @SYSTEM.RETURN.CODE NE 0 THEN
           CRT @(0,23):'Unable to attach MT':UNIT:', please re-enter.':@(-4):
           UNIT = ''
        END
        IF UNIT NE '' THEN
           CRT @(0,23):@(-4):
           GOSUB PROMPT.FILE.NO
           RETURN
        END
     REPEAT
     RETURN

PROMPT.FILE.NO:
     LOOP
        CRT @(5,8):'Enter File Number to Read: ':@(-4):
        INPUT FILE.NO
     UNTIL FILE.NO EQ ''
        IF FILE.NO MATCHES '1-3N' THEN
           CRT @(0,23):@(-4):
           GOSUB PROMPT.SEG
           RETURN
        END ELSE
           CRT @(0,23):'Invalid file number, please re-enter.':@(-4):
        END
     REPEAT
     RETURN

PROMPT.SEG:
     LOOP
        CRT @(5,10):'Enter Segmented File to Write to: ':
        INPUT OUT.FILE
     UNTIL OUT.FILE EQ ''
        OPEN '',OUT.FILE TO OUT.FILE.VAR ELSE
        FILE = OUT.FILE.VAR
           CRT @(0,23):"Unable to open ":OUT.FILE:", please re-enter.":@(-4):
           OUT.FILE = ''
        END
        IF OUT.FILE THEN
           GOSUB PROCESS.DATA
           RETURN
        END
     REPEAT
     RETURN

PROCESS.DATA:
     GOSUB SKIP.HEADER
     CRT "Reading data into ":OUT.FILE
     LOOP
        GOSUB READ.TAPE
        DATA(2) = ''
        GOSUB DECODE.LINE
        SKIP = 0
        CALL @POST.CODE
        IF NOT(SKIP) THEN
           WRITE DATA(2) TO OUT.FILE.VAR, CID
        END
        CRT @(10,15):CID:@(-4):
        COUNT += 1
        IF MOD(COUNT,10) EQ 0 THEN
           CRT @(10,16):COUNT:
        END
     REPEAT
     CRT @(10,16):COUNT:
     RETURN

READ.TAPE:
     IF BLOCK EQ '' THEN
        READT UNIT('1010':UNIT) BLOCK ELSE
           IF STATUS() EQ 1 OR STATUS() EQ 2 THEN
              CRT @(0,23):'Tape process complete, press return to continue: ':@(-4):
              INPUT DUMMY
              STOP
           END ELSE
              MSG = ''
              CALL TAPE.ERROR(STATUS(),MSG)
              CRT @(0,23):MSG:'  Retry ([Y]/N) ? ':@(-4):
              INPUT RETRY
              IF RETRY NE 'N' THEN
                 BLOCK = ''
                 GOTO READ.TAPE
              END ELSE
                 STOP
              END
           END
        END
        IF LEN(BLOCK) NE BLOCK.SIZE THEN
           CRT @(0,22):"Warning, block size on tape (":LEN(BLOCK):") not equal to expected block size (":BLOCK.SIZE:")":@(-4):
        END
     END
     DATA(1) = BLOCK[1,LRECL]
     BLOCK = BLOCK[LRECL+1,LEN(BLOCK)]
     RETURN

DECODE.LINE:
     CID = DATA(1)[ID.FORMAT<1,1>,ID.FORMAT<1,2>]
     FOR I = 1 TO FORMATS
        DISP = FORMAT<I,1>
        IF DISP THEN
           LENGTH = FORMAT<I,2>
           DATA(2)<I> = DATA(1)[DISP,LENGTH]
        END
     NEXT I
     RETURN

DISPLAY.FORMATS:
     CALL !HUSHIT(1)
     EXECUTE 'SELECT FORMATS BY @ID'
     CALL !HUSHIT(0)
     START = 6
     ROW = START
     COL = 10
     FS = ''
     LOOP
        READNEXT ID ELSE
           CRT FS:
           RETURN
        END
        FS := @(COL,ROW):ID
        ROW += 1
        IF ROW GT 20 THEN
           ROW = START
           COL += 20
        END
     REPEAT
     RETURN

SKIP.HEADER:
     CRT "Seeking file number ":FILE.NO
     REWIND UNIT('1010':UNIT) ELSE NULL
     FOR I = 1 TO (FILE.NO - 1)
        CRT CHAR(13):I:
        EXECUTE 'HUSH ON':@FM:'T.FWD':@FM:'HUSH OFF'
     NEXT I
     RETURN
  END