C..   DATLIB.FTN   BOHDEN K. CMAYLO    DEC 1981
C..
C..   LIBRARY OF ROUTINES FOR DATAENTRY ONLY
C..
	SUBROUTINE DATENT(IERR,IN,INPUT)
C..
C..	THIS ROUTINE READS A FILE CALLED DATAENTRY.DTN AND ASKS THE USER
C..	WHICH APPLICATION TO PICK
C..
	BYTE INPUT(1),APPLIC(24)
392	OPEN(UNIT=IN,ERR=91,NAME='SX:[5,10]DATAENTRY.DTN',TYPE='OLD'
     1 ,READONLY)
	IERR=0
	CALL CRTCLR(3)
	TYPE 1
1	FORMAT('0*** ENTER GENERAL APPLICATION:'//' APPLICATION'/)
	IPASS=1
2	READ(IN,3,END=4)IQ,(INPUT(I),I=1,IQ)
3	FORMAT(Q,132A1)
	CALL DOBYTE(INPUT(IQ+1),INPUT(132),' ')
	I1=0
	I2=0
	DO 5 I=1,IQ
	IF(INPUT(I).EQ.' '.AND.I1.NE.0) I2=I
	IF(INPUT(I).EQ.' '.AND.I1.EQ.0) I1=I
	IF(I2.NE.0) GO TO 6
5	CONTINUE
	GO TO 2
6	I3=14-(I2-I1)
	IF(I3.LE.0) I3=1
	TYPE 7,(INPUT(II),II=I1,I2),(' ',II=1,I3),(INPUT(II),II=I2,IQ)
7	FORMAT(132A1)
	GO TO 2
C..
C..	ENTER APPLICATION
C..
4	CONTINUE
	TYPE 7
	CALL PROMPT('ENTER APPLICATION =',IQ,INPUT)
	IF(IQ.LT.0) GO TO 93
	CALL CAPS(INPUT,IQ)
C..ADDED FOR FIRST FOUND (NOT FULL LENGTH APPLIC)
	IZ=IQ
	CALL BYTEDO(APPLIC,APPLIC(24),INPUT)
	REWIND IN
10	READ(IN,3,END=44)IQ,(INPUT(I),I=1,IQ)
	CALL DOBYTE(INPUT(IQ+1),INPUT(132),' ')
	DO 11 I=1,IQ
	IF(INPUT(I).NE.' ') GO TO 11
CDO 24 II=1,I
	DO 24 II=1,IZ
	IF(INPUT(II+I).NE.APPLIC(II)) GO TO 10
C..	CHECK IF FOUND
CIF(INPUT(II+I).EQ.' ') GO TO 14
	IF(APPLIC(II+1).EQ.' ') GO TO 14
24	CONTINUE
	GO TO 14
11	CONTINUE
	GO TO 10
C..
C..	NOT FOUND, ASSUMED INPUT
C..
44	TYPE 45,APPLIC
45	FORMAT('0*** APPLICATION ',24A1/'     NOT FOUND,'
     1 ,' ASSUMED AS AN INPUT FILE.'/)
	IPASS=2
	IX=4
	IF(APPLIC(3).EQ.':'.OR.APPLIC(4).EQ.':'.OR.APPLIC(5).EQ.':')IX=1
	CALL BYTEDO(INPUT(IX),INPUT(23+IX),APPLIC)
	IF(IX.EQ.4) CALL BYTEDO(INPUT,INPUT(3),'SY:')
	I=24+IX
14	CONTINUE
	CLOSE (UNIT=IN)
	INPUT(I)=0
	OPEN (UNIT=IN,ERR=92,NAME=INPUT,TYPE='OLD',READONLY)
	IF(IPASS.GT.1) RETURN
	CALL CRTCLR(3)
	IPASS=2
	TYPE 8
8	FORMAT('0*** ENTER SPECIFIC APPLICATION:'//' APPLICATION'/)
	GO TO 2
C.. NO SX:[5,10]DATAENTRY.DTN
91	TYPE 191
191	FORMAT('0*** INSTALLATION ERROR *** CONTACT SYSTEM MANAGER ***'/
     1 //'0 *** NO SX:[5,10]DATAENTRY.DTN FILE FOUND ***'//)
	CALL EXIT
92	TYPE 192,(INPUT(J),J=1,I)
192	FORMAT('0*** ERROR *** NO FILE NAMED: ',80A1)
	GO TO 392
93	TYPE 193
193	FORMAT('0*** END OF FILE READ *** STOP ***')
	CALL EXIT
	END
	SUBROUTINE INDATA(INFILE,IREC,KARR,ENDX,MAXID,IERR,ICONST)
C..
	BYTE INPUT,MARRAY
	COMMON/IOCOM/INCR,IPR,IEOF,INPUT(512),INARR(5,99)
	COMMON/XMAXID/MAXIDX
	COMMON/XIOCOM/MARRAX,MARRAY(1000)
	REAL FMAT(1),FMATX(3)
	EQUIVALENCE (XDATA,INPUT)
	DATA FMATX/'(I1)','(I2)','(I3)'/
C..
C..	IPR	PRINT UNIT
C..	INFILE	READ UNIT
C..	IREC	RECORD COUNTER, - WHEN EOF READ
C..	INPUT	200 CHARACTER BUFFER
C..	KARR	COUNTER IN MARRAY LOCATION
C..	INARR	SEE DATAENTRY MAIN PROGRAM
C..	MARRAY	CONTAINS MESSAGES, CHECKS AND LAST ENTRIES
C..	ENDX	REAL WORD CONTAINING 4 CHAR END FILE CONDITION
	DATA MAXALP,MAXNUM/80,20/
C..
	READ(INFILE,1,END=99)IQ,(INPUT(I),I=1,IQ)
1	FORMAT(Q,200A1)
	CALL DOBYTE(INPUT(IQ+1),INPUT(200),' ')
	IREC=IREC+1
	IF(XDATA.NE.ENDX) GO TO 3
	IREC=-IREC
	RETURN
C..
C..	FORMAT OF RECORD IS:
C..
C..	ID  MSG....:(+Z-?)N:V1 V2 V3 ...
C..	1-3    TO : NUMBER  SAME NUMBER OF CHARS AS NUMBER
C..	                V1 V2 = GE LE IF NUMBER
C..	                V1 V2 V3 ... ALPHA IF -NUMBER
C..
3	DECODE(3,5,INPUT,ERR=6)ID
5	FORMAT(I3)
	IF(ID.LE.MAXID.OR.ID.GT.MAXIDX) GO TO 7
	MAXID=ID
	IF(INARR(1,ID).NE.0) GO TO 8
C..
C..	ID OK, PLACE IN STORAGE
C..
	INARR(1,ID)=ID
C..
C..	PLACE COUNTER OF MSG IN ARRAY (BEGINNING LOCATION)
C..
	INARR(3,ID)=KARR+1
C..
C..	CODE OVER FIELD NUMBER IN MESSAGE
C..
	ENCODE(5,123,MARRAY(KARR+1))ID
123	FORMAT(I3,': ')
	KARR=KARR+5
	IF(KARR.GE.MARRAX) GO TO 888
C..
C..	MOVE MSG OVER INTO STORAGE
C..
	DO 9 I=4,IQ
	IF(INPUT(I).EQ.':') GO TO 10
	KARR=KARR+1
	IF(KARR.GE.MARRAX) GO TO 888
	MARRAY(KARR)=INPUT(I)
9	CONTINUE
C.. NO :, ERROR MSG
	CALL ERROR(INPUT,IQ,'NO '':'' TO END MESSAGE PROMPT..')
100	IERR=IERR+1
	RETURN
101	CALL ERROR(INPUT,IQ,'PROMPT PLUS FORMAT GREATER THAN 132..')
	GO TO 100
C..
C..	PICK UP FORMAT (+Z-? NUMBER)
C..
10	CONTINUE
	KPROM=I-4
	IX=I+1
	KARR=KARR+1
	IF(KARR.GE.MARRAX) GO TO 888
	MARRAY(KARR)=INPUT(I)
	DO 11 I=IX,IQ
	IF(INPUT(I).EQ.':') GO TO 12
11	CONTINUE
	CALL ERROR(INPUT,IQ,'NO '':'' SEPARATING FORMAT FROM CHECKS..')
	GO TO 100
C.. ERRORS FOR ID
6	CALL ERROR(INPUT,IQ,'ID FORMAT ERROR..')
	GO TO 100
7	CALL ERROR(INPUT,IQ,'ID FALLS OUT OF RANGE OR NON SEQUENCED..')
	GO TO 100
8	CALL ERROR(INPUT,IQ,'ID USED PREVIOUSLY..')
	GO TO 100
C..
C..	GET NUMBER OF CHARACTERS IN FORMAT AND SIGN
C..
12	CONTINUE
	IY=I-IX
	IZ=I
	IF(IY.GE.1.AND.IY.LE.3) GO TO 13
130	CALL ERROR(INPUT,IQ,'BAD FORMAT NUMBER FOUND..')
	GO TO 100
C..
C..	CHECK FOR SPECIAL OPTIONS
C..
13	CONTINUE
	ICONST=0
C.. ? FOR VARIABLE STRING
	IVAR=0
	IF(INPUT(IX).EQ.'?'.AND.IY.GT.1) IVAR=1
C..	Z FOR ZERO FILLED RIGHT JUSTIFIED NUMBER
	IF(INPUT(IX).EQ.'Z'.AND.IY.GT.1) IVAR=2
C.. NORMAL STUFF (- OR +)
	FMAT(1)=FMATX(IY)
	IF(IVAR.GT.0) IX=IX+1
	IF(IVAR.GT.0) IY=IY-1
	DECODE(IY,FMAT,INPUT(IX),ERR=130)NUM
	ISIGN=1
	IF(NUM.EQ.0) ICONST=1
	IF(NUM.LT.0.OR.IVAR.EQ.1.OR.ICONST.EQ.1) ISIGN=-1
	IF(NUM.LT.0) NUM=-NUM
	IF(NUM.EQ.0) NUM=1
	IF(KPROM+NUM.GT.132) GO TO 101
	IF(ISIGN.GT.0.AND.NUM.GT.MAXNUM) GO TO 130
	IF(ISIGN.LT.0.AND.NUM.GT.MAXALP) GO TO 130
	IF(ICONST.GT.0) NUM=IQ-IZ
	IF(NUM.LE.0) NUM=1
	IF(ICONST.GT.0) INARR(1,ID)=1000+INARR(1,ID)
	INARR(2,ID)=ISIGN*NUM
C..
C..	FILL CHECK FIELDS
C..
C..	+NUMBER IS (BLANK=NO CHECK) GE/LE FIELDS
C..	ZNUMBER IS SAME AS +
C..	-NUMBER IS EQ FIELDS (BLANK=NO CHECK)
C..	?NUMBER IS VARIABLE ALPHA FIELDS, SAME AS -
C..
C..	SET UP LAST ENTRY ACCESS NUMBER
C..
	INARR(4,ID)=KARR+1
	MARR=INARR(4,ID)-1
C..
C..	SET UP = FOR PROMPT AFTER LAST ENTRY
C..
	KARR=KARR+NUM+1
	IF(KARR.GE.MARRAX) GO TO 888
	MARRAY(KARR)='='
	IF(IVAR.GT.0) MARRAY(KARR)='?'
C..
C..	SET UP CHECK ENTRIES OR CONSTANT FIELD
C..
	INARR(5,ID)=KARR+1
C..
C..	FILL IN DATA FIELDS
C..
	IVEN=0
15	IFLAG=0
	DO 14 I=1,NUM
	IF(INPUT(I+IZ).EQ.' ') IFLAG=IFLAG+1
	IF(ICONST.EQ.0) MARRAY(KARR+I)=INPUT(I+IZ)
	IF(ICONST.EQ.1) MARRAY(MARR+I)=INPUT(I+IZ)
14	CONTINUE
C..
C..	SEE IF OK TO GO ON
C..
	IF(IFLAG.EQ.NUM) GO TO 16
C..
C..	SAVE FIELD IN MARRAY
C..
	IVEN=IVEN+1
	KARR=KARR+NUM
	IF(KARR.GE.MARRAX) GO TO 888
	IZ=IZ+NUM
	IF(IZ+NUM.LE.IQ) GO TO 15
C..
C..	SET UP NEXT INARR POINTER, THEN FINISHED
C..
16	INARR(3,ID+1)=KARR+1
C..
C..	CHECK IF NUMBER AND EVEN NUMBER OF FIELDS
C..
	IF(INARR(2,ID).LT.0) RETURN
	IEVEN=IVEN/2
	IEVEN=IEVEN*2
	IF(IEVEN.EQ.IVEN) RETURN
	CALL ERROR(INPUT,IQ,'NUMBER OF CHECK FIELDS NOT EVEN..')
	GO TO 100
C..
C..	MEMORY OVERFLOW
C..
888	CALL ERROR(INPUT,IQ,'MEMORY OVERFLOW, SHORTEN PROMPTS ***..')
	GO TO 100
C..
C..	EOF
C..
99	IREC=-IREC
	RETURN
	END
	SUBROUTINE OUTPIN(INFILE,KOUT,NKOUT,MAXOUT,MAXID,TYPE,ENDX,IERR)
C.. INPUT2=OVERLAP CHECK FOR OUTPUT
	BYTE INPUT2(512),IBLANK
C.. KOUT=ARRAY FOR OUTPUT 1=FIELD, 2=COLUMN
	BYTE INPUT,MARRAY
	DIMENSION KOUT(2,MAXOUT)
	COMMON/IOCOM/INCR,IPR,IEOF,INPUT(512),INARR(5,99)
	COMMON/XIOCOM/MARRAX,MARRAY(1000)
	EQUIVALENCE (XDATA,INPUT)
	DATA MAXCOL/512/
C..
C..	OUTPUT SECTION
C..
C..	FORMAT IS #,ID,COLUMN,ID,COLUMN,...
C..	NKOUT=COUNTER FOR OUTPUT FORMAT 0=END OF RECORD SECTION
C..
4	IDATA=IHEAD+1
	IREC=-IREC
5	READ(INFILE,1,END=120)IQ,(INPUT(I),I=1,IQ)
1	FORMAT(Q,200A1)
	CALL DOBYTE(INPUT(IQ+1),INPUT(200),' ')
	IF(IQ.GT.200) CALL ERROR(INPUT,132,'OUTPUT DEFINITION GT 200..')
	IF(IQ.GT.200) IERR=IERR+1
	IREC=IREC+1
	IF(XDATA.EQ.TYPE.OR.XDATA.EQ.ENDX) GO TO 12
	BACKSPACE INFILE
	READ(INFILE,*,ERR=7)NUM,((KOUT(I,J+NKOUT),I=1,2),J=1,NUM)
6	FORMAT(80I6)
	NKOUT1=NKOUT+1
	NKOUT=NKOUT+NUM+1
	IF(NKOUT.LE.MAXOUT) GO TO 666
	CALL ERROR(INPUT,132,'MAXIMUM OUTPUT RECORDS OVERFLOW.')
	IERR=IERR+1
	RETURN
666	CONTINUE
	KOUT(1,NKOUT)=0
	KOUT(2,NKOUT)=0
C..
C..	TEST IF OK
C..
	NKOUT2=NKOUT-1
	DO 55 I=NKOUT1,NKOUT2
	ID=KOUT(1,I)
	IF(ID.GT.0.AND.ID.LE.MAXID.AND.INARR(1,ID).NE.0) GO TO 57
	IF(ID.NE.0)
     1 CALL ERROR(INPUT,IQ,'INVALID ID ENTERED FOR OUTPUT..')
	IF(ID.EQ.0)
     1 CALL ERROR(INPUT,IQ,'TO FEW IDS ENTERED FOR OUTPUT..')
58	IERR=IERR+1
	IF(ID.NE.0) WRITE(IPR,70)ID
70	FORMAT('            ID IN QUESTION=',I7)
	GO TO 55
C..
C..	CHECK FOR INVALID COLUMN
C..
57	IF(KOUT(2,I).GE.1.OR.KOUT(2,I).LE.MAXCOL) GO TO 55
	CALL ERROR(INPUT,IQ,'INVALID COLUMN NUMBER ENTERED..')
	GO TO 58
55	CONTINUE
C..
C..	TEST FOR OVERLAP
C..
	CALL DOBYTE(INPUT2,INPUT2(MAXCOL),' ')
	DO 56 I=NKOUT1,NKOUT2
	ID=KOUT(1,I)
	NCOL=KOUT(2,I)
	NUM=INARR(2,ID)
	IF(NUM.LT.0) NUM=-NUM
C.. SEE IF OUT OF BOUNDS
	IF(NUM+NCOL-1.LE.MAXCOL) GO TO 590
	CALL ERROR(INPUT,IQ,'ID PLUS SIZE OVER COLUMN 512.')
591	WRITE(IPR,70)ID
	IERR=IERR+1
	GO TO 56
590	DO 59 J=1,NUM
	IF(INPUT2(J+NCOL-1).EQ.' ') GO TO 51
	CALL ERROR(INPUT,IQ,'OUTPUT COLUMN OVERLAP FOUND..')
	WRITE(IPR,599)NCOL
599	FORMAT('     *** STARTING COLUMN NUMBER IS: ',I4,' ***')
	GO TO 591
51	INPUT2(J+NCOL-1)='X'
59	CONTINUE
56	CONTINUE
	GO TO 5
C.. ERROR
7	CALL ERROR(INPUT,IQ,'OUTPUT FORMAT INVALID..')
	IERR=IERR+1
	GO TO 5
C..
C..	RETURN TO MAIN ROUTINE
C..
120	XDATA=ENDX
12	RETURN
	END
	SUBROUTINE OUTCR(IDD,IRTN,KPNUM)
	BYTE DASH(80),IPROMP,NUM,INPUT,MARRAY
	COMMON /XFORMX/INFORM,MXFORM,IRECO
	COMMON/IOCOM/INCR,IPR,IEOF,INPUT(512),INARR(5,99)
	COMMON/XIOCOM/MARRAX,MARRAY(1000)
	DOUBLE PRECISION FNUM,FNUM1,FNUM2,FORMAX(20),FORNUM(1)
	DATA FORMAX/'(D1.0)','(D2.0)','(D3.0)','(D4.0)','(D5.0)'
     1 ,'(D6.0)','(D7.0)','(D8.0)','(D9.0)','(D10.0)',
     1 '(D11.0)','(D12.0)','(D13.0)','(D14.0)','(D15.0)'
     1 ,'(D16.0)','(D17.0)','(D18.0)','(D19.0)','(D20.0)'/
C..	KPNUM=NO CR OPTION IF 1
	DATA DASH/80*'-'/
C..
C..	CHECK IF OK TO PROMPT
C..
	IF(IDD.EQ.0) RETURN
C..
C..	CHECK FOR CONSTANT
C..
	IF(IDD.GT.1000) RETURN
C..
C..	SEE IF DONE BEFORE
C..
	ID=IDD
	IF(ID.LT.0) ID=-ID
C..
C..	SIZE, SEE IF NUMBER OR ALPHA
C..
	NUM=INARR(2,ID)
	KNUM=NUM
	IF(NUM.LT.0) KNUM=-NUM
	LX=INARR(3,ID)
C..
C..	CHECK FOR PREVIOUS TAB
C..
	IF(IRTN.EQ.0) GO TO 66
C..
C..	PRINT PROMPT
C..
	LINEXX=MXFORM+2*IRECO
	IF(LINEXX.GE.23) LINEXX=23
	CALL CRTCLR(LINEXX)
6	IX=LX
C..
C..	CHECK OUT IF FORM MODE
C..
	IF(INFORM.EQ.0) GO TO 500
C..
C..	FORM MODE
C..
	CALL CRTWRT(INFORM,0,MARRAY(IX))
	LX=IX
	ICOL=0
	DO 501 I=1,80
	IF(MARRAY(IX+I).EQ.':') ICOL=ICOL+1
	IF(ICOL.EQ.2) GO TO 502

501	CONTINUE
	I=80
502	I=I+1
	CALL CRTPOS(INFORM,I)
	GO TO 503
500	CALL CRTWRT(3,0,MARRAY(IX))
C..
C..	PLACE DASHES FOR SIZE
C..
	DASH(KNUM+1)=0
	CALL CRTWRT(4,0,DASH)
	DASH(KNUM+1)='-'
C..
C..	POSITION AND READ
C..
	CALL CRTPOS(4,0)
503	CONTINUE
	KNUM=KNUM+KPNUM
	CALL CRTRED(INPUT,KNUM,IACT,ISPEC)
	KNUM=KNUM-KPNUM
C..
C..	SEE IF <CR> TO REPEAT FIELD 
C..
	IRTN=1
	IF(IACT.EQ.0.AND.ISPEC.EQ.1) GO TO 50
C..
C..	SEE IF ESC FOR OK AND GO BACK ONE
C..
	IF(ISPEC.EQ.2) IRTN=-1
C..	SEE IF REPEAT FIELD ALSO
	IF(IACT.EQ.0.AND.IRTN.EQ.-1) GO TO 50
C..
C..	SEE IF TAB TO ERASE ALL FIELDS
C..
	IF(ISPEC.EQ.3) GO TO 67
C..
C..	SEE IF CTRL Z OR @ FOR EOF
C..
	IF(ISPEC.LT.0) GO TO 101
	IF(IACT.EQ.1.AND.INPUT(1).EQ.'@') GO TO 100
C..
C..	SEE IF CHECKS AVAILABLE PLUS GET PROMPT TYPE
C..
	IDHECK=INARR(5,ID)
	LCHECK=INARR(3,ID+1)-1
	IPROMP=MARRAY(IDHECK-1)
C..
C..		GO TO APPROPIATE RESPONSE
C..
C..SEE IF ONE BLANK CHARACTER
	IF(IACT.EQ.1.AND.INPUT(1).EQ.' ') GO TO 5
C..
C..	CHECK FOR SIZE OR VARIABLE SIZE OK
C..
	IF(IACT.NE.KNUM.AND.(IACT.GT.KNUM.OR.IPROMP.NE.'?')) GO TO 55
C..
C..	ALPHA OR NUMBER, DECODE AND GO TO CHECKS
C..
	FORNUM(1)='(80A1)'
	IOK=0
	IF(NUM.LT.0) GO TO 88
C.. CHECK FOR Z TYPE NUMBER
	MDIFF=NUM-IACT
	IF(MDIFF.EQ.0) GO TO 888
C.. SHIFT AND ZERO FILL
	CALL BYTEDO(INPUT(NUM),INPUT(MDIFF+1),INPUT(IACT))
	CALL DOBYTE(INPUT(1),INPUT(MDIFF),'0')
	IF(INPUT(NUM).EQ.' ') INPUT(NUM)='0'
	IACT=NUM
888	FORNUM(1)=FORMAX(NUM)
88	DECODE(IACT,FORNUM,INPUT,ERR=2)FNUM
C.. NO CHECKS
	IF(IDHECK.GT.LCHECK) GO TO 5
C..
C..	CHECKS AVAILABLE
C..
	IVEN=0
	DO 4 I=IDHECK,LCHECK,KNUM
C.. ALPHA
	IF(NUM.LT.0) GO TO 31
C.. NUMBER
	DECODE(KNUM,FORNUM,MARRAY(I))FNUM2
	IVEN=IVEN+1
	IF(IVEN.EQ.1) FNUM1=FNUM2
	IF(IVEN.EQ.1) GO TO 4
C..
C..	CHECK RANGE
C..
	IF(FNUM.GE.FNUM1.AND.FNUM.LE.FNUM2) IOK=1
	IVEN=0
	GO TO 4
C..
C..	ALPHA
C..
31	DO 32 II=1,KNUM
	IF(INPUT(II).NE.MARRAY(I+II-1)) GO TO 4
32	CONTINUE
	IOK=1
	GO TO 8
4	CONTINUE
C..
C..	CHECK IF OK
C..
8	IF(IOK.GE.1) GO TO 5
C..
C..	ERROR
C..
	IF(NUM.GT.0)
     1 CALL CRTERR(INPUT,IACT,'INVALID NUMBER ENTERED, TRY AGAIN..')
	IF(NUM.LT.0)
     1 CALL CRTERR(INPUT,IACT,'INVALID ALPHA ENTERED, TRY AGAIN..')
	GO TO 6
2	CALL CRTERR(INPUT,IACT,'INVALID NUMERIC FORMAT, TRY AGAIN..')
	GO TO 6
C..
C..	OK, SAVE RESPONSE
C..
5	IX=INARR(4,ID)
	CALL BYTEDO(MARRAY(IX),MARRAY(IX+KNUM-1),INPUT)
50	IF(INARR(1,ID).GT.0) INARR(1,ID)=-INARR(1,ID)
77	IF(IRTN.NE.0.AND.INFORM.EQ.0) CALL CRTWRT(3,0,0)
	IF(IRTN.NE.0.AND.INFORM.EQ.0) CALL CRTWRT(4,0,0)
	IF(INFORM.GT.0) CALL CRTWRT(INFORM,0,MARRAY(LX))
C.. REMOVE ASSECC FLAG IF <ESC> USED
	IF(IRTN.LT.0.AND.INARR(1,ID).LT.0) INARR(1,ID)=-INARR(1,ID)
	RETURN
C..
C..
C..	ERROR IN SIZE
C..
55	CALL CRTERR(INPUT,IACT,'INVALID SIZE OF ENTRY, TRY AGAIN..')
	GO TO 6
C..	CHECKS
C..
C..
C..	EOF REACHED
C..
101	IEOF=1
	GO TO 77
100	IEOF=1
	GO TO 77
C..
C..	TAB PREVIOUSLY SET
C..
67	IF(INFORM.EQ.0)CALL CRTCLR(3)
66	IACT=1
	CALL DOBYTE(INPUT,INPUT(KNUM),' ')
	IRTN=0
	GO TO 5
	END
	SUBROUTINE TYPEIN(INF,MAXID,MAXT,MIN,KTYPES,KBTYPE,ENDX,IERR)
C..
C..	THIS ROUTINE ENTERS TYPE DATA UNTIL END REACHED
C..
	BYTE INPUT,MARRAY
	COMMON/IOCOM/INCR,IPR,IEOF,INPUT(512),INARR(5,99)
	COMMON/XIOCOM/MARRAX,MARRAY(1000)
	COMMON/XMTY/MTYMAX,MTY(250)
	DIMENSION KTYPES(2,MAXT)
	BYTE KBTYPE(4,MAXT)
	EQUIVALENCE (XDATA,INPUT),(INTYPE,INPUT)
	DATA MTYMAX/250/
C..
C..	IPR	PRINT UNIT
C..	INF	READ UNIT
C..	INPUT	200 CHARACTER BUFFER
C..	MTY	250 WORD BUFFER FOR TYPES
C..	NTYPE	COUNTER IN MTY LOCATION
C..	INARR	SEE DATAENTRY MAIN PROGRAM
C..	MAXID CONTAINS MAX FIELD NUMBER
C..	MAXT CONTAINS MAX NUMBER OF TYPES
C..	MIN CONTAINS ACTUAL NUMBER OF TYPES
C..	MARRAY	CONTAINS MESSAGES, CHECKS AND LAST ENTRIES
C..	ENDX	REAL WORD CONTAINING 4 CHAR END FILE CONDITION
C..
	MIN=0
	NTYPE=0
100	NTYPE=NTYPE+1
336	READ(INF,1,END=99)IQ,(INPUT(I),I=1,IQ)
1	FORMAT(Q,200A1)
	CALL DOBYTE(INPUT(IQ+1),INPUT(200),' ')
	IREC=IREC+1
	IF(IQ.LE.0) GO TO 336
	IF(IQ.GT.200) CALL ERROR(INPUT,132,'TYPE DEFINITION GT 200..')
	IF(IQ.GT.200) IERR=IERR+1
	IF(XDATA.NE.ENDX) GO TO 3
	IREC=-IREC
	RETURN
C..
C..	FORMAT OF RECORD IS:
C..
C..   INTYPE,N,ID(1),ID(2),ID(3),...,ID(N)
C..  WHERE INTYPE = 1CHAR TYPE ID, N=NUMBER, ID(I)=FIELD NUMBERS
C..  OR
C..  INTYPE,LINK
C..  WHERE INTYPE=PREVIOUS TYPE AND LINK=PREVIOUS TYPE FOR LINK
C..
3	IF(INPUT(IQ).NE.' ') GO TO 3333
	IQ=IQ-1
	IF(IQ.GT.1) GO TO 3
3333	IF(IQ.GT.3) GO TO 333
C.. CHECK FOR LINKS
	DO 331 I=1,MIN
	IF(INPUT(1).EQ.KBTYPE(1,I)) GO TO 332
331	CONTINUE
335	CONTINUE
	CALL ERROR(INPUT,IQ,'INVALID TYPE LINK SETUP.')
	IERR=IERR+1
	GO TO 336
332	KBTYPE(2,I)=INPUT(3)
	IF(INPUT(2).NE.' '.AND.INPUT(2).NE.',') KBTYPE(2,I)=INPUT(2)
C.. CHECK FOR VALID LINK
	DO 334 I1=1,MIN
	IF(KBTYPE(2,I).EQ.KBTYPE(1,I1)) GO TO 336
334	CONTINUE
	GO TO 335
333	DECODE(IQ-2,5,INPUT(3),ERR=6)NUM,(MTY(I+NTYPE-1),I=1,NUM)
5	FORMAT(60I4)
C..	CHECK FOR ERRORS IN FIELD
	IF(MTYMAX.LT.NTYPE+NUM-1) GO TO 8
C..
C..	SAVE INFO
C..
	MIN=MIN+1
	IF(MIN.GT.MAXT) GO TO 8
	IF(INPUT(2).NE.' '.AND.INPUT(2).NE.',') GO TO 6
	INPUT(2)=' '
	KBTYPE(1,MIN)=INPUT(1)
	KBTYPE(2,MIN)=INPUT(1)
	KTYPES(2,MIN)=NTYPE
C..
C..	CHECK OVER DUP STUFF
C..
	DO 9 I=1,MIN
	IF(I.EQ.MIN) GO TO 9
	IF(KBTYPE(1,I).EQ.INPUT(1)) GO TO 10
9	CONTINUE
C..
C..	CHECK OVER VALID FIELDS
C..
	DO 50 I=1,NUM
	ID=MTY(I+NTYPE-1)
	IF(ID.LE.0.OR.ID.GT.MAXID.OR.INARR(1,ID).EQ.0) GO TO 7
50	CONTINUE
C..
C..	END SECTION, INCREASE COUNTER, NEXT SECTION
C..
	NTYPE=NTYPE+NUM
	MTY(NTYPE)=0
	GO TO 100
C..
C..	ERRORS
C..
8	CALL ERROR(INPUT,IQ,'MAXIMUM TYPE ARRAY MTY EXCEEDED..')
	IERR=IERR+1
	RETURN
6	CALL ERROR(INPUT,IQ,'FORMAT ERROR IN DATA..')
	IERR=IERR+1
	GO TO 100
7	CALL ERROR(INPUT,IQ,'FIELD IS OUT OF RANGE OF VALID FIELDS..')
	WRITE(IPR,51)ID
51	FORMAT(' *** FIELD IN QUESTION =',I6)
	IERR=IERR+1
	GO TO 100
10	CALL ERROR(INPUT,IQ,'DUPLICATED TYPE..')
	IERR=IERR+1
	GO TO 100
C..
C..	END SECTION
C..
99	CONTINUE
	RETURN
	END