CLEAR
SET ESCAPE OFF
SET INTENSITY OFF
SET TALK OFF
  STORE 1 TO TELL
  STORE '      ' TO SYS:
  DO WHILE TELL = 1
  ERASE
  @ 2,5 SAY 'ENTER DATE IN "YYMMDD" FORMAT ' GET SYS:
  READ
  STORE $(SYS:,1,2) + '/' + $(SYS:,3,2) + '/' + $(SYS:,5,2) TO SYS:DATE
  IF $(SYS:DATE,1,1) <> '8' .OR. $(SYS:DATE,4,2) < '01' .OR. $(SYS:DATE,4,2);
  > '12' .OR. $(SYS:DATE,7,2) < '01' .OR. $(SYS:DATE,7,2) > '31';
  .OR. $(SYS:DATE,2,1) < '2' .OR. VAL(SYS:) < 820101
  @ 2,5 SAY 'INVALID DATE - TRY AGAIN !                               '
  DO SWAIT
  ELSE
  STORE 0 TO TELL
  ENDIF
  ENDDO
  SET DATE TO SYS:DATE
  RELEASE TELL
STORE '     ' TO SYS:
STORE T TO I:RUN
STORE F TO I:QUIT
STORE ' ' TO I:FILE
IF FILE('SYSIMP.CMD')
   ? 'YOU HAVE NOT UPDATED THIS SYSTEM WITH YOUR NEW VERSION OF SYSGEN! BYE !'
   QUIT
ENDIF
STORE 0 TO I:TRY
DO WHILE I:RUN
SELECT SECONDARY
USE SYSCHK
IF I:TRY = 3
   ERASE
   QUIT
ENDIF
GO 1
 ERASE
 @ 5,0 SAY 'SYSTEM NAMES ARE:'
 STORE 0 TO I::COL
 STORE 7 TO I::LINE
 DO WHILE .NOT. EOF
 IF TRANS:CD <> '      '
 @ I::LINE,I::COL SAY TRANS:CD
 STORE I::COL + 10 TO I::COL
 IF I::COL > 30
 STORE I::LINE + 2 TO I::LINE
 STORE 0 TO I::COL
 ENDIF
 ENDIF
 SKIP
 ENDDO
 SET INDEX TO SYSCHK
 RELEASE I::LINE , I::COL
STORE 99 TO MFUNC:NR
STORE F TO IERR
STORE I:TRY + 1 TO I:TRY
@ 0,0
ACCEPT 'ENTER SYSTEM' TO TRANCODE
STORE !(TRANCODE) TO TRANCODE
IF ( LEN(TRANCODE) <> 4 .AND. LEN(TRANCODE) <> 6 );
   .OR. ( LEN(TRANCODE) = 4 .AND. $(TRANCODE,1,4) <> 'QUIT' ) ;
   .OR. $(TRANCODE,1,6) = '      '
    STORE T TO IERR
ENDIF
IF IERR
@ 20,2 SAY 'INVALID ENTRY --- TRY AGAIN !'
DO SWAIT
ERASE
LOOP
ENDIF
IF $(TRANCODE,1,4) = 'QUIT'
   IF FILE(I:FILE)
      DELETE FILE &I:FILE
   ENDIF
 ERASE
 QUIT
ENDIF
STORE $(TRANCODE,1,6) TO RECORD
STORE RECORD + '.CMD' TO CHK:SYS
FIND &RECORD
STORE # TO SYS:NUM
IF TRANS:CD = $(TRANCODE,1,6)
IF .NOT. FILE(CHK:SYS) 
@ 10,1 SAY 'SYSTEM NOT ON DISK - HIT <RETURN> OR '
@ 11,3 SAY '- Enter "PURGE" to Remove From File ' ;
GET SYS:
READ
IF 'PURGE' = SYS:
SET INDEX TO
GO SYS:NUM
DELETE
PACK
INDEX ON TRANS:CD TO SYSCHK
STORE I:TRY - 1 TO I:TRY
ENDIF
LOOP
ENDIF
RELEASE SYS: , SYS:NUM
   SELECT PRIMARY
   RELEASE IERR , TRANCODE
   IF II:VAL = '*'
    ? 'INVALID DATA BASE STRUCTURE - RECREATE DATA BASE & REBUILD SYSTEM'
    QUIT
   ENDIF
   RELEASE I:TRY
   DO &RECORD
   STORE 0 TO I:TRY
   STORE RECORD + '.MEM' TO I:FILE
   IF FILE(I:FILE)
      DELETE FILE &I:FILE
   ENDIF
ELSE
   @ 20,2 SAY 'INVALID ENTRY --- TRY AGAIN !'
   DO SWAIT
   ERASE
ENDIF
IF I:QUIT
ERASE
STORE F TO I:RUN
ENDIF
ENDDO
USE
CLEAR
RELEASE ALL
QUIT
RETURN