!********************************************************************
!*                                                                  *
!*  Program:  MENU                                                  *
!*                                                                  *
!*  Purpose:  Menu subroutine.  Places provided text on screen,     *
!*            allows user to manipulate screen to make a choice.    *
!*            Requires FMS on target machine.                       *
!*                                                                  *
!*  Programmer:  Richard Snyder                                     *
!*               The KeTech Corporation                             *
!*                                                                  *
!*  Calling parameters:                                             *
!*                                                                  *
!*       param 1 -  character string array, each element is 60      *
!*                  characters long, the array contains 16 elements *
!*                  The first element is the title line for the     *
!*                  menu.  The other fifteen elements are the text  *
!*                  lines for the choices on the menu.  Passed by   *
!*                  descriptor.                                     *
!*                                                                  *
!*       param 2 -  32 bit integer, passed by reference.  Specifies *
!*                  the number of choices on the menu (2-15).       *
!*                                                                  *
!*       param 3 -  32 bit integer, passed by reference.  Specifies *
!*                  the users choice ( 1 - param 2 ).               *
!*                                                                  *
!********************************************************************
	subroutine menu (prompt_string,no_choices,ireturn_code)
!
	character*60	prompt_string(16)
	character*60	heading/' '/
	character 	field*3
	character	garb*2
	character	bell*1
	byte 		itca(12)
	byte		iwksp(12)
	data 		bell	/7/
!
!	initialize fms
!
	ichan = 12
	itchan = 1
	call fdv$aterm(%descr(itca),12,itchan,'sys$output')
	call fdv$awksp(%descr(iwksp),2000)
	call fdv$lchan(ichan)
	call fdv$lopen('menu_library')
!
!	check out which screen to put up
!
	if (no_choices .le. 8) then
		call fdv$clrsh ('menu')
	else
		call fdv$clrsh ('menu1')
	endif
!
	if (no_choices .gt. 15) no_choices = 15
!
!
	i = no_choices
	iptr = 21
!
!	center the heading string and put it out
!
	call str$trim ( prompt_string(1), prompt_string(1), icount )
	icount = ( 60 - icount ) / 2
	heading(icount:) = prompt_string(1)
	call fdv$put(heading,'headng')
!
!	output menu selection descriptions to screen
!	
10	write(field(2:3),'(i2.2)')iptr
	field(1:1) = 'x'
	call fdv$put(prompt_string(iptr-19),field)
	iptr = iptr + 1
	i = i - 1
	if (i .gt. 0) go to 10
!
!	position selector arrow at first field on page
!
	ifield = 1
	write (field(2:3),'(i2.2)')ifield
	field(1:1) = 'x'
	call fdv$put('->',field)
!
!	let the user move up and down on the screen until hitting return
!
100	call fdv$get(garb,iterm,field)
	if (iterm .eq. 1 .and. ifield .lt. no_choices) then
		call fdv$put(' ',field)
		ifield = ifield + 1
		write (field(2:3),'(i2.2)')ifield
		field(1:1) = 'x'
		call fdv$put('->',field)
		go to 100
	endif
	if (iterm .eq. 2 .and. ifield .gt. 1) then
		call fdv$put(' ',field)	
		ifield = ifield - 1
		write (field(2:3),'(i2.2)')ifield
		field(1:1) = 'x'
		call fdv$put('->',field)
		go to 100
	endif
	if (iterm .eq. 2 .or. iterm .eq. 1) go to 100
!
!	they made a choice--return
!
	ireturn_code = ifield
	call fdv$lclos
	call fdv$dterm (%descr(itca))
	return
	end