CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC SY:ENTRY1B.FTN
CCCCC 02/03/82
CCCCC R. DAVID BARSKY
CCCCC U. C. L. A. 
CCCCC SCHOOL OF PUBLIC HEALTH 
CCCCC CENTER FOR THE HEALTH SCIENCES ROOM 71-245
CCCCC LOS ANGELES, CALIFORNIA  90024
CCCCC TEL (213) 825-9284
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE   'SY:ENTRY.CMN'
C
      INCLUDE   'SY:ENTRY.DAT'
C
      EXTERNAL  *INPAST, *CNTRLC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC   SET UP ENVIRONMENT AND FIRST SCREEN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      OPEN (UNIT=4, NAME='TI:',RECL=200, CARRIAGECONTROL='NONE')
C
CCC   ASYNCHRONOUS TRAPS:
      CALL GETADR(PRL(1), INPAST)
      CALL GETADR(PRL(3), CNTRLC)
      PRL(2) = 0
      CALL WTQIO(IOATA,4,2,,,PRL)
C
CCC   SET NOWRAP:
      CALL GETADR(PRL,TCACR)
      PRL(2) = 2
      CALL WTQIO(SFSMC,4,2,,,PRL)
C
CCC   SET BLACK BACKGROUND SCREEN:
      CALL UVT100(RM,5)
C
CCC   SET ANSI:
      CALL UVT100(ANSI,0)
C
CCC   SAVE ADDRESS AND LENGTH OF CHARAC:
      CALL GETADR(PRLC,CHARAC)
      PRLC(2) = 1
C
CCC   SAVE ADDRESS AND LENGTH OF UNDERBAR:
      CALL GETADR(PRLU,UNDERB)
      PRLU(2) = 1
C
CCC   SAVE ADDRESS AND LENGTH OF BLANK:
      CALL GETADR(PRLB,BLANK)
      PRLB(2) = 1
C
CCC   SET APPLICATION KEYPAD MODE:
      CALL UVT100(KEYPAD,1)
      KEYMOD = APP
      ASSIGN 1015 TO PF1
      ASSIGN 1016 TO PF2
      ASSIGN 1017 TO PF3
      ASSIGN 1018 TO PF4
C
CCC   SET PRINT FLAG: (NO = NOTHING PRINTED)
      PRTFLG = NO
C
CCC   SET DIRECTION FLAG:
      DIREC = FORWD
C
CCC   READ IN SCREEN FILE, QUIT IF CNTRL/Z OR INVALID SCREEN LAYOUT 
      CALL SCRINI(RC)
      IF (RC.EQ.-1) THEN
        CALL EQUIT
        CALL UVT100(CUP,1,27)
        WRITE(4,15)
   15   FORMAT('ENTRY ABORTED WITH CNTRL/Z')
        STOP
      ELSE IF (RC.EQ.-2) THEN
        CALL EQUIT
        CALL UVT100(CUP,1,10)
        WRITE(4,25) RECLEN
   25   FORMAT('TOO FEW/MANY COLUMNS (1 MIN, 510 MAX): ', I4,
     *         ' COLUMNS READ IN.')
        STOP
      END IF
C
      FLAST = NUMFLD(1)+NUMFLD(2)
C
      FILNAM(NAMLEN+4) = '.'
      FILNAM(NAMLEN+5) = 'A'
      FILNAM(NAMLEN+6) = 'T'
      FILNAM(NAMLEN+7) = 'R'
C
      LEN = (RECLEN/2)+2
C
CCC   OPEN ATTRIBUTE FILE WITH STATUS 'OLD':
      OPEN (UNIT=1, NAME=FILNAM, FORM='UNFORMATTED', STATUS='OLD',
     *      RECORDSIZE=128, RECORDTYPE='FIXED', ACCESS='DIRECT',
     *      DISP='KEEP', ERR=340)
      GOTO 350
C
CCC   ERROR OCCURED - OPEN ATTRIBUTE FILE WITH STATUS 'NEW':
  340 OPEN (UNIT=1, NAME=FILNAM, FORM='UNFORMATTED', STATUS='NEW',
     *      RECORDSIZE=128, RECORDTYPE='FIXED', ACCESS='DIRECT',
     *      DISP='KEEP')
C
      DO 345 N=1,5
        WRITE(1,REC=N) (BUFFER(CT), CT=1,RECLEN)
  345 CONTINUE
C
CCC   CALCULATE 'BUFCHR(F,2)' - THE FIELD LENGTH:
  350 DO 355 F = 2,FLAST
        BUFCHR(F-1,2) = BUFCHR(F,1) - BUFCHR(F-1,1)
  355 CONTINUE
      BUFCHR(FLAST,2) = (RECLEN - BUFCHR(FLAST,1)) + 1
C
CCC   CALCULATE 'BUFCHR(F,3)' - THE FIELD ATTRIBUTE:
      DO 365 F = 1,FLAST
        BUFCHR(F,3) = 1
  365 CONTINUE
      DO 400 N=1,3
        READ(1,REC=N) (BUFFER(CT),CT=1,RECLEN)
        DO 375 F = 1,FLAST
          TCHR = BUFFER(BUFCHR(F,1))
          IF (TCHR.EQ.'N') THEN
            TCHR = 4
          ELSE IF (TCHR.EQ.'F') THEN
            TCHR = 2
          ELSE IF (TCHR.EQ.'1' .OR. TCHR.EQ.'R') THEN
            TCHR = 1
          ELSE
            TCHR = 0
          END IF
          BUFCHR(F,3) = BUFCHR(F,3) + TCHR
  375   CONTINUE
  400 CONTINUE
C
CCC   CALCULATE 'BUFCHR(F,4 & 5)' - THE FIELD MINIMUMS / MAXIMUMS:
      READ(1,REC=4) (BUFFER(CT), CT=1,RECLEN)
      DO 450 F = 1,FLAST
        FLDBGN = BUFCHR(F,1)
        FLDLEN = BUFCHR(F,2)
        DECODE(FLDLEN,2005,BUFFER(FLDBGN))  BUFCHR(F,4)
  450 CONTINUE
      READ(1,REC=5) (BUFFER(CT), CT=1,RECLEN)
      DO 475 F = 1,FLAST
        FLDBGN = BUFCHR(F,1)
        FLDLEN = BUFCHR(F,2)
        DECODE(FLDLEN,2005,BUFFER(FLDBGN))  BUFCHR(F,5)
  475 CONTINUE
 2005 FORMAT(BN,I<FLDLEN>)
      DO 2010 CT=1,RECLEN
        BUFFER(CT) = BLANK
 2010 CONTINUE
C
CCC   CHECK MODE: CHECK   USED TO MODIFY REQUIRED, FILLED, NUMERIC,
CCC                       AND RANGE CHECK INFORMATION.
CCC               ENTER   APPENDS NEW DATA TO OLD FILE AT EXIT.
CCC               MODIFY  ALLOWS OLD DATA TO BE ALTERED AND ADDED,
CCC                       WRITES NEW FILE AT END.
C
      CALL UVT100(ED,2)
      CALL UVT100(SCA,1)
      CALL UVT100(CUP,24,2)
      WRITE(4,110)
  110 FORMAT('ENTER MODE: ')
      CALL UVT100(SCA,0)
      READ(4,1605) CMD
      CALL UVT100(ED,2)
C
      IF (CMD(1).EQ.'CH' .OR. CMD(1).EQ.'ch') THEN
        MODE = CHECK
      ELSE 
        CLOSE (UNIT=1, DISP='KEEP')
        OPEN  (UNIT=1, FORM='UNFORMATTED', STATUS='SCRATCH', 
     *         RECORDSIZE=128, RECORDTYPE='FIXED',
     *         INITIALSIZE=200, EXTENDSIZE=200, ACCESS='DIRECT')
        IF (CMD(1).EQ.'MO' .OR. CMD(1).EQ.'mo') THEN
          MODE = MODIFY
CCC       SET UP OUTPUT FILE NAME (2ND QUALIFIER OF NAME IS 'OUT')
CCC       FINAL NAME IS 'SY:AN.OUT'  ('AN' FOR ALPHA-NUMERIC)
          FILNAM(NAMLEN+4) = '.'
          FILNAM(NAMLEN+5) = 'O'
          FILNAM(NAMLEN+6) = 'U'
          FILNAM(NAMLEN+7) = 'T'
          CALL UVT100(SCA,1)
          CALL UVT100(CUP,24,2)
          WRITE(4,120) 
  120     FORMAT('READING INPUT FILE')
          CALL UVT100(SCA,5)
          CALL UVT100(CUP,24,73)
          WRITE(4,130)
  130     FORMAT('WORKING')
          CALL UVT100(CUP,24,1)
          CALL READS(BUFFER,RECLEN)
        ELSE IF (CMD(1).EQ.'EN' .OR. CMD(1).EQ.'en') THEN 
          MODE = ENTER
          LSTREC = 1
CCC       ENTER A BLANK RECORD - PREVENTS PROBLEMS...
          WRITE(1,REC=1) (BUFFER(CT), CT=1,RECLEN), OK
        ELSE
CCC       INVALID MODE: SEND MESSAGE AND ABORT
          CALL MESSGE(2,YES,NOSCR,NOCUP)
          CALL EQUIT
          STOP
        END IF
      END IF
C
CCC   WRITE OUT FIRST SCREEN:
      POSREC = 1
      NUMINP = 0
      NUMCHA = 0
      NUMDEL = 0
C
      CALL UVT100(SCA,0)
      CALL UVT100(SCA,1)
      CALL UVT100(SCA,7)
      CALL UVT100(CUP,24,1)
      CALL UVT100(EL,2)
      WRITE(4,140) 
  140 FORMAT(' LOC:     INP:     CHA:     DEL: ')
      CALL UVT100(SCA,0)
C
      CALL UVT100(CUP,24,6)
      WRITE(4,1505) POSREC
      CALL UVT100(CUP,24,15)
      WRITE(4,1505) NUMINP
      CALL UVT100(CUP,24,24)
      WRITE(4,1505) NUMCHA
      CALL UVT100(CUP,24,33)
      WRITE(4,1505) NUMDEL
C
      READ(1,REC=1) (BUFFER(CT), CT=1,RECLEN), RECTYP
      DO 150 CT = 1,RECLEN
        SAVBUF(CT) = BUFFER(CT)
  150 CONTINUE
      S = 1
      CALL SCRWRT(NOCLE,CUPTOP)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC   MAIN PROGRAM LOOP STARTS HERE:
CCC   FLAG:    SET IN INPAST (INPUT AST) - INDICATES ACTION TO TAKE.
CCC   CHARAC:  SET IN INPAST - CHARACTER READ IN.
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1001 CALL ENASTR
      CALL WAITFR(1)
      CALL DSASTR
      CALL CLREF(1)
      GOTO (1001,1002,1024,1001,1005,1001,1001,1008,1009,1001,
     *      1011,1012,1013,1014,1015,1116,1117,1118,1001,1001,
     *      1021,1022,1023,1024,1025,1026,1027,1028,1029,1030,
     *      1127,1127,1033,1034), FLAG
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                       CHARACTER INPUT
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1002 IF (C.EQ.1 .OR. SCRCOL(S,R,C).EQ.PROTEC) THEN
CCC     PROTECTED FIELD - RING BELL, DON'T MOVE CURSOR OR  CHAR:
        CALL UVT100(BEL)
      ELSE
CCC     UNPROTECTED AREA - ENTER THE CHARACTER:
        BUFFER(SCRCOL(S,R,C)) = CHARAC
        CALL WTQIO(IOWVB,4,2,,,PRLC)
        CALL UVT100(CUF,R,C)
        IF (C.EQ.1.OR.SCRCOL(S,R,C).EQ.PROTEC) CALL FNDFLD(FORWD,YES)
      END IF
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                    DELETE LAST CHARACTER
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1005 IF (C-1.EQ.1 .OR. SCRCOL(S,R,C-1).EQ.PROTEC) GOTO 1001
      CALL UVT100(CUB,R,C)
      BUFFER(SCRCOL(S,R,C)) = BLANK
      CALL WTQIO(IOWVB,4,2,,,PRLU)
      CALL UVT100(CUP,R,C)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC              ENTER RECORD AND REPAINT SCREEN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
 1009 IF (MODE.EQ.CHECK) GOTO 1001
      CALL CHECKS
      IF (ERRFLG.EQ.YES) GOTO 1001
      WRITE(1,REC=LSTREC)  (BUFFER(CT), CT=1,RECLEN), OK
      RECTYP = OK
      LSTREC = LSTREC+1
      POSREC = LSTREC
      NUMINP = NUMINP+1
      CALL UVT100(SCA,0)
      CALL UVT100(CUP,24,6)
      WRITE(4,1505) POSREC
      CALL UVT100(CUP,24,15)
      WRITE(4,1505) NUMINP
      DO 1109 CT = 1,RECLEN
        SAVBUF(CT) = BUFFER(CT)
        BUFFER(CT) = BLANK
 1109 CONTINUE
C
      IF (S.EQ.2) THEN 
        S = 1
        CALL UVT100(CUP,23,80)
        CALL UVT100(ED,1)
      END IF
      CALL SCRWRT(CLE,CUPTOP)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                       BACKSPACE KEY
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1008 IF (C-1.EQ.1 .OR. SCRCOL(S,R,C-1).EQ.PROTEC) GOTO 1001
      CALL UVT100(CUB,R,C)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                   CURSOR MOVEMENT KEYS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1011 CALL UVT100(CUU,R,C)
      GOTO 1001      
 1012 CALL UVT100(CUD,R,C)
      GOTO 1001      
 1013 CALL UVT100(CUF,R,C)
      GOTO 1001      
 1014 CALL UVT100(CUB,R,C)
      GOTO 1001      
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC            PROGRAM FUNCTION KEYS: ESC-O-P,Q,R,S 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC           1ST FIELD OF NEXT ROW:  APP KEYPAD '0'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1021 C = 79
      CALL FNDFLD(FORWD,YES)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC           FIRST FIELD OF SCREEN:  APP KEYPAD '.'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1022 R = 1
      C = 1
      CALL FNDFLD(FORWD,YES)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC        INPUT, DO NOT CLEAR SCREEN: APP KEYPAD 'ENTER'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1023 IF (MODE.EQ.CHECK) GOTO 1001
      CALL CHECKS
      IF (ERRFLG.EQ.YES) GOTO 1001
      WRITE(1,REC=LSTREC) (BUFFER(CT), CT=1,RECLEN), OK
      RECTYP = OK
      POSREC = LSTREC
      LSTREC = LSTREC+1
      NUMINP = NUMINP+1
      CALL UVT100(SCA,0)
      CALL UVT100(CUP,24,6)
      WRITE(4,1505) POSREC
      CALL UVT100(CUP,24,15)
      WRITE(4,1505) NUMINP
      DO 1123 CT = 1,RECLEN
        SAVBUF(CT) = BUFFER(CT)
 1123 CONTINUE
      C = C+1
      CALL FNDFLD(BACKWD,YES)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC            NEXT FIELD              APP KEYPAD '1'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1024 CALL FNDFLD(FORWD,YES)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC            LAST FIELD              APP KEYPAD '2'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1025 CALL FNDFLD(BACKWD,YES)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC            PRINT PRESENT SCREEN:   APP KEYPAD '3'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1026 IF (PRTFLG.EQ.NO) THEN
CCC     SET UP PRINT FILE NAME (2ND QUALIFIER OF NAME IS 'PRT')
CCC     FINAL NAME IS 'SY:AN.PRT'  ('AN' FOR ALPHA-NUMERIC)
        FILNAM(NAMLEN+4) = '.'
        FILNAM(NAMLEN+5) = 'P'
        FILNAM(NAMLEN+6) = 'R'
        FILNAM(NAMLEN+7) = 'T'
        OPEN (UNIT=3, NAME=FILNAM, FORM='FORMATTED', 
     *        DISPOSE='PRINT', RECL=132)
        PRTFLG = YES
      END IF
      CALL SCRPRT
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC            ADVANCE                 APP KEYPAD '4'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1027 DIREC = FORWD
      IF (FNDFLG.EQ.YES) CALL FIND(FIRST,BUFFER,RECLEN)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                    BACKUP   APP KEYPAD '5'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1028 DIREC = BACKWD
      IF (FNDFLG.EQ.YES) CALL FIND(FIRST,BUFFER,RECLEN)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC              TOP, BOTTOM, NEXT, OR LAST RECORD
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1127 IF (MODE.EQ.CHECK) LSTREC = 6
      IF (FLAG.EQ.TOP) THEN
        DIREC = BACKWD
      ELSE IF (FLAG.EQ.BOTTOM) THEN
        DIREC = FORWD
      END IF
C
      IF ((DIREC.EQ.FORWD.AND.(POSREC.GE.LSTREC-1.OR.LSTREC.LE.2)) .OR.
     *    (DIREC.EQ.BACKWD .AND. POSREC.EQ.1)) THEN
        CALL MESSGE(3,YES,NOSCR,CUPNM)
      ELSE
        IF (FLAG.EQ.MOVE1) THEN
          MOVENM = 1
        ELSE IF (FLAG.EQ.MOVE10) THEN
          MOVENM = 10
        ELSE
          MOVENM = 10000
        END IF
C 
        TMPPOS = POSREC + DIREC*MOVENM
        IF (TMPPOS.LT.1) THEN
          POSREC = 1
        ELSE IF (TMPPOS.GT.LSTREC-1) THEN
          POSREC = LSTREC-1
        ELSE
          POSREC = TMPPOS
        END IF
C
        READ(1,REC=POSREC) (BUFFER(CT), CT=1,RECLEN), RECTYP
        CALL UVT100(SCA,0)
        CALL UVT100(CUP,24,6)
        WRITE(4,1505) POSREC
        DO 1227 CT = 1,RECLEN
          SAVBUF(CT) = BUFFER(CT)
 1227   CONTINUE
        CALL SCRWRT(NOCLE,CUPTOP)
      END IF
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC    CLEAR SCREEN AND CANCEL CURRENT ENTRY:  APP KEYPAD '6'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1029 DO 1129 CT = 1,RECLEN
        BUFFER(CT) = BLANK
 1129 CONTINUE
      CALL SCRWRT(CLE,CUPTOP)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC              SWITCH SCREENS:       APP KEYPAD ','
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1030 IF (NUMSCR.EQ.1) THEN
        CALL MESSGE(9,YES,NOSCR,CUPNM)
      ELSE
        S = S+1
        IF (S.GT.2) S = 1
        CALL UVT100(CUP,23,80)
        CALL UVT100(ED,1)
        CALL SCRWRT(NOCLE,CUPTOP)
      END IF
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                CHANGE RECORD:   APP KEYPAD '9'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1033 IF (MODE.NE.CHECK) CALL CHECKS
      IF (ERRFLG.EQ.YES) GOTO 1001
      NUMCHA = NUMCHA+1
      WRITE(1,REC=POSREC) (BUFFER(CT), CT=1,RECLEN), CHANGD
      RECTYP = CHANGD
      CALL UVT100(SCA,0)
      CALL UVT100(CUP,24,24)
      WRITE(4,1505) NUMCHA
      DO 1133 CT = 1,RECLEN
        SAVBUF(CT) = BUFFER(CT)
 1133 CONTINUE
      CALL MESSGE(5,NO,NOSCR,CUPBF)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                RESHOW RECORD:   APP KEYPAD '-'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1034 DO 1134 CT = 1,RECLEN
        BUFFER(CT) = SAVBUF(CT)
 1134 CONTINUE
      CALL SCRWRT(NOCLE,CUPNM)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                        HELP:  PFK 2
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1016 CALL HELP
      CALL SCRWRT(NOCLE,CUPNM)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                    FIND NEXT:      PFK 3
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1017 CALL FIND(NEXT,BUFFER,RECLEN)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                             FIND
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1171 FNDFLG = YES
      DO 1173 CT = 1,RECLEN
        SAVBUF(CT) = BUFFER(CT)
        BUFFER(CT) = BLANK
 1173 CONTINUE
      CALL SCRWRT(CLE,NOCUP)
      CALL UVT100(SCA,0)
      CALL UVT100(SCA,1)
      CALL UVT100(SCA,5)
      CALL UVT100(CUP,24,40)
      WRITE(4,1175)
 1175 FORMAT(' Enter data onto screen for search.')
      CALL UVT100(SCA,0)
      R = 1
      C = 1
      CALL FNDFLD(FORWD,YES)
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC             DELETE RECORD SHOWN ON SCREEN   PFK 4
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1018 IF (MODE.EQ.CHECK)    GOTO 1001
      IF (RECTYP.NE.DELETD) THEN
        NUMDEL = NUMDEL+1
        RECTYP = DELETD
        WRITE(1,REC=POSREC) (BUFFER(CT), CT=1,RECLEN), RECTYP
        CALL UVT100(SCA,0)
        CALL UVT100(CUP,24,33)
        WRITE(4,1505) NUMDEL
        CALL SCRWRT(CLE,CUPTOP)  
      ELSE
        CALL MESSGE(15,YES,NOSCR,CUPNM)
      END IF
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                 UNDELETE RECORD:  GOLD PF4
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1181 IF (MODE.EQ.CHECK)    GOTO 1001
      IF (RECTYP.EQ.DELETD) THEN
        NUMDEL = NUMDEL-1
        RECTYP = OK
        WRITE(1,REC=POSREC) (BUFFER(CT), CT=1,RECLEN), RECTYP
        CALL UVT100(SCA,0)
        CALL UVT100(CUP,24,33)
        WRITE(4,1505) NUMDEL
        CALL SCRWRT(NOCLE,CUPTOP)
        CALL MESSGE(17,NO,NOSCR,CUPNM)
      ELSE
        CALL MESSGE(16,YES,NOSCR,CUPNM)
      END IF
      GOTO 1001
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                       PF KEY ASSIGNMENTS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1116 GOTO PF2
 1117 GOTO PF3
 1118 GOTO PF4
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                       GOLD           PF1
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 1015 IF (KEYMOD.EQ.APP) THEN
        CALL ENASTR
        CALL WAITFR(1)
        CALL DSASTR
        CALL CLREF(1)
      ELSE
        FLAG = 31
      END IF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                       GOLD FUNCTION KEYS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IF      (FLAG.EQ.17) THEN
CCC     FIND
        GOTO 1171
      ELSE IF (FLAG.EQ.18) THEN
CCC     UNDELETE
        GOTO 1181
      ELSE IF (FLAG.EQ.27) THEN
CCC     BOTTOM OF FILE
        GOTO 1127
      ELSE IF (FLAG.EQ.28) THEN
CCC     TOP OF FILE
        GOTO 1127
      ELSE IF (FLAG.EQ.31) THEN
CCC     COMMAND ENTRY:  GOLD APP 7 IN APP MODE / GOLD IN NUM MODE
        CALL UVT100(SCROLL,1,23)
        CALL UVT100(CUP,24,40)
        CALL UVT100(EL,0)
        CALL UVT100(SCA,0)
        CALL UVT100(SCA,1)
        WRITE(4,2015)
 2015   FORMAT( 'Command: ')
        CALL UVT100(SCA,0)
        CALL UVT100(SCA,7)
        READ(4,1605) CMD
        CALL UVT100(CUP,24,40)
        CALL UVT100(EL,0)
        CALL UVT100(CUP,24,1)
        CALL UVT100(SCROLL,1,24)
        CALL UVT100(SCA,0)
      END IF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCC                     PROCESS COMMANDS 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IF      (CMD(1).EQ.'EX' .OR. CMD(1).EQ.'ex') THEN
        CALL EEXIT
        STOP
      ELSE IF (CMD(1).EQ.'QU' .OR. CMD(1).EQ.'qu') THEN
        CALL EQUIT
        STOP
      ELSE IF (CMD(1).EQ.'PR' .OR. CMD(1).EQ.'pr') THEN
        GOTO 1026
      ELSE IF (CMD(1).EQ.'AD' .OR. CMD(1).EQ.'ad') THEN
        CALL UVT100(CUP,R,C)
        GOTO 1027
      ELSE IF (CMD(1).EQ.'BA' .OR. CMD(1).EQ.'ba') THEN
        CALL UVT100(CUP,R,C)
        GOTO 1028
      ELSE IF (CMD(1).EQ.'TO' .OR. CMD(1).EQ.'to') THEN
        FLAG = TOP
        GOTO 1127
      ELSE IF (CMD(1).EQ.'BO' .OR. CMD(1).EQ.'bo') THEN
        FLAG = BOTTOM
        GOTO 1127
      ELSE IF (CMD(1).EQ.'10') THEN
        FLAG = MOVE10
        GOTO 1127
      ELSE IF (CMD(1).EQ.'1')  THEN
        FLAG = MOVE1
        GOTO 1127
      ELSE IF (CMD(1).EQ.'CL' .OR. CMD(1).EQ.'cl') THEN
        GOTO 1029
      ELSE IF (CMD(1).EQ.'CH' .OR. CMD(1).EQ.'ch') THEN
        GOTO 1033
      ELSE IF (CMD(1).EQ.'RE' .OR. CMD(1).EQ.'re') THEN
        GOTO 1034
      ELSE IF (CMD(1).EQ.'HE' .OR. CMD(1).EQ.'he') THEN
        CALL UVT100(CUP,24,40)
        CALL UVT100(EL,0)
        GOTO 1016
      ELSE IF (CMD(1).EQ.'FI' .OR. CMD(1).EQ.'fi') THEN
        GOTO 1171
      ELSE IF (CMD(1).EQ.'FN' .OR. CMD(1).EQ.'fn') THEN
        GOTO 1017
      ELSE IF (CMD(1).EQ.'DE' .OR. CMD(1).EQ.'de') THEN
        GOTO 1018
      ELSE IF (CMD(1).EQ.'SW' .OR. CMD(1).EQ.'sw') THEN
        GOTO 1030
      ELSE IF (CMD(1).EQ.'UN' .OR. CMD(1).EQ.'un') THEN
        GOTO 1181
      ELSE IF (CMD(1).EQ.'NU' .OR. CMD(1).EQ.'nu') THEN
CCC     PF1:CMD, PF2:SWITCH SCR, PF3:INPUT, NO CLR, PF4:CLR
        ASSIGN 1030 TO PF2
        ASSIGN 1023 TO PF3
        ASSIGN 1029 TO PF4
        CALL UVT100(CUP,R,C)
        CALL UVT100(KEYPAD,0)
        KEYMOD = NUM
      ELSE IF (CMD(1).EQ.'AP' .OR. CMD(1).EQ.'ap') THEN
CCC     PF1:CMD, PF2:HELP, PF3:FIND, PF4:DEL REC
        ASSIGN 1016 TO PF2
        ASSIGN 1017 TO PF3
        ASSIGN 1018 TO PF4
        CALL UVT100(CUP,R,C)
        CALL UVT100(KEYPAD,1)
        KEYMOD = APP
      ELSE
CCC     INVALID COMMAND
        CALL MESSGE(8,YES,NOSCR,CUPNM)
      END IF
      GOTO 1001
C
 1505 FORMAT(I4)
 1600 FORMAT(Q, 80A1)
 1605 FORMAT(4A2)
C
      END