C	PROGRAM TO EDIT AN EXISTING TABLE
C
C  Submitted by:
C  
C  	R. N. Stillwell
C  	Institute for Lipid Research
C  	Baylor College of Medicine
C  	Houston, Texas 77030
C  	
C  (who would be glad to receive comments, suggestions, bug fixes, etc., but
C  who promises no support whatever).
C  
C  Literature reference:
C  
C  	R. N. Stillwell.  A low-overhead laboratory data management system
C  	for the PDP11.  Comput. Biomed. Res., 15, 29-38(1982).
C  
C  Acknowledgement:
C
C  	This software was developed under National Institutes of Health grants
C  	GM-13901 and GM-26611.
C 
C  General permission is hereby granted to copy, modify, or distribute this
C  program, but not for profit.  Copyright to this software is and shall
C  remain in the public domain.
C
	OPEN-THE-TABLE
	GET-STARTING-RECORD-NUMBER
	EDIT-THE-TABLE
	STOP
	TO OPEN-THE-TABLE
C
	COMMON/TABX/HEAD1,HEAD2,IPTRH1,IPTRH2,IPTRD,
	1 LEN,OFFSET,PREF,ZERO1,ZERO2
C
	BYTE HEAD1(1000),HEAD2(1000)
	BYTE ZERO1(10),ZERO2(10)!ZERO-TH COLUMN HEADERS
	INTEGER OFFSET
	BYTE PREF(6)		!TABLE PREFIX CONTAINING '-' AND NULLS
	INTEGER LEN(40)		!LENGTH OF COLUMN I
	INTEGER IPTRH1(41)	!POINTER TO START OF HEAD1(I)
	INTEGER IPTRH2(41)	!POINTER TO START OF HEAD2(I)
	INTEGER IPTRD(41)	!POINTER TO START OF DATA FOR COL. I
	DATA MAXCOL/40/		!MAX. NUMBER OF COLUMNS
	DATA MAXLEN/1000/	!MAX. LENGTH OF DATA FOR EACH RECORD
	DATA MAXHD/1000/	!MAX. LENGTH OF HEAD1,HEAD2
C
	BYTE DEL(6)
	DATA DEL/'D','E','L','E','T','E'/
	LOGICAL*1 HEDOES,REPLY(5),EQUAL,OK,BAD
C
C
	COMMON/TITL/ LENTL,TITLE,LENSTL,SUBTL
C
	BYTE TITLE(80),SUBTL(80)
C
	BYTE FILNAM(15),TABNAM(10),DATA(1000)
	BYTE INDATA(255),SP
	EQUIVALENCE (FILNAM,TABNAM)
	CALL GETNAM(FILNAM,10)
	CALL OPNTAB(FILNAM,NREC,LENREC,NCOL,IERR)
D	WRITE (5,9905) LENREC,NREC,OFFSET,NCOL
D9905	FORMAT (' LENREC,NREC,OFFSET: ',4I8)
	IF (NREC.GT.0) CHECK-LAST-RECORD
	FIN
C
	TO GET-STARTING-RECORD-NUMBER
	REPEAT UNTIL (OK)
	WRITE (5,30)
30	FORMAT ('$START EDITING AT ROW (<CR> FOR ADD TO TABLE): ')
	READ (5,31) LENR,IROW
31	FORMAT (Q,I5)
	IROW=IROW-OFFSET
	OK = .TRUE.
	CONDITIONAL
	(LENR.EQ.0) IROW = NREC+1
	(IROW.LE.0)
	WRITE (5,33) OFFSET+1
33	FORMAT (' THIS TABLE STARTS AT RECORD #',I5)
	OK = .FALSE.
	FIN
	(IROW.GT.NREC+1)
	WRITE (5,32) NREC+OFFSET
32	FORMAT (' THIS TABLE HAS ONLY',I4,' ROWS.')
	OK = .FALSE.
	FIN
	FIN
	FIN
D	WRITE (5,9907) IROW
D9907	FORMAT (' IROW = ',I4)
	FIN
	TO EDIT-THE-TABLE
	WRITE (5,15)
15	FORMAT (' TYPE <CR> TO LEAVE DATA UNCHANGED;'/
	1       '      >    TO GO TO NEXT RECORD;'/
	1       '      >n   TO GO TO RECORD n;'/
	1       '      <    TO BACK UP ONE RECORD;'/
	1       '      @n   TO GO TO COLUMN n;'/
	1 '  "DELETE" TO DELETE THIS RECORD (COLUMN 1, LAST ROW ONLY);'/
	1       '     CTL-Z WHEN DONE ENTERING.'/)
	BYTE ENDIT,CHNGED
	ENDIT = .FALSE.
	REPEAT UNTIL (ENDIT)
	CHNGED = .FALSE.
	GET-A-RECORD
	IF (CHNGED) WRITE-A-RECORD
	IROW = IROW+1
	FIN
	FIN
	TO GET-A-RECORD
	IREC = IROW
	CONDITIONAL
	(NREC.EQ.0) 
	DO (I=1,LENREC) DATA(I) = ' '
	FIN
	(IREC.LE.NREC) READ-TABLE-RECORD
	(OTHERWISE) 
	DO (I=1,LENREC) DATA(I) = ' '
	FIN
	FIN
	ICOL = 1
	WHILE (ICOL.LE.NCOL)
	REPEAT UNTIL (OK)
	WHEN (IREC.LE.NREC) SHOW-HEADER-AND-DATA
	ELSE SHOW-HEADER
	READ (5,21,END=50) LDATA,INDATA
21	FORMAT (Q,255A1)
	OK = .TRUE.
	I = 1
	WHILE (I.LE.LDATA.AND.OK)
	OK = INDATA(I).GE."40
	I = I+1
	FIN
	CONDITIONAL
	(.NOT. OK)
	WRITE (5,200)
200	FORMAT (' PLEASE RE-ENTER.')
	FIN
	(ICOL.EQ.1.AND.EQUAL(INDATA,DEL,6))
	WHEN (IREC.EQ.NREC)
	CONFIRM-DELETE-LAST-ROW
	IF (HEDOES)
	DO (I=1,6) DATA(I) = DEL(I)
	WRITE-A-RECORD
	NREC=NREC-1
	WRITE-HEADER
	FIN
	ICOL=0
	FIN
	ELSE
	WRITE (5,29)
29	FORMAT (' This is not the last row of the table.')
	OK = .FALSE.
	FIN
	FIN
	(LDATA .GT. (IPTRD(ICOL+1)-IPTRD(ICOL)) )
	WRITE (5,24) IPTRD(ICOL+1)-IPTRD(ICOL)
24	FORMAT (' ENTRY IS LONGER THAN',I4,' CHARACTERS.')
	OK = .FALSE.
	FIN
	(LDATA.EQ.1.AND.INDATA(1).EQ.'<')
	IROW = MAX0(IROW-2,0)
	ICOL = NCOL
	FIN
	(LDATA.EQ.1.AND.INDATA(1).EQ.'>')
	IROW = MIN0(NREC,IROW)
	ICOL = NCOL
	FIN
	(LDATA.GT.1.AND.INDATA(1).EQ.'>')
	DECODE (LDATA-1,201,INDATA(2),ERR=210) LROW
	LROW = LROW-OFFSET
	WHEN (LROW.LT.1.OR.LROW.GT.NREC+1)
	WRITE (5,204)
204	FORMAT (' NO SUCH ROW.')
	OK = .FALSE.
	FIN
	ELSE
	ICOL = NCOL
	IROW = LROW-1
	FIN
	FIN
	(LDATA.GT.0.AND.INDATA(1).EQ.'@')
	DECODE (LDATA-1,201,INDATA(2),ERR=210) LCOL
201	FORMAT (I7)
	WHEN (LCOL.LT.1.OR.LCOL.GT.NCOL)
	WRITE (5,202)
202	FORMAT (' NO SUCH COLUMN.')
	OK = .FALSE.
	FIN
	ELSE ICOL = LCOL-1
	FIN
	(LDATA.GT.0)
	DO (I=1,IPTRD(ICOL+1)-IPTRD(ICOL))
	DATA(IPTRD(ICOL)+I-1) = INDATA(I)
	FIN
	CHNGED = .TRUE.
	FIN
	(.FALSE.)
210	OK = .FALSE.
	FIN
	FIN
	FIN
	ICOL = ICOL+1
	FIN
	IF (.FALSE.)
50	ENDIT = .TRUE.
	FIN
	FIN
	TO SHOW-HEADER
	WRITE (5,20) PREF,IROW+OFFSET,ICOL,
	1 (HEAD1(J),J=IPTRH1(ICOL),IPTRH1(ICOL+1)-1),SP,
	1 (HEAD2(J),J=IPTRH2(ICOL),IPTRH2(ICOL+1)-1)
20	FORMAT (1X,'<',6A1,I4,'> COL.',I3,': ',80A1)
	FIN
	TO SHOW-HEADER-AND-DATA
	WHEN (LEN(ICOL).LT.25) SHOW-IN-SINGLE-LINE
	ELSE SHOW-IN-TWO-LINES
	FIN
	TO SHOW-IN-SINGLE-LINE
	BYTE COLSP(3)
	DATA SP/' '/
	DATA COLSP /' ',':',' '/
	WRITE (5,27) PREF,IROW+OFFSET,ICOL,
	1 (HEAD1(J),J=IPTRH1(ICOL),IPTRH1(ICOL+1)-1),SP,
	1 (HEAD2(J),J=IPTRH2(ICOL),IPTRH2(ICOL+1)-1),COLSP,
	1 (DATA(J),J=IPTRD(ICOL),IPTRD(ICOL+1)-1)
27	FORMAT (1X,'<',6A1,I4,'> COL.',I3,': ',80A1)
	FIN
	TO SHOW-IN-TWO-LINES
	WRITE (5,27) PREF,IROW+OFFSET,ICOL,
	1 (HEAD1(J),J=IPTRH1(ICOL),IPTRH1(ICOL+1)-1),SP,
	1 (HEAD2(J),J=IPTRH2(ICOL),IPTRH2(ICOL+1)-1)
	WRITE (5,28) COLSP,(DATA(J),J=IPTRD(ICOL),IPTRD(ICOL+1)-1)
28	FORMAT (4X,70A1)
	FIN
	TO READ-TABLE-RECORD
D	WRITE (5,9902) IREC
D9902	FORMAT (' READING RECORD:',I5)
	READ (2'IREC) (DATA(J),J=1,LENREC)
	FIN
	TO WRITE-A-RECORD
D	WRITE (5,9906) IREC
D9906	FORMAT (' WRITING RECORD',I5)
	WRITE (2'IREC) (DATA(J),J=1,LENREC)
C	KEEP HEADER FILE UPDATED
	IF (IREC.GT.NREC) 
	NREC = IREC
	WRITE-HEADER
	FIN
	FIN
	TO WRITE-HEADER
	WRITE (1) NREC
	BACKSPACE 1
	FIN
C
	TO CONFIRM-DELETE-LAST-ROW
	WRITE (5,40)
40	FORMAT ('$DELETE THIS RECORD? (Y/N):')
	READ (5,41) REPLY
41	FORMAT (5A1)
	HEDOES = REPLY(1).EQ.'Y'
	FIN
C
	TO CHECK-LAST-RECORD
C
C	CHECK THAT THE LAST READABLE UNDELETED RECORD IS THE ONE RECORDED IN NREC
C
	DATA MAXREC/32766/     !CORRESPONDS TO VALUE USED IN DEFINEFILE IN
C                             ! SUBROUTINE OPNTAB
	LSTREC = NREC+1
C	TRY READING N+1ST RECORD. SHOULD GET ERR= TRANSFER
	CALL ERRSET(39,.TRUE.,.FALSE.,.TRUE.,.FALSE.)
D	WRITE (5,9910) LSTREC
D9910	FORMAT (' CHECK: TRY READING ',I4)
	READ (2'LSTREC,ERR=102,END=102) JJ
C	THERE ARE MORE THAN NREC RECORDS IN FILE.
D	WRITE (5,9911) LSTREC,NREC
D9911	FORMAT (' READ SUCCEEDED: AT LEAST',I4,' I.E. >',I4,' RECORDS.')
	WHILE (LSTREC.LT.MAXREC)
	LSTREC = LSTREC+1
	READ (2'LSTREC,ERR=103,END=103) JJ
D	WRITE (5,9911) LSTREC,NREC
	FIN
	WRITE (5,121) MAXREC
121	FORMAT (//
	1 10X,' **************************************************'/
	1 10X,' *                                                *'/
	1 10X,' * This table has more than',i6,' records.        *'/
	1 10X,' * It must be split up before you can proceed.    *'/
	1 10X,' *                                                *'/
	1 10X,' **************************************************'/)
	CALL EXIT
C
103	CONTINUE
102	CONTINUE
C
C	NOW FIND LAST UNDELETED RECORD
C
	WHILE (LSTREC.GT.1)
	LSTREC = LSTREC-1
D	WRITE (5,9912) LSTREC
D9912	FORMAT (' BACK UP TO RECORD',I4)
	READ (2'LSTREC,ERR=105,END=105) (DATA(J),J=1,LENREC)
D	WRITE (5,9913) (DATA(J),J=1,6)
D9913	FORMAT (' READ SUCCEEDED: DATA STARTS: ',6A1)
	IF (.NOT.EQUAL(DATA,DEL,6)) GO TO 110
D	WRITE (5,9914)
D9914	FORMAT (' RECORD DELETED; CONTINUE.')
	IF (.FALSE.)
C	SHOULD NOT GET HERE
105	CONTINUE
D	WRITE (5,9915)
D9915	FORMAT (' READ FAILED!  INDEX FILE WAS CORRUPT.')
	FIN
	FIN
110	CONTINUE
C
C	LSTREC IS THE LAST READABLE UNDELETED RECORD.  IT SHOULD = NREC.
C
D	WRITE (5,9916) LSTREC,NREC
D9916	FORMAT (' LSTREC =',I5,'; NREC =',I5)
	IF (LSTREC.NE.NREC) REPORT-TABLE-LENGTH-ERROR
	CALL ERRSET(39,.TRUE.,.TRUE.,.TRUE.,.TRUE.)
	FIN
	TO REPORT-TABLE-LENGTH-ERROR
	WRITE (5,123) PREF,OFFSET+LSTREC,PREF,OFFSET+NREC
123	FORMAT (//
	1 10X,' ******************************************************'/
	1 10X,' *                                                    *'/
	1 10X,' * WARNING: The last readable record in this table is *'/
	1 10X,' *                                                    *'/
	1 10X,' *            ',6A1,I6,'.'/
	1 10X,' *                                                    *'/
	1 10X,' * According to the index file the last record should *'/
	1 10X,' * be                                                 *'/
	1 10X,' *            ',6A1,I6,'.'/
	1 10X,' *                                                    *'/
	1 10X,' * The index file has been updated to reflect the     *'/
	1 10X,' * actual number of readable records in the table.    *'/
	1 10X,' *                                                    *'/
	1 10X,' * PLEASE check and correct the last few records of   *'/
	1 10X,' * this table before proceeding.                      *'/
	1 10X,' *                                                    *'/
	1 10X,' ******************************************************'/)
	NREC = LSTREC
	WRITE (1) NREC
	BACKSPACE 1
	FIN
	END