
 	subroutine ScrnSub( Name, TextTable, NT, FldTable,
     1  NF, IntArray, NI, CharTable, NC, HelpTable, NR,
     1  RealArray, Text, NdimT, CharString, NdimC, Help,
     1  NdimH, Formats )


c	Parameters
c	----------

	integer*2 RowBegin, ColBegin, HorzLen, VertLen, StartField
	integer*2 First1, Last1, NT, NF, NI, NR, NC, NdimT, NdimC, NdimH

	integer*2 TextTable(5,NT), FldTable(7,NF), IntArray(5,NI),
     1   CharTable(2,NC), HelpTable(4,NF)
	real RealArray(5,NR)
	character*1 Text(NdimT), CharString(NdimC), Help(NdimH)
	character*7 Formats(NF)
	character*80 Menu
	logical*1 Next, Prev, Exit, Refresh, DoOutput, MenuEnabled
	logical*1 HelpEnabled
	integer*2 TermKeys(30), LastKey, KeyInBuf

	character*(*) Name
	integer*2 Intg
	real Real
	character*80 Chr
	logical*1 ValidField

	logical*1 IOisBuffered

c	Functions
c	---------

	logical*1 ValidRea, ValidInt, ValidDat,
     1   ChrRdy, Echo, FPBuffer
	integer*2 Length


c	Local data elements
c	-------------------

	integer*2 I, Index, FirstIndex, LastIndex, ITK, NTK
	integer*2 T, E, P, L, R, C, A, J, First, Last

	character*80 Buffer
	character*9 Fmt, TmpDate


c	Local constants
c	---------------

	integer*2 CR, Up, Down, CtlR
	integer*2 FTyp, FEle, FJust, FLth, FRow, FCol, FAttr
	integer*2 Val, LowLim, HighLim, Sprs, SprsVal
	integer*2 CPos, CNullOk
	integer*2 TPos, TLth, TRow, TCol, TAttr
	integer*2 TypeI, TypeR, TypeC, TypeL, TypeD, TypeM

	data CR /13/, Up /128/, Down /129/, CtlR /18/
	data FTyp, FEle, FJust, FLth, FRow, FCol, FAttr /1,2,3,4,5,6,7/
	data Val, LowLim, HighLim, Sprs, SprsVal /1,2,3,4,5/
	data Cpos, CNullOk /1,2/
	data Tpos, TLth, TRow, TCol, TAttr /1,2,3,4,5/
	data TypeI, TypeR, TypeC, TypeL, TypeD, TypeM /1,2,3,4,5,6/
	data MenuEnabled /.true./, HelpEnabled /.true./


c===========================================================================

	entry EnablScrnHelpLine

	  MenuEnabled = .true.

	return


	entry DsablScrnHelpLine

	  MenuEnabled = .false.

	return


	entry EnablHelpText

	  HelpEnabled = .true.

	return


	entry DsablHelpText

	  HelpEnabled = .false.

	return


	entry ClearScrn( RowBegin, ColBegin, HorzLen, VertLen )

	IOisBuffered = FPBuffer(0)
	if( .not. IOisBuffered ) call FPStartBuffer

	call DspAttribute( 0 )
	call EraseRegion( RowBegin, ColBegin, RowBegin+VertLen-1,
     1  		  ColBegin+HorzLen-1 )

	if( .not. IOisBuffered ) call FPStopBuffer

	return

c==========================================================================

	entry DsplyText( RowBegin, ColBegin, NT,
     1   TextTable, NdimT, Text )


	IOisBuffered = FPBuffer(0)
	if( .not. IOisBuffered ) call FPStartBuffer

c--
c Initialization
c--
	call SetOrigin( RowBegin, ColBegin )

c--
c Display the text
c--
	do 100 I = 1 , NT

	  call DspAttribute( TextTable(TAttr,I) )

	  call RelCsrPos( TextTable(TRow,I), TextTable(TCol,I) )

	  P = TextTable(TPos,I)
	  L = TextTable(TLth,I)

	  call A1toAN( NdimT, Text, P, L, Buffer )
	  call OutString( Buffer(1:L) )

100	continue

	call DspAttribute(0)

	if( .not. IOisBuffered ) call FPStopBuffer

	return


c===========================================================================

	entry DsplyData( RowBegin, ColBegin, First1, Last1, NF,
     1   FldTable, NI, IntArray, NR, RealArray, NC, CharTable, NdimC,
     1   CharString, Formats )


	IOisBuffered = FPBuffer(0)
	if( .not. IOisBuffered ) call FPStartBuffer

c--
c Initialization
c--
	call SetOrigin( RowBegin, ColBegin )

	First = First1
	Last = Last1
	if( First .lt. 1 ) First = 1
	if( First .gt. NF ) First = NF
	if( Last .lt. 1 ) Last = 1
	if( Last .gt. NF ) Last = NF

c--
c Display all the data entry fields
c--
	do 200 I = First, Last

	  Buffer = ' '

	  T = FldTable(FTyp,I)
	  E = FldTable(FEle,I)
	  L = FldTable(FLth,I)
	  A = FldTable(FAttr,I)
	  J = FldTable(FJust,I)
	  R = FldTable(FRow,I)
	  C = FldTable(FCol,I)


	  if( T .eq. TypeC .or. T .eq. TypeL .or.
     1        T .eq. TypeM .or. T .eq. TypeD ) then
	    P = CharTable(CPos,E)
	    call A1toAN( NdimC, CharString, P, L, Buffer )
	  else
	    Fmt(1:1) = '('
	    Fmt(2:8) = Formats(I)(1:7)
	    Fmt(9:9) = ')'
	    if( T .eq. TypeI ) then
	      write( Buffer, Fmt ) IntArray(Val,E)
	      if( IntArray(Sprs,E) .gt. 0 .and.
     1           IntArray(SprsVal,E) .eq. IntArray(Val,E) ) then
	        Buffer = ' '
	      end if
	    else if( T .eq. TypeR ) then
	      write( Buffer, Fmt ) RealArray(Val,E)
	      if( RealArray(Sprs,E) .gt. 0 .and.
     1           RealArray(SprsVal,E) .eq. RealArray(Val,E) ) then
	        Buffer = ' '
	      end if
	    end if
	  end if

	  call Justify( J, Buffer(1:L) )
	  call DspAttribute( A )
	  call RelCsrPos( R, C )
	  call OutString( Buffer(1:L) )

200	continue

	call DspAttribute(0)

	if( .not. IOisBuffered ) call FPStopBuffer

	return

c===========================================================================

	entry EditScrn( Name, RowBegin, ColBegin, First1, Last1,
     1   StartField, Menu, TermKeys, NF, FldTable, NI, IntArray,
     1   NR, RealArray, NC, CharTable, NdimC, CharString, Formats,
     1   HelpTable, NdimH, Help, Next, Prev, Exit, Refresh, LastKey )


	IOisBuffered = FPBuffer(0)
	if( .not. IOisBuffered ) call FPStartBuffer

c--
c Initialization
c--
	call ResetChangeFlag

	if( Echo(0) ) call TTYset
	call DspAttribute( 0 )
c	if( HelpEnabled ) call EraseRegion( 23, 1, 24, 80 )
	call SetOrigin( RowBegin, ColBegin )

	First = First1
	Last = Last1
	if( First .lt. 1 ) First = 1
	if( First .gt. NF ) First = NF
	if( Last .lt. 1 ) Last = 1
	if( Last .gt. NF ) Last = NF

c--
c display the Menu line ( if not disabled )
c--
	if( MenuEnabled ) then
	  call DspAttribute( 3 )
	  call CsrPos( 22, 1 )
	  call Cnter( Menu )
	  call OutString( Menu )
	end if

c--
c Allow data entry for each field until a termination condition is encountered
c--

	Next = .false.
	Prev = .false.
	Exit = .false.
	Refresh = .false.
	LastKey = 0
	if( StartField .ge. First .and. StartField .le. Last ) then
	  I = StartField
	else
	  I = First
	end if

c--
c find the first "non-label" field from the start field
c--
	if( FldTable(1,I) .ne. 4 ) goto 1000

c--
c If the startfield is a label field then search all fields for
c the first non-label field. If no non-label fields then
c set exit and return.
c--

	J = I + 1
	if( J .gt. Last ) J = First
900	continue

	if( FldTable(1,J) .ne. 4 ) then
	  I = J
	  goto 1000
	end if

	J = J + 1
	if( J .gt. Last ) J = First
	if( J .eq. I ) then
	  Exit = .true.
	  goto 2000
	end if

	goto 900

c	repeat until LastKey is not a termination character and not a
c	  field command ( CR, up, or down ) and not zero

1000	continue

c--
c Process first set of termination keys - these cause termination after
c input validation ( including limit chaecking and null string checking ).
c--
	if( LastKey .ne. 0 ) then
	  LastIndex = TermKeys(1)+1
	  if( LastIndex .gt. 30 ) LastIndex = 30
	  do 1050 Index = 2 , LastIndex
	    if( LastKey .eq. TermKeys(Index) ) goto 2000
1050	  continue
	end if

c--
c Set termination flags base on termination condition
c--
	if( LastKey .eq. 26 ) then
	  Exit = .true.
	  goto 2000
	else if(( LastKey.eq.CR .or. LastKey.eq.Down ) ) then
	  if( I .lt. Last ) then
	    I = I + 1
	  else
	    Next = .true.
	    goto 2000
	  end if
	else if( LastKey.eq.Up ) then
	  if( I .gt. First ) then
	    I = I - 1
	  else
	    Prev = .true.
	    goto 2000
	  end if
	end if

1100	continue

	  StartField = I

	  Buffer = ' '

	  T = FldTable(FTyp,I)

c     { don't allow entry for a label type field }
	  if( T .eq. TypeL ) then
	    if( LastKey .eq. CR .or. LastKey .eq. Down ) then
	      if( I .lt. Last ) then
	        I = I + 1
	      else
	        Next = .true.
	        goto 2000
	      end if
	    else if( LastKey .eq. Up ) then
	      if( I .gt. First ) then
	        I = I - 1
	      else
	        Prev = .true.
	        goto 2000
	      end if
	    end if
	    goto 1100
	  end if

	  E = FldTable(FEle,I)
	  L = FldTable(FLth,I)
	  A = FldTable(FAttr,I)
	  J = FldTable(FJust,I)
	  R = FldTable(FRow,I)
	  C = FldTable(FCol,I)

	  if( T .eq. TypeC .or. T .eq. TypeD .or. T .eq. TypeM ) then
	    P = CharTable(CPos,E)
	    call A1toAN( NdimC, CharString, P, L, Buffer )
	  else
	    Fmt(1:1) = '('
	    Fmt(2:8) = Formats(I)(1:7)
	    Fmt(9:9) = ')'
	    if( T .eq. TypeI ) then
	      if( IntArray(Sprs,E) .gt. 0 .and.
     1           IntArray(SprsVal,E) .eq. IntArray(Val,E) ) then
	        Buffer = ' '
	      else
	        write( Buffer, Fmt ) IntArray(Val,E)
	      end if
	    else if( T .eq. TypeR ) then
	      if( RealArray(Sprs,E) .gt. 0 .and.
     1           RealArray(SprsVal,E) .eq. RealArray(Val,E) ) then
	        Buffer = ' '
	      else
	        write( Buffer, Fmt ) RealArray(Val,E)
	      end if
	    end if
	  end if

3000	  continue

c--
c if the field is a menu field or
c if the next key in the buffer is a up, down, or carriage return
c then don't display the help text or output the field
c--

c	  if( T .ne. TypeM ) then

	    if( .not. ChrRdy(0) ) call Snooze(100)
	    call NextChar( KeyInBuf )
	    if( KeyInBuf .ne. Up .and. KeyInBuf .ne. Down
     1               	         .and. KeyInBuf .ne. CR   ) then
	      DoOutput = .true.
	    else
	      DoOutput = .false.
	    end if

c	  else

c	    DoOutput = .false.

c	  end if


	  if( DoOutput ) then

	    if( HelpEnabled .and. T .ne. TypeM ) then
	      call DsplHelpText( I, NF, HelpTable, NdimH, Help )
	    end if

	    if( J .ne. 0 ) call LeftJustify( Buffer(1:L) )
	    call DspAttribute( A )
	    call RelCsrPos( R, C )
	    call OutString( Buffer(1:L) )

	  end if

	  if( T .ne. TypeM ) then

	    call LineEdit( R, C, Buffer(1:L), TermKeys,
     1       LastKey )

	  else

	    call InpFromMenu( R, C, I, NF, HelpTable, NdimH, Help,
     1       Buffer(1:L), TermKeys, LastKey )

	  end if


c--
c If a date then convert "TODAY" to today's date )
c--
	  if( T .eq. TypeD .and. Length(Buffer(1:L)) .ne. 0 ) then

	    TmpDate = Buffer(1:L)
 	    call CvtToUpCase( TmpDate )
	    if( TmpDate .eq. 'TODAY' ) then
	      call Today( Buffer(1:L) )
	    end if

	  end if


c--
c process second set of termination keys - these cause
c immediate termination - no input validation is done.
c--
	  ITK = TermKeys(1) + 2
	  FirstIndex = ITK+1
	  if( FirstIndex .lt. 3 ) goto 1052

	  NTK = TermKeys(ITK)
	  LastIndex = ITK+NTK
	  if( LastIndex .gt. 30 ) LastIndex = 30

	  do 1051 Index = FirstIndex , LastIndex
	    if( LastKey .eq. TermKeys(Index) ) then
	      if( T .eq. TypeC .or. T .eq. TypeD ) then
	        call ANtoA1( Buffer, NdimC, CharString, P, L )
	      end if
	      goto 2000
	    end if
1051	  continue
1052	  continue

	  if( LastKey .eq. CtlR ) then
	    if( T .eq. TypeC .or. T .eq. TypeD .or. T .eq. TypeM ) then
	      call ANtoA1( Buffer, NdimC, CharString, P, L )
	    end if
	    Refresh = .true.
	    goto 2000
	  end if


c--
c Check for invalid entry of integer or real.
c--
	  if( T .eq. TypeI ) then
	    if( .not. ValidInt( Buffer(1:L) ) ) then
	      call InvalidEntry
	      call FlushBuffer
	      goto 3000
	    end if
	  else if( T .eq. TypeR ) then
	    if( .not. ValidRea( Buffer(1:L) ) ) then
	      call InvalidEntry
	      call FlushBuffer
	      goto 3000
	    end if
	  end if


	  if( T .eq. TypeC .or. T .eq. TypeD .or. T .eq. TypeM ) then
	    call ANtoA1( Buffer, NdimC, CharString, P, L )
	  else
	    if( T .eq. TypeI ) then
	      if( Length(Buffer) .gt. 0 ) then
	        call GetInteger( Buffer(1:L), IntArray(Val,E) )
	      else
	        if( IntArray(Sprs,E) .gt. 0 ) then
	          IntArray(Val,E) = IntArray(SprsVal,E)
	        end if
	      end if
	    else if( T .eq. TypeR ) then
	      if( Length(Buffer) .gt. 0 ) then
	        call GetReal( Buffer(1:L), RealArray(Val,E) )
	      else
	        if( RealArray(Sprs,E) .gt. 0.0 ) then
	          RealArray(Val,E) = RealArray(SprsVal,E)
	        end if
	      end if

	    end if
	  end if

c--
c Perform user supplied field validation
c--

	if( T .eq. TypeI ) then
	  Intg = IntArray(Val,E)
 	  Real = 0.0
	  Chr = ' '
	  call ValScr( Name, I, Intg, Real, Chr, ValidField )
	  if( .not. ValidField ) then
	    call FlushBuffer
	    goto 3000
	  end if
	else if( T .eq. TypeR ) then
	  Intg = 0
 	  Real = RealArray(Val,E)
	  Chr = ' '
	  call ValScr( Name, I, Intg, Real, Chr, ValidField )
	  if( .not. ValidField ) then
	    call FlushBuffer
	    goto 3000
	  end if
	else if( T .eq. TypeC .or. T .eq. TypeD ) then
	  Intg = 0
 	  Real = 0.0
	  call ValScr( Name, I, Intg, Real, Buffer(1:L), ValidField )
	  if( .not. ValidField ) then
	    call FlushBuffer
	    goto 3000
	  end if
	end if

c--
c Check	limits for integer or real.
c--
	  if( T .eq. TypeI ) then

	    if( IntArray(Sprs,E) .eq. 2 .and.
     1        IntArray(SprsVal,E) .eq. IntArray(Val,E) ) then

	      call NullEntryIllegal
	      call FlushBuffer
	      goto 3000

	    end if

	    if( IntArray(Sprs,E) .eq. 0 .or.
     1         IntArray(SprsVal,E) .ne. IntArray(Val,E) ) then

	      if( IntArray(LowLim,E) .ne. 0 .or.
     1        IntArray(HighLim,E) .ne. 0 ) then
	        if( IntArray(Val,E) .lt. IntArray(LowLim,E) .or.
     1          IntArray(Val,E) .gt. IntArray(HighLim,E) ) then
	          call OutOfLimits
	          call FlushBuffer
	          goto 3000
	        end if
	      end if

	    end if

	  else if( T .eq. TypeR ) then

	    if( RealArray(Sprs,E) .eq. 2.0 .and.
     1        RealArray(SprsVal,E) .eq. RealArray(Val,E) ) then

	      call NullEntryIllegal
	      call FlushBuffer
	      goto 3000

	    end if

	    if( RealArray(Sprs,E) .eq. 0.0 .or.
     1         RealArray(SprsVal,E) .ne. RealArray(Val,E) ) then

	      if( RealArray(LowLim,E) .ne. 0.0 .or.
     1        RealArray(HighLim,E) .ne. 0.0 ) then
	        if( RealArray(Val,E) .lt. RealArray(LowLim,E) .or.
     1          RealArray(Val,E) .gt. RealArray(HighLim,E) ) then
	          call OutOfLimits
	          call FlushBuffer
	          goto 3000
	        end if
	      end if

	    end if

c--
c write ints and reals back to buffer

	  if( T .eq. TypeI ) then
	    Buffer = ' '
	    if( IntArray(Sprs,E) .eq. 0 .or.
     1         IntArray(SprsVal,E) .ne. IntArray(Val,E) ) then
	      write( Buffer, Fmt ) IntArray(Val,E)
	    end if

	  else if( T .eq. TypeR ) then
	    Buffer = ' '
	    if( RealArray(Sprs,E) .eq. 0 .or.
     1         RealArray(SprsVal,E) .ne. RealArray(Val,E) ) then
	      write( Buffer, Fmt ) RealArray(Val,E)
	    end if

	  end if

c--
c Check null entry ( if null entry is not allowed for strings and dates
c--
	  else if( T .eq. TypeC .or. T .eq. TypeD ) then
	    if( CharTable(CNullOk,E) .eq. 0 .and.
     1         Length( Buffer(1:L) ) .eq. 0 ) then
	      call NullEntryIllegal
	      call FlushBuffer
	      goto 3000
	    end if
	  end if

c--
c validate the date for a non-null date entry
c--
	  if( T .eq. TypeD .and. Length(Buffer(1:L)) .ne. 0 ) then

	    if( .not. ValidDat( Buffer(1:L) ) ) then
	      call DateNotValid
	      call FlushBuffer
	      goto 3000
	    end if

	  end if

c--
c changed logic here for character types only 9-25-87
c--
	  if( T .eq. TypeC ) then
	    if( J .eq. 0 ) then
	      DoOutput = .false.
	    else if( J .eq. 1 ) then
	      if( Buffer(1:1) .ne. ' ' ) DoOutput = .false.
	    else if( J .eq. 2 ) then
	      if( Buffer(L:L) .ne. ' ' ) DoOutput = .false.
	    end if
	  end if

c	  if( T .eq. TypeM ) DoOutput = .true.

	  if( DoOutput ) then

	    call Justify( J, Buffer(1:L) )
	    call DspAttribute( A )
	    call RelCsrPos( R, C )
	    call OutString( Buffer(1:L) )

	  end if

c	end repeat
	goto 1000

2000	continue

	call DspAttribute( 0 )
	if( Echo(0) ) call TTYrst

	if( .not. IOisBuffered ) call FPStopBuffer

	return
	end

c===========================================================================


	subroutine InpFromMenu( CsrRow, CsrCol, I, NF, HelpTable,
     1   NdimH, Help, String, TermKeys, LastKey )


	integer*2 I, NF, HelpTable(4,NF), NdimH, TermKeys(30), LastKey
	integer*2 CsrRow, CsrCol
	character*1 Help(NdimH)
	character*(*) String
	character*80 Buffer, OneItem
	character*80 Original
	integer*2 StrLength
	character*40 PossibleValues

	integer*2 J, P1, L1, P2, L2, Item

	integer*2 Pntr(2,40) , WordLength(40) , NumWords, Err
	integer*2 P(2,3), WL(3), NW


c -- functions

	integer*2 Length

	StrLength = len( String )
	Original(1:StrLength) = String

	do 100 J = 1 , Length( String )
	  if( String(J:J) .eq. ' ' ) String(J:J) = '_'
100	continue

	call DspAttribute( 2 )

	call EraseRegion( 23, 1, 24, 80 )

	P1 = HelpTable(1,I)
	L1 = HelpTable(2,I)
	if( P1 .ne. 0 ) then
	  call CsrPos( 23, 1 )
	  call A1toAN( NdimH, Help, P1, L1, Buffer )
	  call OutString( Buffer(1:L1) )
	end if


	P2 = HelpTable(3,I)
	L2 = HelpTable(4,I)
	call A1toAN( NdimH, Help, P2, L2, Buffer )

	call Parse( Buffer(1:L2), ' ', ' ', ' ',
     1   40, Pntr, WordLength, NumWords, Err )

	do 50 J = 1 , NumWords
	  OneItem = Buffer(Pntr(1,J):Pntr(2,J))
	  call Parse( OneItem(1:WordLength(J)), ' ', ' ', '|',
     1     3, P, WL, NW, Err )
	  if(OneItem(P(1,NW):P(2,NW)) .eq. String)then
	    Item = J
	    goto 60
	  end if
50	continue
	Item = 1
60	continue

	PossibleValues = ' '
	do 70 J = 1 , NumWords
	  PossibleValues(J:J) = Buffer(Pntr(1,J):Pntr(1,J))
70	continue
	call CvtToUpCase( PossibleValues )

	call ScrMnu( CsrRow, CsrCol, 24, Buffer(1:L2),
     1   PossibleValues(1:NumWords), TermKeys, LastKey, Item )

	call Parse( Buffer(1:L2), ' ', ' ', ' ',
     1   40, Pntr, WordLength, NumWords, Err )

	OneItem = Buffer(Pntr(1,Item):Pntr(2,Item))

	call Parse( OneItem(1:WordLength(Item)), ' ', ' ', '|',
     1   3, P, WL, NW, Err )

	String = OneItem(P(1,NW):P(2,NW))

	do 200 J = 1 , Length( String )
	  if( String(J:J) .eq. '_' ) String(J:J) = ' '
200	continue

	call EraseRegion( 23, 1, 24, 80 )

	if( Original(1:StrLength) .ne. String ) call SetChangeFlag

	return
	end



	subroutine DsplHelpText( I, NF, HelpTable, NdimH, Help )

	integer*2 I, NF, HelpTable(4,NF), NdimH
	character*1 Help(NdimH)
	character*80 Buffer

	integer*2 P1, L1, P2, L2, LastL1, LastL2

	data LastL1 /0/ , LastL2 /0/

	call DspAttribute( 2 )

	if( LastL1 .gt. 0 ) then
	  call EraseRegion( 23, 1, 23, 80 )
	end if

	if( LastL2 .gt. 0 ) then
	  call EraseRegion( 24, 1, 24, 80 )
	end if

	P1 = HelpTable(1,I)
	L1 = HelpTable(2,I)
	if( P1 .ne. 0 ) then
	  call CsrPos( 23, 1 )
	  call A1toAN( NdimH, Help, P1, L1, Buffer )
	  call OutString( Buffer(1:L1) )
	end if

	P2 = HelpTable(3,I)
	L2 = HelpTable(4,I)
	if( P2 .ne. 0 ) then
	  call CsrPos( 24, 1 )
	  call A1toAN( NdimH, Help, P2, L2, Buffer )
	  call OutString( Buffer(1:L2) )
	end if

	LastL1 = L1
	LastL2 = L2

	return
	end


	subroutine A1toAN( Ndim, CharArray, P, L, String )

	integer*2 Ndim, P, L, Ichr, I

	character*1 CharArray(Ndim)
	character*(*) String

	String = ' '

	Ichr = P
	do 10 I = 1 , L
	  String(I:I) = CharArray(Ichr)
	  Ichr = Ichr + 1
10	continue

	return
	end


	subroutine ANtoA1( String, Ndim, CharArray, P, L )

	integer*2 Ndim, P, L, Ichr, I

	character*1 CharArray(Ndim)
	character*(*) String

	Ichr = P
	do 10 I = 1 , L
	  CharArray(Ichr) = String(I:I)
	  Ichr = Ichr + 1
10	continue

	return
	end


	subroutine VldWholeScreen( First1, Last1, NF, FldTable,
     1   NI, IntArray, NR, RealArray, NC, CharTable, NdimC,
     1   CharString, Name, Valid, FldNumber )


c--
c Validate the entire page of fields
c--


c	Parameters
c	----------

	integer*2 NF, NI, NR, NC, NdimC, First1, Last1

	integer*2 FldTable(7,NF), IntArray(5,NI),
     1   CharTable(2,NC)
	real RealArray(5,NR)
	character*1 CharString(NdimC)

	integer*2 FldNumber
	logical*1 Valid

	character*(*) Name
	integer*2 Intg
	real Real
	character*80 Chr
	logical*1 ValidField


c	Functions
c	---------

	logical*1 ValidDat
	integer*2 Length


c	Local data elements
c	-------------------

	integer*2 I, T, E, P, L, First, Last

	character*80 Buffer


c	Local constants
c	---------------

	integer*2 FTyp, FEle, FLth
	integer*2 Val, LowLim, HighLim, Sprs, SprsVal
	integer*2 CPos, CNullOk
	integer*2 TypeI, TypeR, TypeC, TypeL, TypeD

	data FTyp, FEle, FLth /1,2,4/
	data Val, LowLim, HighLim, Sprs, SprsVal /1,2,3,4,5/
	data Cpos, CNullOk /1,2/
	data TypeI, TypeR, TypeC, TypeL, TypeD /1,2,3,4,5/



	Valid = .true.

	First = First1
	Last = Last1
	if( First .lt. 1 ) First = 1
	if( First .gt. NF ) First = NF
	if( Last .lt. 1 ) Last = 1
	if( Last .gt. NF ) Last = NF

	do 100 I = First , Last

	  T = FldTable(FTyp,I)

	  if( T .eq. TypeL ) goto 90

	  E = FldTable(FEle,I)

c--
c Perform user supplied field validation
c--

	if( T .eq. TypeI ) then
	  Intg = IntArray(Val,E)
 	  Real = 0.0
	  Chr = ' '
	  call ValScr( Name, I, Intg, Real, Chr, ValidField )
	  if( .not. ValidField ) then
	    call FlushBuffer
	    goto 1000
	  end if
	else if( T .eq. TypeR ) then
	  Intg = 0
 	  Real = RealArray(Val,E)
	  Chr = ' '
	  call ValScr( Name, I, Intg, Real, Chr, ValidField )
	  if( .not. ValidField ) then
	    call FlushBuffer
	    goto 1000
	  end if
	else if( T .eq. TypeC .or. T .eq. TypeD ) then
	  Intg = 0
 	  Real = 0.0
	  Buffer = ' '
	  P = CharTable(CPos,E)
	  L = FldTable(FLth,I)
	  call A1toAN( NdimC, CharString, P, L, Buffer )
	  call ValScr( Name, I, Intg, Real, Buffer(1:L), ValidField )
	  if( .not. ValidField ) then
	    call FlushBuffer
	    goto 1000
	  end if
	end if



	  if( T .eq. TypeI ) then

c--
c Check	if suppressed value is illegal
c--

	    if( IntArray(Sprs,E) .eq. 2 .and.
     1        IntArray(SprsVal,E) .eq. IntArray(Val,E) ) then

	      call NullEntryIllegal
	      call FlushBuffer
	      goto 1000

	    end if

c--
c Check	limits for integer
c--
	    if( IntArray(Sprs,E) .eq. 0 .or.
     1         IntArray(SprsVal,E) .ne. IntArray(Val,E) ) then

	      if( IntArray(LowLim,E) .ne. 0 .or.
     1        IntArray(HighLim,E) .ne. 0 ) then
	        if( IntArray(Val,E) .lt. IntArray(LowLim,E) .or.
     1          IntArray(Val,E) .gt. IntArray(HighLim,E) ) then
	          call OutOfLimits
	          call FlushBuffer
	          goto 1000
	        end if
	      end if

	    end if


	  else if( T .eq. TypeR ) then
c--
c Check	if suppressed value is illegal
c--

	    if( RealArray(Sprs,E) .eq. 2.0 .and.
     1        RealArray(SprsVal,E) .eq. RealArray(Val,E) ) then

	      call NullEntryIllegal
	      call FlushBuffer
	      goto 1000

	    end if

c--
c Check	limits for real
c--
	    if( RealArray(Sprs,E) .eq. 0.0 .or.
     1         RealArray(SprsVal,E) .ne. RealArray(Val,E) ) then

	      if( RealArray(LowLim,E) .ne. 0.0 .or.
     1        RealArray(HighLim,E) .ne. 0.0 ) then
	        if( RealArray(Val,E) .lt. RealArray(LowLim,E) .or.
     1          RealArray(Val,E) .gt. RealArray(HighLim,E) ) then
	          call OutOfLimits
	          call FlushBuffer
	          goto 1000
	        end if
	      end if

	    end if


	  else if( T .eq. TypeC .or. T .eq. TypeD ) then
c--
c Check for null entry of character or date
c--

	    if( CharTable(CNullOk,E) .eq. 0 .and.
     1         Length( Buffer(1:L) ) .eq. 0 ) then
	      call NullEntryIllegal
	      call FlushBuffer
	      goto 1000
	    end if

	    if( T .eq. TypeD .and. Length(Buffer(1:L)) .ne. 0 ) then
c--
c validate the date for a non-null date entry
c--
	      if( .not. ValidDat( Buffer(1:L) ) ) then
	        call DateNotValid
	        call FlushBuffer
	        goto 1000
	      end if

	    end if

	  end if


90	  continue

100	continue

	return

1000	continue

	Valid = .false.
	FldNumber = I

	end

c===========================================================================

	subroutine ValScr( Name, Field, Intg, Real, Chr, Valid )

c--
c
c This routine is always called after a field is edited and
c should be written for each application. This particular routine
c is a stub that will be used if one is not present in the application
c link list.
c
c	Parameters
c
c	Name	character*(*)	Input	- Name of screen being edited
c
c	Field	integer		Input	- Number of field being edited
c
c	Intg	integer		Input	- value of integer type
c
c	Real	real		Input	- value of real type
c
c	Chr	character	Input	- value of character or date
c
c	Valid	logical		Output	- true if field is valid else false
c
c---

	character*(*) Name, Chr
	integer*2 Field, Intg
	real Real
	logical*1 Valid

	Valid = .true.

	end




      SUBROUTINE ScrMnu( CsrRow, CsrCol, ROW, STRING, POSSIBLEVALUES,
     1  TermKeys, LastKey, ITEMSELECTED )

C--
C Similar to LOTUS menu
C--


c     Subroutine DspMenuItem is in Menu1.for[100,115,fpaint,lib]
c     Object is in the library Fpaint.rel[100,115,aid]


C     PARAMETERS
C     ----------

      CHARACTER*(*) STRING, POSSIBLEVALUES
      INTEGER*2 CsrRow, CsrCol, ROW, TermKeys(30), LastKey,
     1  ITEMSELECTED


C     LOCAL DATA ELEMENTS
C     -------------------

      INTEGER*2 STATE, CHR, LEN,
     1 Selection, LASTITEM, ITK, NTK, FirstIndex,
     1 LastIndex, NumOfPossibleValues, Attr,
     1 LEFT, RIGHT, Up, Down, RETURN, CtrlZ, CtrlR,
     1 I, NITEMS, STARTCOL(20), ENDCOL(20)
      CHARACTER*1 SINGLECHAR
      CHARACTER*80 BUFFER


C     FUNCTIONS
C     ---------

      INTEGER*2 LENGTH


      DATA LEFT /130/ , RIGHT /131/ , Up /128/ ,
     1 Down /129/ , RETURN /13/ , CtrlZ /26/ , CtrlR /18/
C<PAGE>

      CALL SAVEATTRIBUTE

      NUMOFPOSSIBLEVALUES = LENGTH( POSSIBLEVALUES )

      LEN = LENGTH( STRING )

      CALL DSPATTRIBUTE(0)
      CALL ERASEREGION( ROW, 1, ROW, 80 )
      CALL DSPATTRIBUTE(2)


      CHR = 0
      NITEMS = 0
      STATE = 1
      DO 100 I = 1 , LEN
         CHR = ICHAR( STRING(I:I) )
         IF( STATE .EQ. 1 ) THEN
           IF( CHR .NE. 32 ) THEN
             IF( CHR .EQ. 95 .OR. CHR .EQ. 124 ) CHR = 32
             BUFFER(I:I) = CHAR( CHR )
             NITEMS = NITEMS + 1
             STARTCOL(NITEMS) = I
             STATE = 2
           ELSE
             BUFFER(I:I) = ' '
           END IF
         ELSE IF( STATE .EQ. 2 ) THEN
           IF( CHR .EQ. 32 ) THEN
             ENDCOL(NITEMS) = I - 1
             STATE = 1
             BUFFER(I:I) = ' '
           ELSE
             IF( CHR .EQ. 95 .OR. CHR .EQ. 124 ) CHR = 32
             BUFFER(I:I) = CHAR( CHR )
           END IF
         END IF
100   CONTINUE

      ENDCOL(NITEMS) = LEN

      IF( ITEMSELECTED .LT. 1 .OR. ITEMSELECTED .GT. NITEMS ) THEN
        ITEMSELECTED = 1
      END IF
      LASTITEM = ITEMSELECTED

C--
C Output the menu line
C--
      IF( LEN .GT. 0 ) CALL OUTSTRING( BUFFER(1:LEN) )


C--
C Do until SELECTION is a left or right arrow, a <CR>, or a termination key
C--
200   CONTINUE

      ATTR = 2
      CALL DSPMENUITEM( BUFFER, LEN, ROW, ITEMSELECTED,
     1 LASTITEM, NITEMS, STARTCOL, ENDCOL, ATTR )

      LASTITEM = ITEMSELECTED

      call RelCsrPos( CsrRow, CsrCol )
      CALL FPGetChar( SELECTION )

      IF( SELECTION .EQ. RIGHT ) THEN
        ITEMSELECTED = ITEMSELECTED+1
        IF( ITEMSELECTED .GT. NITEMS ) ITEMSELECTED = 1
        GOTO 200

      ELSE IF( SELECTION .EQ. LEFT ) THEN
        ITEMSELECTED = ITEMSELECTED-1
        IF( ITEMSELECTED .LT. 1 ) ITEMSELECTED = NITEMS
        GOTO 200

      ELSE IF( SELECTION .EQ. RETURN .OR.
     1         SELECTION .EQ. UP .OR.
     1         SELECTION .EQ. DOWN .OR.
     1         SELECTION .EQ. CtrlZ .OR.
     1         SELECTION .EQ. CtrlR ) THEN
	LastKey = Selection
        GOTO 400

      else

	LastIndex = TermKeys(1)+1
	if( LastIndex .gt. 30 ) LastIndex = 30
	do 450 ITK = 2 , LastIndex
	  if( Selection .eq. TermKeys(ITK) ) then
	    LastKey = Selection
            GOTO 400
	  end if
450	continue

	FirstIndex = TermKeys(1) + 3
	if( FirstIndex .lt. 3 ) goto 461

	NTK = TermKeys(ITK)
	LastIndex = ITK+NTK
	if( LastIndex .gt. 30 ) LastIndex = 30

	do 460 ITK = FirstIndex , LastIndex
	  if( Selection .eq. TermKeys(ITK) ) then
	    LastKey = Selection
            GOTO 400
	  end if
460	continue
461	continue

      END IF

      SINGLECHAR = CHAR( SELECTION )
      CALL CVTTOUPCASE( SINGLECHAR )
      SELECTION = ICHAR( SINGLECHAR )

      DO 300 I = 1 , NUMOFPOSSIBLEVALUES
         IF( SELECTION .EQ. ICHAR( POSSIBLEVALUES(I:I) ) ) THEN
	   ItemSelected = I
           GOTO 200
         END IF
300   CONTINUE
      CALL BEEP
      GOTO 200

400   CONTINUE

      CALL DSPATTRIBUTE(0)
      CALL ERASEREGION( ROW, 1, ROW, 80 )

      CALL RSTATTRIBUTE

      RETURN
      END


	subroutine ChangeFlagRoutines

	logical*1 ChangeFlag, Flag

	data ChangeFlag /.false./

	return


	entry SetChangeFlag

	ChangeFlag = .true.

	return


	entry ResetChangeFlag

	ChangeFlag = .false.

	return


	entry ReadChangeFlag( Flag )

	Flag = 	ChangeFlag

	return

	end
