	PROGRAM ENTER
C  PROGRAM TO ACCEPT ITEMS FROM A CRT.
C  This version works with a screen edit subroutine.
C  AUTHOR: Paul Lustgraaf,Iowa State University,Ames,Iowa 515-294-1832
	byte X(80),ID(12),iyes,ino,iblnk,nxt,item(5100)
	DATA IYES/'Y'/,INO/'N'/,IBLNK/' '/
	DATA IN/5/,IRED/2/,IOUT/3/
	type 8005
 8005	format('0Item entry using a screen editor.')
    1   type 8000
 8000   format('$IS THIS A NEW FILE? ')
	accept 8001,nxt
 8001	FORMAT(A1)
	if(nxt.eq.iyes) go to 10
	if(nxt.ne.ino) go to 1
	TYPE 8002
 8002	FORMAT('$ENTER NAME OF OLD FILE: ')
	CALL ASSIGN(IRED,' ',-1)
   10	TYPE 8003
 8003   FORMAT('$ENTER NAME OF NEW FILE: ')
	CALL ASSIGN(IOUT,' ',-1)
	IF(NXT.EQ.IYES) GO TO 101
C
C  COPY FROM OLD FILE TO NEW FILE
C
   20	READ(IRED,1001,END=49) X
	J=80
   22	IF(X(J).NE.IBLNK) GO TO 25
	J=J-1
	IF(J.GT.1) GO TO 22
   25	WRITE(IOUT,1001) (X(I),I=1,J)
	GO TO 20
   49	CALL CLOSE(IRED)
C
C  READ AN ITEM FROM THE CRT AND WRITE IT TO THE NEW FILE.
C
  101   type 7001
 7001   format('$ITEM SERIAL #? ')
	read(in,1001,end=890) (id(i),i=1,9)
	if(id(1).eq.iblnk) go to 890
	type 7002
 7002   format('$ITEM LEVEL? ')
	read(in,1001,end=890) id(10)
	type 7003
 7003   format('$ITEM TYPE? ')
	read(in,1001,end=890) id(11)
	type 7004
 7004   format('$ITEM ANSWER? ')
	read(in,1001,end=890) id(12)
	isize=0
	call clrsch
	call sgrr
	type 7005,id
 7005	format(' serial=',9a1,'  level=',a1,'   type=',a1,'   answer=',a1)
	call sgrp
	call pcstbm(2,24)
	call pcomr
	call edirtn(item,isize,64,5100,23,' ')
	call pcoma
	call pcstbm(1,24)
	call clrsch
	if(isize.eq.0) go to 890
	WRITE(IOUT,1201) ID
 1201   FORMAT('/',9A1,3(1X,A1))
	i=1
  110	j=i
	if(i.gt.isize) go to 150
  111	if(item(j).eq.0) go to 120
	j=j+1
	if(j.le.isize) go to 111
  120	j=j-1
	if(i.gt.j) go to 125
	write(iout,1001) (item(k),k=i,j)
 1001   format(80a1)
	go to  130
  125	WRITE(IOUT,1001)
  130	i=j+2
	go to 110
  150   GO TO 101
  890   continue
  999   STOP
	END
