C	PROGRAM TO DEFINE OR MODIFY A 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
C	HEADERS, ETC., FOR NEW TABLE
C
C	23-SEP-81  ADD ADD-A-COLUMN
C
	BYTE HEAD1(1000),HEAD2(1000)
	BYTE PREF(6)		!TABLE PREFIX CONTAINING '-' AND NULLS
	BYTE ZERO1(10),ZERO2(10)!ZERO-TH COLUMN HEADERS.
	INTEGER OFFSET
	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 MAXHD/1000/	!MAX. LENGTH OF HEAD1,HEAD2
	DATA MAXLEN/1000/	!MAX. LENGTH OF DATA IN EACH RECORD
	DATA IPTRH1(1),IPTRH2(1),IPTRD(1) /3*1/
C
	BYTE TITLE(80),SUBTL(80)
C
C	HEADERS, ETC., FROM OLD TABLE (IF ANY)
C
C
	BYTE NHEAD1(1000),NHEAD2(1000),LINE(80)
	INTEGER NPTRH1(41),NPTRH2(41),NPTRD(41)
	BYTE NTITLE(80), NSUBTL(80)
	BYTE NZERO1(10), NZERO2(10)
C
	BYTE DATA(1000), NDATA(1000)
C
	INTEGER HD1TOT,HD2TOT,DIF,COL,ADD
	DATA SP/' '/
	DATA L1TOT,L2TOT/0,0/
	LOGICAL*1 NOHEAD,DONE
	BYTE FILNAM(20),TABNAM(10)
	BYTE INDATA(80),SP
	LOGICAL*1 OLDTAB,FIXHDR,ADDCOL,DELCOL,FIXCOL
	DATA OLDTAB,FIXHDR,ADDCOL,DELCOL,FIXCOL/5*.FALSE./
C
	GET-TABLE-NAME
	WHEN (OLDTAB) MODIFY-EXISTING-TABLE
	ELSE CREATE-NEW-TABLE
	CALL EXIT
C
	TO MODIFY-EXISTING-TABLE
	READ-OLD-INDEX
	LENREC = NLREC
	ASK-IF-TITLES-OR-HEADERS-SHOULD-BE-CHANGED
	WHEN (FIXHDR)
	UPDATE-TITLE-ETC
	UPDATE-COLUMN-HEADERS
	FIN
	ELSE COPY-TITLE-HEADERS-AND-POINTERS
	ASK-IF-COLUMN-WIDTHS-SHOULD-BE-CHANGED
	UNLESS (FIXCOL) ASK-IF-COLUMN-SHOULD-BE-ADDED-OR-REMOVED
	IF (FIXCOL.OR.ADDCOL.OR.DELCOL)
	ASSIGN-NEW-TABLE
	REWRITE-TABLE
	FIN
	IF (FIXCOL.OR.ADDCOL.OR.DELCOL.OR.FIXHDR)
	ASSIGN-NEW-INDEX
	WRITE-INDEX
	TYPE-DELETE-AND-RENAME-MESSAGE
	FIN
	FIN
	TO CREATE-NEW-TABLE
	WRITE (5,2) (FILNAM(I),I=1,LFNAM)
2	FORMAT (' CREATING A NEW TABLE : ',10A1)
	GET-TITLE-PREFIX-AND-OFFSET
	GET-COLUMN-HEADERS
	ASSIGN-NEW-INDEX
	NREC = 0
	WRITE-INDEX
	TYPE-TABLE-IS-CREATED-MESSAGE
	FIN
C
	TO GET-TABLE-NAME
	CALL GETNAM(FILNAM,10)
	LFNAM = LENGTH(FILNAM)
	CALL MVSTR(TABNAM,FILNAM)
	CHECK-IF-FILE-ALREADY-EXISTS
	FIN
C
	TO GET-COLUMN-HEADERS
	ICOL = 1
	L1TOT = 0
	L2TOT = 0
	WRITE (5,23)
23	FORMAT ( ' REPLY WITH TWO <CR>S WHEN NO MORE COLUMNS.')
	REPEAT UNTIL (DONE.OR.(ICOL.GT.MAXCOL))
C
C	FIRST ROW HEADER
C
	JROW = 1
	WRITE (5,45) ICOL
45	FORMAT (' FIRST ROW HEADER FOR COLUMN ',I4,': ',80A1)
	READ (5,4) L1, INDATA
4	FORMAT (Q,80A1)
	DONE = L1.EQ.0
	IF (L1.EQ.0) LI = 1
	STUFF-HEADER
C
C	SECOND ROW HEADER
C
	JROW = 2
	WRITE (5,46) ICOL
46	FORMAT (' SECOND ROW HEADER FOR COLUMN ',I2,' : ',80A1)
	READ (5,4) L2,INDATA
	DONE = DONE .AND. (L2.EQ.0)
	IF (L2.EQ.0)  L2 = 1
	STUFF-HEADER
C
C	NOW FOR LENGTH ARRAY
C
	UNLESS (DONE)
	WRITE (5,6) ICOL
6	FORMAT ('$LENGTH OF COLUMN',I4,' : ')
	READ (5,7) L3
7	FORMAT (I8)
	IF (L3.GE.132) WRITE (5,56)
56	FORMAT (' **WARNING** COLUMN IS TOO LONG TO PRINT!')
	LEN(ICOL) = MAX0(L1,L2,L3)
	IPTRD(ICOL+1) = IPTRD(ICOL) + L3
	IF (IPTRD(ICOL+1).GT.MAXLEN) ABORT-WITH-TABLE-OVERFLOW
	L1TOT = L1TOT + L1
	L2TOT = L2TOT + L2
	ICOL = ICOL + 1
	IF (ICOL.GT.MAXCOL+1) ABORT-WITH-COLUMN-OVERFLOW
	FIN
	FIN
	NCOL = ICOL-1
	LENREC = IPTRD(NCOL+1)
D	WRITE (6,9920) LENREC,NCOL,(I,IPTRH1(I),IPTRH2(I),
D	1 IPTRD(I),LEN(I), I=1,NCOL+1)
D9920	FORMAT (' LENREC =',I8,'   NCOL =',I5/
D	1 ' COL       IPTRH1       IPTRH2    IPTRD    LEN'/
D	1 (I5,4I10))
D	WRITE (6,9921) L1TOT,(HEAD1(I),I=1,L1TOT)
D9921	FORMAT (/' L1TOT =',I6/(1X,50A1))
D	WRITE (6,9922) L2TOT,(HEAD2(I),I=1,L2TOT)
D9922	FORMAT (/' L2TOT =',I6/(1X,50A1))
	FIN
C
	TO UPDATE-COLUMN-HEADERS
	ICOL = 1
	L1TOT = 0
	L2TOT = 0
	WRITE (5,43)
43	FORMAT (' ENTER <CR> TO LEAVE THAT HEADER UNCHANGED.',//)
	REPEAT UNTIL (ICOL.GT.NCOL)
	JROW = 1
	K = 1
	DO (I=NPTRH1(ICOL),NPTRH1(ICOL+1)-1)
	LINE(K) = NHEAD1(I)
	K = K + 1
	FIN
	DIF = K-1
	WRITE (5,45) ICOL,(LINE(I),I=1,DIF)
	READ (5,4) L1, INDATA
	IF (L1.EQ.0)
	DO (I=1,80) INDATA(I) = LINE(I)
	L1 = DIF
	FIN
	STUFF-HEADER
C
	JROW = 2
	K = 1
	DO (I=NPTRH2(ICOL),NPTRH2(ICOL+1)-1)
	LINE(K) = NHEAD2(I)
	K = K + 1
	FIN
	DIF = K - 1
	WRITE (5,46) ICOL,(LINE(I),I=1,DIF)
	READ (5,4) L2,INDATA
	IF (L2.EQ.0)
	DO (I=1,80) INDATA(I) = LINE(I)
	L2 = DIF
	FIN
	STUFF-HEADER
C
	IPTRD(ICOL) = NPTRD(ICOL)
	L3 = NPTRD(ICOL+1) - NPTRD(ICOL) - 1
	LEN(ICOL) = MAX0(L1,L2,L3)
C
	ICOL = ICOL+1
C
	FIN
	IPTRD(NCOL+1) = NPTRD(NCOL+1)
	L1TOT = IPTRH1(NCOL+1)
	L2TOT = IPTRH2(NCOL+1)
D	WRITE (6,9920) NLREC,NCOL,(I,IPTRH1(I),IPTRH2(I),
D	1 IPTRD(I),LEN(I),
D	1 I=1,NCOL+1)
D	WRITE (6,9921) L1TOT,(HEAD1(I),I=1,L1TOT)
D	WRITE (6,9922) L2TOT,(HEAD2(I),I=1,L2TOT)
	FIN
C
	TO STUFF-HEADER
	SELECT (JROW)
	(1)
D	WRITE (6,9925) ICOL,IPTRH1(ICOL),L1,(INDATA(I),I=1,L1)
D9925	FORMAT (' STUFF ICOL =',I5,' AT',I5,' L1 =',I5,' INDATA = '/
D	1 (1X,20A1))
	DO (I=1,L1)
	HEAD1(IPTRH1(ICOL)+I-1) = INDATA(I)
	FIN
	IPTRH1(ICOL+1) = IPTRH1(ICOL) + L1
	IF (IPTRH1(ICOL+1).GT.MAXHD) ABORT-WITH-HEADER-OVERFLOW
	FIN
	(2)
D	WRITE (6,9926) ICOL,IPTRH2(ICOL),L2,(INDATA(I),I=1,L2)
D9926	FORMAT (' STUFF ICOL =',I5,' AT',I5,' L2 =',I5,' INDATA = '/
D	1 (1X,20A1))
	DO (I=1,L2)
	HEAD2(IPTRH2(ICOL)+I-1) = INDATA(I)
	FIN
	IPTRH2(ICOL+1) = IPTRH2(ICOL) + L2
	IF (IPTRH2(ICOL+1).GT.MAXHD) ABORT-WITH-HEADER-OVERFLOW
	FIN
	FIN
	FIN
C
	TO COPY-TITLE-HEADERS-AND-POINTERS
	DO (I=1,41)
	IPTRH1(I) = NPTRH1(I)
	IPTRH2(I) = NPTRH2(I)
	IPTRD(I) = NPTRD(I)
	FIN
	DO (I=1,L1TOT) HEAD1(I) = NHEAD1(I)
	DO (I=1,L2TOT) HEAD2(I) = NHEAD2(I)
	LENTL = NLENTL
	DO (I=1,LENTL) TITLE(I) = NTITLE(I)
	LENSTL = NLSUBT
	DO (I=1,LENSTL) SUBTL(I) = NSUBTL(I)
	DO (I=1,10) ZERO1(I) = NZERO1(I)
	DO (I=1,10) ZERO2(I) = NZERO2(I)
	FIN
	TO CHECK-IF-FILE-ALREADY-EXISTS
	OLDTAB = .FALSE.
C	SUPPRESS NO-SUCH-FILE MESSAGE
	CALL ERRSET (29,.TRUE.,,,.FALSE.)
	CALL ERRSNS
	CALL MVSTR (FILNAM(LFNAM),'.TAI')
	CALL ASSIGN(1,FILNAM)
	READ (1,ERR=55) NLREC,NCOL
C	RESULT SHOULD BE AN ERROR 29, FCS ERROR -26
55	CALL ERRSNS(IER,IFCS)
D	WRITE (6,9902) IER,IFCS,NREC,NLREC
D9902	FORMAT (' IER,IFCS,NREC,NLREC:',L2,4I6)
	IF (IER.NE.29)
	OLDTAB = .TRUE.
D	WRITE (6,9901) IER,IFCS
D9901	FORMAT (' IER, IFCS',2I8)
	CALL MVSTR(FILNAM(LFNAM),'.TAB')
	LENWDS = (NLREC+1)/2
	CALL ASSIGN(2,FILNAM)
	DEFINE FILE 2 (32767,LENWDS,U,IVAR2)
	WRITE (5,25) TABNAM
25	FORMAT (' TABLE ',10A1' ALREADY EXISTS.')
	FIN
	CALL ERRSET(29,.TRUE.,,,.TRUE.)
	FIN
	TO GET-TITLE-PREFIX-AND-OFFSET
	WRITE (5,30)
30	FORMAT (' TITLE FOR TABLE: ',80A1)
	READ (5,32) LENTL,TITLE
32	FORMAT (Q,80A1)
	WRITE (5,35)
35	FORMAT (' SUBTITLE FOR TABLE: ',80A1)
	READ (5,32) LENSTL,SUBTL
	WRITE (5,22)
22	FORMAT ('$ENTER TABLE PREFIX : ')
	READ (5,26) LP,PREF
26	FORMAT (Q,10A1)
	IF (LP.NE.0) PREF(LP+1) = '-'
	LP=LP+2
	REPEAT UNTIL (LP.GE.6)
	PREF(LP) = 0
	LP=LP+1
	FIN
	WRITE (5,27)
27	FORMAT ('$BEGINNING RECORD NUMBER: ')
	READ (5,28) ITEMP
28	FORMAT (I5)
	OFFSET = ITEMP-1
	ICOL = 0
	WRITE (5,45) ICOL
	READ (5,408) ZERO1
408	FORMAT (10A1)
	WRITE (5,46) ICOL
	READ (5,408) ZERO2
	FIN
C
	TO UPDATE-TITLE-ETC
	WRITE (5,30) (NTITLE(I),I=1,NLENTL)
	READ (5,32) LENTL,TITLE
	IF (LENTL.EQ.0)
	DO (I=1,NLENTL) TITLE(I) = NTITLE(I)
	LENTL = NLENTL
	TITLE(LENTL+1) = 0
	FIN
	WRITE (5,35) (NSUBTL(I),I=1,NLSUBT)
	READ (5,32)LENSTL,SUBTL
	IF (LENSTL.EQ.0)
	DO (I=1,NLSUBT) SUBTL(I) = NSUBTL(I)
	LENSTL = NLSUBT
	SUBTL(LENSTL+1) = 0
	FIN
	ICOL = 0
	WRITE (5,45) ICOL,NZERO1
	READ (5,4) L1,ZERO1
	IF (L1.EQ.0)
	DO (I=1,10) ZERO1(I) = NZERO1(I)
	FIN
	WRITE (5,46) ICOL,NZERO2
	READ (5,4) L2,ZERO2
	IF (L2.EQ.0)
	DO (I=1,10) ZERO2(I) = NZERO2(I)
	FIN
	FIN
	TO ASSIGN-NEW-INDEX
	CALL CLOSE (3)
	CALL MVSTR(FILNAM(LFNAM),'.TAI')
	CALL ASSIGN(3,FILNAM)
	FIN
	TO ASSIGN-NEW-TABLE
	LENWDS = (LENREC+1)/2
	CALL MVSTR(FILNAM(LFNAM),0)
	CALL MVSTR(FILNAM(LFNAM),'.TAB')
	CALL ASSIGN(4,FILNAM)
	DEFINE FILE 4 (32767,LENWDS,U,IVAR)
	FIN
C
	TO WRITE-INDEX
D	WRITE (6,9931)
D9931	FORMAT (//' WRITING NEW INDEX')
D	WRITE (6,9920) LENREC,NCOL,(I,IPTRH1(I),IPTRH2(I),
D	1 IPTRD(I),LEN(I),
D	1 I=1,NCOL+1)
D	WRITE (6,9921) L1TOT,(HEAD1(I),I=1,L1TOT)
D	WRITE (6,9922) L2TOT,(HEAD2(I),I=1,L2TOT)
	WRITE (3) LENREC,NCOL
	WRITE (3) IPTRH1,IPTRH2
	WRITE (3) L1TOT,(HEAD1(J),J=1,L1TOT)
	WRITE (3) L2TOT,(HEAD2(J),J=1,L2TOT)
	WRITE (3) LENTL,(TITLE(J),J=1,LENTL)
	WRITE (3) LENSTL,(SUBTL(J),J=1,LENSTL)
	WRITE (3) LEN,IPTRD
	WRITE (3) OFFSET, PREF
	WRITE (3) ZERO1,ZERO2
	WRITE (3) NREC
	FIN
C
	TO READ-OLD-INDEX
C	FIRST RECORD WAS READ IN CHECK-IF-FILE-ALREADY-EXISTS
C	READ (1) NLREC,NCOL
	READ (1) NPTRH1,NPTRH2
	READ (1) L1TOT,(NHEAD1(J),J=1,L1TOT)
	READ (1) L2TOT,(NHEAD2(J),J=1,L2TOT)
	READ (1) NLENTL,(NTITLE(J),J=1,NLENTL)
	READ (1) NLSUBT,(NSUBTL(J),J=1,NLSUBT)
	READ (1) LEN,NPTRD
	READ (1) OFFSET, PREF
	READ (1) NZERO1,NZERO2
	READ (1) NREC
C
D	WRITE (6,9932)
D9932	FORMAT (//' OLD INDEX: ')
D	WRITE (6,9920) NLREC,NCOL,(I,NPTRH1(I),NPTRH2(I),
D	1 NPTRD(I),LEN(I),
D	1 I=1,NCOL+1)
D	WRITE (6,9921) L1TOT,(NHEAD1(I),I=1,L1TOT)
D	WRITE (6,9922) L2TOT,(NHEAD2(I),I=1,L2TOT)
	FIN
C
	TO ASK-IF-TITLES-OR-HEADERS-SHOULD-BE-CHANGED
	BYTE REPLY
	WRITE (5,41)
41	FORMAT (' WOULD YOU LIKE TO CHANGE THE TITLE OR COLUMN HEADERS?'/
	1 '$(Y OR N): ')
	READ (5,42) REPLY
42	FORMAT (A1)
	FIXHDR = REPLY.EQ.'Y'
	FIN
C
	TO ABORT-WITH-COLUMN-OVERFLOW
	WRITE (5,92) MAXCOL
92	FORMAT (' ***MAXIMUM NUMBER OF COLUMNS (',I2,') IS EXCEEDED.')
	STOP
	FIN
	TO ABORT-WITH-HEADER-OVERFLOW
	WRITE (5,90) MAXHD 
90	FORMAT (' ****HEADER ARRAY HAS OVERFLOWED****'/
	1 ' MAX. TOTAL LENGTH OF EACH ROW OF HEADERS IS ,',I5,
	1 ' CHARACTERS.')
	STOP
	FIN
C
	TO ABORT-WITH-TABLE-OVERFLOW
	WRITE (5,91) MAXLEN
91	FORMAT ('****TABLE OVERFLOW****',/,
	1 ' MAX. TOTAL LENGTH OF DATA RECORD IS ,',I5,
	1 ' CHARACTERS.')
	STOP
	FIN
C
	TO ABORT-WITH-INVALID-COLUMN-NUMBER
	WRITE (5,93) NCOL
93	FORMAT ('****INVALID COLUMN NUMBER****'/
	1 ' MAX. COLUMN NUMBER IS ',I5)
	STOP
	FIN
C
	TO ASK-IF-COLUMN-WIDTHS-SHOULD-BE-CHANGED
	WRITE (5,61)
61	FORMAT ('$DO YOU WANT TO CHANGE THE WIDTH OF A COLUMN? ')
	READ (5,42) REPLY
	FIXCOL = REPLY.EQ.'Y'
	IF (FIXCOL) 
	WRITE (5,63)
63	FORMAT ('$COLUMN NUMBER: ')
	READ (5,62) COL
62	FORMAT (I3)
	WRITE (5,64)
64	FORMAT ('$HOW MANY SPACES TO ADD? (<0 FOR SUBTRACT): ')
	READ (5,62) ADD
	DO (J=COL,NCOL) IPTRD(J+1) = IPTRD(J+1) + ADD
	LEN(COL) = MAX0( LEN(COL)+ADD, IPTRH1(ICOL+1)-IPTRH1(ICOL),
	1 IPTRH2(ICOL+1)-IPTRH2(ICOL) )
	LENREC = NLREC + ADD
	LENWDS = (LENREC+1)/2
	FIN
	FIN
C
	TO ASK-IF-COLUMN-SHOULD-BE-ADDED-OR-REMOVED
	BYTE NEWHD1(100),NEWHD2(100)
	WRITE (5,71)
71	FORMAT ('$DO YOU WANT TO ADD OR REMOVE ',
	1 'A COLUMN (TYPE "A", "R", OR "N"): ')
	READ (5,42) REPLY
	ADDCOL = REPLY.EQ.'A'
	DELCOL = REPLY.EQ.'R'
	IF (ADDCOL)
	IF (NCOL.EQ.MAXCOL) ABORT-WITH-COLUMN-OVERFLOW
	WRITE (5,72)
72	FORMAT ('$COLUMN NUMBER OF NEW COLUMN: ')
	READ (5,62) COL
	IF (COL.LE.0.OR.COL.GT.NCOL+1) ABORT-WITH-INVALID-COLUMN-NUMBER
	WRITE (5,74)
74	FORMAT ('$HEADER (1): ')
	READ (5,75) LNHD1,NEWHD1
75	FORMAT (Q,100A1)
	IF (LNHD1.EQ.0) LNHD1 = 1
	WRITE (5,76)
76	FORMAT ('$HEADER (2): ')
	READ (5,75) LNHD2,NEWHD2
	IF (LNHD2.EQ.0) LNHD2 = 1
	WRITE (5,77)
77	FORMAT ('$WIDTH OF COLUMN: ')
	READ (5,62) ADD
	IF (NLREC+ADD .GT. MAXLEN) ABORT-WITH-TABLE-OVERFLOW
	NEWLEN = MAX0(ADD,LNHD1,LNHD2)
	IF (L1TOT+LNHD1.GT.MAXHD) ABORT-WITH-HEADER-OVERFLOW
	IF (L2TOT+LNHD2.GT.MAXHD) ABORT-WITH-HEADER-OVERFLOW
	IF (COL.LE.NCOL)
	IHD1 = IPTRH1(COL)
	IHD2 = IPTRH2(COL)
	DO (I=L1TOT,IHD1,-1) HEAD1(I+LNHD1) = HEAD1(I)
	DO (I=L2TOT,IHD2,-1) HEAD2(I+LNHD2) = HEAD2(I)
	FIN
	DO (ICOL = NCOL+1,COL,-1)
	IF (ICOL.LE.NCOL) LEN(ICOL+1) = LEN(ICOL)
	IPTRH1(ICOL+1) = IPTRH1(ICOL)+LNHD1
	IPTRH2(ICOL+1) = IPTRH2(ICOL)+LNHD2
	IPTRD(ICOL+1) = IPTRD(ICOL)+ADD
	FIN
	NCOL = NCOL+1
	L1TOT = L1TOT + LNHD1
	L2TOT = L2TOT + LNHD2
	IHD1 = IPTRH1(COL)
	IHD2 = IPTRH2(COL)
	DO (I=1,LNHD1) HEAD1(I-1+IHD1) = NEWHD1(I)
	DO (I=1,LNHD2) HEAD2(I-1+IHD2) = NEWHD2(I)
	LEN(COL) = NEWLEN
	LENREC = NLREC + ADD
	LENWDS = (LENREC+1)/2
	FIN
C	REMOVE COLUMN
	IF (DELCOL)
	WRITE (5,81)
81	FORMAT ('$COLUMN TO REMOVE: ')
	READ (5,62) COL
	IF (COL.LE.0.OR.COL.GT.NCOL) ABORT-WITH-INVALID-COLUMN-NUMBER
	LNHD1 = IPTRH1(COL+1)-IPTRH1(COL)
	LNHD2 = IPTRH2(COL+1)-IPTRH2(COL)
	ADD = -(IPTRD(COL+1)-IPTRD(COL))
	IHD1 = IPTRH1(COL)
	IHD2 = IPTRH2(COL)
	L1TOT = L1TOT - LNHD1
	L2TOT = L2TOT - LNHD2
	DO (I=IHD1,L1TOT) HEAD1(I) = HEAD1(I+LNHD1)
	DO (I=IHD2,L2TOT) HEAD2(I) = HEAD2(I+LNHD2)
	DO (ICOL = COL,NCOL)
	IF (ICOL.LT.NCOL) LEN(ICOL) = LEN(ICOL+1)
	IPTRH1(ICOL) = IPTRH1(ICOL+1)-LNHD1
	IPTRH2(ICOL) = IPTRH2(ICOL+1)-LNHD2
	IPTRD(ICOL) = IPTRD(ICOL+1)+ ADD
	FIN
	LENREC = NLREC + ADD
	LENWDS = (LENREC+1)/2
	NCOL = NCOL-1
	FIN
	FIN
C
	TO REWRITE-TABLE
	DO (I=1,NREC)
	READ (2'I) (NDATA(K),K=1,NLREC)
C	COPY DATA UP TO MODIFIED COLUMN
	UNLESS (COL.EQ.1)
	DO (J=1,IPTRD(COL)-1) DATA(J) = NDATA(J)
	FIN
C	DO SOMETHING ABOUT MODIFIED COLUMN
	CONDITIONAL
	(ADDCOL)
	DO (J=IPTRD(COL),IPTRD(COL+1)-1) DATA(J) = ' '
	FIN
	(FIXCOL)
	JJ = MIN0(IPTRD(COL+1)-1,NPTRD(COL+1)-1)
	DO (J=IPTRD(ICOL),JJ) DATA(J) = NDATA(J)
	IF (JJ.LT.IPTRD(COL+1)-1)
	DO (J=JJ+1,IPTRD(COL+1)-1) DATA(J) = ' '
	FIN
	FIN
	FIN
C	COPY DATA AFTER MODIFIED COLUMN
	UNLESS (COL.EQ.NCOL)
	DO (J=IPTRD(COL+1),LENREC) DATA(J) = NDATA(J-ADD)
	FIN
	WRITE (4'I) (DATA(K),K=1,LENREC)
	FIN
	FIN
C
	TO TYPE-DELETE-AND-RENAME-MESSAGE
	WRITE (5,311)
311	FORMAT (/' Now you must enter the following PDS commands:'//)
	WRITE (5,312) TABNAM
312	FORMAT ( ' PDS>SET PROTECTION ',10A1,'.TAI;1 (OW:RWED)')
	IF (FIXCOL.OR.ADDCOL.OR.DELCOL) WRITE (5,313) TABNAM
313	FORMAT ( ' PDS>SET PROTECTION ',10A1,'.TAB;1 (OW:RWED)')
	WRITE (5,314) (TABNAM,I=1,2)
314	FORMAT ( ' PDS>DELETE/KEEP ',10A1,'.TAB, ',10A1,'.TAI')
	WRITE (5,315) TABNAM,TABNAM
315	FORMAT ( ' PDS>RENAME ',10A1,'.TAI;2 ',10A1,'.TAI;1')
	IF (FIXCOL.OR.ADDCOL.OR.DELCOL) WRITE (5,316) TABNAM,TABNAM
316	FORMAT ( ' PDS>RENAME ',10A1,'.TAB;2 ',10A1,'.TAB;1')
	WRITE (5,317) TABNAM
317	FORMAT ( ' PDS>SET PROTECTION ',10A1,'.TAI;1 (SY:RWE OW:RWE)')
	IF (FIXCOL.OR.ADDCOL.OR.DELCOL) WRITE (5,318) TABNAM
318	FORMAT (' PDS>SET PROTECTION ',10A1,'.TAB;1 (SY:RWE OW:RWE)'/)

	FIN
C
	TO TYPE-TABLE-IS-CREATED-MESSAGE
	WRITE (5,301) TABNAM,TABNAM,TABNAM
301	FORMAT (' TABLE ',10A1,' HAS BEEN CREATED.'/
	1 ' Use EDT to start filling in ',10A1,', then, for safety,'/
	1 ' type the following PDS commands:'/
	1 ' PDS>SET PROTECTION ',10A1,'.* (SY:RWE OW:RWE)'/)
	FIN
	END