/*
 ****************************************************************
 *								*
 * SAMP -- The FMS Sample Application Program in IA64  C	*
 * 	      							*
 ****************************************************************
 */
 /*
		          COPYRIGHT (c) 2004 BY
	         HEWLETT PACKARD DEVELOPMENT COMPANY L.P.,    

 THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
 ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
 INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
 COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
 OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
 TRANSFERRED.

 THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
 AND  SHOULD  NOT  BE   CONSTRUED  AS  A COMMITMENT BY HEWLETT PACKARD.

 HEWLETT PACKARD ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY
 OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY HEWLETT PACKARD.
 */
 /* Author: S.P.Simon */

#include string
#include stdlib
#include stdio			/* Definitions for I/O	

-002, 28-Oct-2004   B P Vidya
    Provided the default "NULL" values for the unused arguments for all
    the FDV$ routines to avoid compilation warnings (too few arguments warning)
*/



/* 
 * C has no built-in facility for passing arguments by descriptor, so we
 * have to define and set up all descriptors explicitly.  The following file
 * contains structure definitions for the various descriptor types:
 */

#include descrip

/*
 * A macro, $DESCRIPTOR, is defined in the file included above, and can be
 * used to declare descriptors for the usual C strings (NUL-terminated arrays
 * of char).  This macro is not adequate for all the cases requiring descriptors
 * in this program, however, so we must define a few more macros:
 *
 * $DESCRIPTOR1 can be used for 1-character items, or for whole structures
 * $DESCRIPTORM can be used for strings that are structure members, or for
 *		any other string not terminated by a NUL character
 * $DESCRIPTORA generates an array descriptor, and is used to describe
 *		the workspaces and terminal control area
 *
 * LENGTH and POINTER are useful shorthands for accessing descriptor fields
 */

#define $DESCRIPTOR1(name,string)	struct dsc$descriptor_s \
name = { sizeof(string), DSC$K_DTYPE_T, DSC$K_CLASS_S, &string }

#define $DESCRIPTORM(name,string)	struct dsc$descriptor_s \
name = { sizeof(string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string }

#define $DESCRIPTORA(name,array,type)	struct dsc$descriptor_a \
name = { sizeof (type), DSC$K_DTYPE_L, DSC$K_CLASS_A, array, 0, 0, { 0, 0, 0, 0, 0 }, 1, sizeof array }

#define LENGTH(descriptor)	descriptor.dsc$w_length
#define POINTER(descriptor)	descriptor.dsc$a_pointer

/*
 * Data definitions
 */



/*
 * FMS related
 */
static int
   workspace [3],		/* General workspace		*/
   checkwksp [3],		/* Check workspace		*/
   tcarea [3],		/* Terminal Control Area	*/
   menu_form [500],	/* Storage for memory resident form */
   check_form [750],	/* Storage for memory resident form */
   dposit_form [500],	/* Storage for memory resident form */
   size_menu,
   size_check,
   size_dposit;

/* Array descriptors for above	*/
static	$DESCRIPTORA (_workspace, workspace, int);
static	$DESCRIPTORA (_checkwksp, checkwksp, int);
static	$DESCRIPTORA (_tcarea, tcarea, int);
static	$DESCRIPTORA (_menu_form, menu_form, int);
static	$DESCRIPTORA (_check_form, check_form, int);
static	$DESCRIPTORA (_dposit_form, dposit_form, int);



/*
 * Account (Read in from file)
 */

static struct	{
		char	acctno [5];
		char	accdate [7];
		char	last [20];
		char	first [15];
		char	middle [15];
		char	street [30];
		char	city [20];
		char	state [2];
		char	zip [5];
		char	homeph [10];
		char	workph [10];
		char	opw [12];
		char	account_nul [2]; /* Space for NL and NUL (C only) */
		} account;



/*
 * Deposit data (Read via fdv$getal)
 */

static	struct	{
		char	dep_date [7];
		char	dep_curbal [6];
		char	dep_amt [6];
		char	dep_newbal [6];
		char	dep_memo [35];
		} deposit;

/*
 * Money.
 * Note that all money is kept internally as integers (in cents).
 * It is only when the quantities are output that they look like
 * dollars, since all the money fields have periods as field
 * markers in the right places and they are right justified or
 * fixed decimal.
 *
 * Register data.
 */

#define REGSIZE 50

static	struct	{
		char	ri_num [4];
		char	ri_date [7];
		char	ri_mempayto [35];
		char	ri_amtdep [6];
		char	ri_amtpay [6];
		char	ri_balance [6];
		char	ri_nul [2];		/* Space for NL and NUL (C only) */
		} regarray [REGSIZE + 1];





/*
 * Other variables
 */

static	int
	terminator,	/* Terminator returned by FDV */
	balance,	/* Balance in account, numeric */
	sbalance,	/* Starting balance */
	totdep,		/* Total deposits made in this session */
	totpay,		/* Total checks payed in this session */
	fmsstatus,	/* Status for last FDV call */
	rmsstatus,	/* RMS Status for last FDV call */
	lastregnum,	/* Last number used in the register (1...REGSIZE) */
	lastchnum,	/* Last check number used */
	curline,	/* Line of check register that cursor is now on */
	minwindow,	/* Smallest line of register being displayed
			   on the scrolled area */
	maxwindow;	/* Largest line of register being displayed
			   on the scrolled area */

/*
 * We could use a couple of string descriptors for temporary use
 * and macros to make it easier to pass literal strings to FMS
 */

static	struct	dsc$descriptor_s
	_temp_descr_1 = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0 },
	_temp_descr_2 = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0 };

#define $DESCR(literal) (LENGTH (_temp_descr_1) = sizeof literal - 1,\
 POINTER (_temp_descr_1) = literal, &_temp_descr_1)

#define $DESCR2(string) (LENGTH (_temp_descr_2) = sizeof (string),\
 POINTER (_temp_descr_2) = string, &_temp_descr_2)





/*
 * Some string function declarations.
 */

static struct dsc$descriptor_s	*itoa(int);

char	*strchr ();



/*
 * FMS terminator codes:
 */

#include "fdvdef"

int simulate_getal(void);
int makdep(void);
int vuereg(void);
int scrfwd(void);
int scrbak(void);
int simulate_getval(void);
int getsta(void);
int error(void);
int valid1(void);
int take15(void);
int passky(void);
int range(void);
static int val(char* string,int size);
static  trim (struct  dsc$descriptor_s  *);
int vueact(void);
int writch(void);
int srvchk(void);
int inacct(void);
int fmtchk(void);
int onechk(void);
int chkchk(void);
int endchk(void);
int prichk(void);
int menu(void);




main ()
{
	/*
	 * Initialize FMS
	 *   Attach default terminal
	 *   Attach normal and check workspaces (order important for help
    	 *    and refresh during CHECK/CHECK_DONE time--try switching and see).
	 *   Open form library, attach to channel 1
	 *   Set keypad mode to application
	 *   Set signal mode to bell (default, but it's fun to do)
	 */
	fdv$aterm (&_tcarea, &12, &2,0,0,0);
	getsta ();
	fdv$awksp (&_checkwksp, &2000);
	getsta ();
	fdv$awksp (&_workspace, &2000);
	getsta ();
	fdv$lopen ($DESCR ("FMS$EXAMPLES:SAMP"), &1);
	getsta ();
	fdv$spada (&1);
	fdv$ssigq (&0);

	/*
	 * Set all future calls to return status to the two status recording
	 * variables fmsstatus and rmsstatus without having to call the
	 * fdv$stat routine.
	 */
	fdv$ssrv (&fmsstatus, &rmsstatus);

	/*
	 * Read in a few forms from the form library onto the dynamic
	 * resident form list.  You may be able to detect the difference
	 * in the form to form access times for those forms which have to be
	 * accessed from the form library on disk and those forms which are
	 * on the dynamic or static memory resident form list.  See the
	 * installation notes for this program (the LINK command) to see
	 * which forms are on the static memory resident form list.
	 */
	fdv$read ($DESCR ("MENU"), &_menu_form, &2000, &size_menu);
	fdv$read ($DESCR ("CHECK"), &_check_form, &3000, &size_check);
	fdv$read ($DESCR ("DEPOSIT"), &_dposit_form, &2000, &size_dposit);

	/*
	 * Initialize account information
	 */
	inacct ();

	/*
	 * Put up welcome form, wait for response
	 */
	fdv$cdisp ($DESCR ("WELCOME"),0);
	srvchk ();
	fdv$wait (0);

	/*
	 * Process all menu requests
	 */
	menu ();

	/*
	 * Clean up and leave:
	 *   Close form library.
	 *   Reset keypad to numeric.
	 *   Delete a form from dynamic mem. res. form list just to show how.
	 *   Detach workspaces (not really necessary since DTERM would do it).
	 *   Detach terminal.
	 */
	fdv$lclos ();
	fdv$spada (&0);
	fdv$del ($DESCR ("MENU"));
	fdv$dwksp (&_workspace);
	fdv$dwksp (&_checkwksp);
	fdv$dterm (&_tcarea);

}

/*
 * Subroutine INACCT
 *	Read from file SAMP.DAT into internal variables.
 *	Set up the workspace for checks and fill in the check form
 *	with the account's name, address, and account number.
 */

inacct ()
{
	FILE	*account_file;



	/*
	 * Open file, get account data
	 */
	if ((account_file = fopen ("FMS$EXAMPLES:samp.dat", "r")) == NULL)
	{
		printf ("Unable to open account file, \"samp.dat\"");
		exit (1);
	}
	fgets (&account, sizeof account, account_file);

	/*
	 * Read the remaining records into the check register, counting them.
	 * The last record has the current balance, and some record has the
	 * last check number used (not necessarily the last record).
	 */
	lastchnum = 0;
	lastregnum = 0;
	while (lastregnum < REGSIZE)
	{
		if (fgets (& regarray [lastregnum + 1], sizeof regarray [0], account_file) == NULL)
			break;
		++lastregnum;
		if (strncmp (regarray [lastregnum].ri_num, "    ", 4) != 0)
			lastchnum = val (regarray [lastregnum].ri_num,
					 sizeof regarray[0].ri_num);
	}

	/*
	 * Reached here with or without hitting end of file.
	 * If not end of file, should probably print a message or something,
	 * except that this is just a l'il ol' demo.
	 * As it is, just fall through and ignore remaining records.
	 *
	 * Check for data file in error.
	 * Take balance from last record read.
	 * Set session sums to zero to say no activity yet.
	 */
	fclose (account_file);
	if (lastregnum == 0)
	{
		printf ("DATA FILE IN ERROR");
		exit (1);
	}
	balance = val (regarray [lastregnum].ri_balance,
		       sizeof regarray[0].ri_balance);
	sbalance = balance;
	totdep = 0;
	totpay = 0;

	/*
	 * Set up the check workspace once so we don't have to do it every time.
	 */
	fmtchk ();

	return;

}

/*
 * Subroutine FMTCHK
 *	Format account data onto check form in the check workspace.
 */

fmtchk ()
{
	static	char	string [sizeof account.first + sizeof account.middle +
				sizeof account.last + 3];
	static	$DESCRIPTOR (_string, string);
	$DESCRIPTORM (_first, account.first);
	$DESCRIPTORM (_middle, account.middle);
	$DESCRIPTORM (_last, account.last);
	$DESCRIPTORM (_street, account.street);
	$DESCRIPTORM (_city, account.city);
	$DESCRIPTORM (_homeph, account.homeph);
	$DESCRIPTORM (_acctno, account.acctno);



	fdv$swksp (&_checkwksp);
	fdv$load ($DESCR ("CHECK"));

	trim (&_first);
    	LENGTH (_middle) = 1;
	trim (&_last);
	sprintf (string, "%.*s %.*s. %.*s",
		 LENGTH (_first), POINTER (_first),
		 LENGTH (_middle), POINTER (_middle),
		 LENGTH (_last), POINTER (_last) );
	LENGTH (_string) = strlen (string);
	fdv$put (&_string, $DESCR ("NAME"),0);

	fdv$put (&_street, $DESCR ("STREET"),0);

	trim (&_city);
	sprintf (string, "%.*s, %.*s %.*s",
		 LENGTH (_city), POINTER (_city),
		 sizeof account.state, account.state,
		 sizeof account.zip, account.zip );
	LENGTH (_string) = strlen (string);
	fdv$put (&_string, $DESCR ("CSZ"),0);

	fdv$put (&_homeph, $DESCR ("HOMEPH"),0);

	fdv$put (&_acctno, $DESCR ("ACCTNO"),0);

	fdv$swksp (&_workspace);

}

/*
 * Subroutine MENU
 *	Accept inputs from the menu form and dispatch to the
 *	appropriate routine.  Repeat until option 1 (exit) is
 *	chosen.  The UARs in the form guarantee that we get back
 *	only inputs '1'-'5' with the correct terminators.
 *	Options are:
 *		1 => Exit
 *		2 => Write checks
 *		3 => Make deposit
 *		4 => View register
 *		5 => View account data
 */

menu ()
{
	static	char	option;
	static	$DESCRIPTOR1 (_option, option);



	while (1)
	{
		fdv$cdisp ($DESCR ("MENU"),0);
		srvchk ();
		fdv$get (&_option, &terminator, $DESCR ("OPTION"),0);

		switch (option)
		{
		case '1':
			return;

		case '2':
			writch ();
			continue;

		case '3':
			makdep ();
			continue;

		case '4':
			vuereg ();
			continue;

		case '5':
			vueact ();
			continue;
		}

	}

}

/*
 * Subroutine WRITCH
 *	Write one or more checks
 */

writch ()
{
	/*
	 * Turn on LED 3 on the VT100 during this routine, just to show how.
	 */
	fdv$ledon (&3);

	/*
	 * Mark WORKSPACE not displayed so it doesn't show up during refresh.
    	 * Put up CHECK form from already loaded workspace
	 * and display current balance
	 */
    	fdv$ndisp ();
	fdv$swksp (&_checkwksp);
	fdv$dispw (0);

	fdv$put (itoa (balance), $DESCR ("BALANCE"),0);

	/*
	 * Process checks until a keypad period is read
	 */
	do {
		onechk ();	/* Process one check */
		endchk ();	/* Give options for continuing */
	} while (terminator != FDV$K_KP_PER);

	/*
	 * Turn off LED 3 on VT100
	 */
	fdv$ledof (&3);
    	fdv$swksp (&_workspace);

}

/*
 * Subroutine ONECHK -- Process one check
 *	If input is terminated by kpd period, return with no action
 *	Else deduct from balance and enter into register.
 *	Note that a UAR in the form guarantees that the amount of
 *	the check is always less than or equal to the balance.
 *	Note that the form function key UAR  allows only kpd period
 *	as terminator (other than FDV$K_FT_NTR).
 */

onechk ()
{
	int	amtpay;



	fdv$put (itoa (lastchnum + 1), $DESCR ("NUMBER"),0);
	fdv$getal (0, &terminator,0,0); /* Just want the terminator */
	if (terminator == FDV$K_KP_PER)
		return;

	/*
	 * If the check wouldn't fit in the register, don't process, just
	 * give error message, wait for acknowledgement, and return
	 */
	if (lastregnum == REGSIZE)
	{
		fdv$putl ($DESCR ("Register full, can't enter check"),0);
		fdv$wait (0);
		return;
	}
	++lastregnum;

	/*
	 * Get amount from check.
	 * Update balance (in memory and on screen) and session sums.
	 */
	fdv$ret ($DESCR2 (regarray [lastregnum].ri_amtpay), $DESCR ("AMTPAY"),0);
	amtpay = val (regarray [lastregnum].ri_amtpay,
		      sizeof regarray[0].ri_amtpay);
	balance -= amtpay;
	totpay += amtpay;

	fdv$put (itoa (balance), $DESCR ("BALANCE"),0);
	fdv$ret ($DESCR2 (regarray [lastregnum].ri_balance), $DESCR ("BALANCE"),0);

	strncpy (regarray [lastregnum].ri_amtdep, "      ", 6);
	fdv$ret ($DESCR2 (regarray [lastregnum].ri_num), $DESCR ("NUMBER"),0);
	fdv$ret ($DESCR2 (regarray [lastregnum].ri_date), $DESCR ("DATE"),0);
	fdv$ret ($DESCR2 (regarray [lastregnum].ri_mempayto), $DESCR ("PAYTO"),0);	/* Note: not from check's MEMO */

	++lastchnum;

}

/*
 * Subroutine ENDCHK
 *	Finish off check processing by giving operator
 *	three options:
 *		RETURN	Write another check
 *		KPD 0	Print the check into file SAMPCH.DAT
 *		KPD .	Return to menu
 *	Check to see if check write was aborted by kpd per.
 *	If so, then don't give any further choice, just abort.
 *	Note that form function key UAR allows only the above
 *	terminators to get through.
 */

endchk ()
{
	if (terminator == FDV$K_KP_PER)
		return;

	/*
	 * Tell the operator that the check has been paid by overlaying with
	 * a new form, using the normal workspace, thereby saving the check
	 * workspace in case another check is to be written.
	 */
	fdv$swksp (&_workspace);
	fdv$disp ($DESCR ("CHECK_DONE"),0);
	srvchk ();

	/*
	 * Wait for operator to enter either KPD period, NTR, or KPD zero.
	 * Print the check as many times as requested.
	 * (Note that a UAR on the form guarantees that only those terminators
	 * are accepted).
	 * Process accordingly.
	 */
	fdv$wait (&terminator);
	while (terminator == FDV$K_KP_0)
	{
		prichk ();	/* Print the check */
		fdv$wait (&terminator);
	}

	/*
	 * If choice is to quit,
    	 * then mark check wksp undisplayed so it doesn't appear during refresh,
    	 * else mark normal workspace (occupied by CHECK_DONE form) undisplayed
    	 *   so it doesn't show during refesh and then clear its lines.
    	 *   (Clearing the space occupied by the CHECK_DONE form, lines 20-23
    	 *   is better done by overlaying with a blank form to
    	 *   avoid having to know the line numbers to clear).
	 */
	if (terminator == FDV$K_KP_PER)
    	{
		fdv$swksp (&_checkwksp);
    		fdv$ndisp ();
    	}
    	else
    	{
    		fdv$ndisp ();
    		fdv$clear (&20, &4);
    		fdv$swksp (&_checkwksp);
    	}

	/*
	 * Going to write another check now or eventually, so:
	 * Clear out operator entered fields.
	 */
	fdv$putd ($DESCR ("AMTPAY"),0);
	fdv$putd ($DESCR ("MEMO"),0);
	fdv$putd ($DESCR ("PAYTO"),0);

}

/*
 * Subroutine PRICHK
 *	Print the check into the file SAMPCH.DAT
 *	Use the check workspace, then switch back to the normal wksp
 *	to keep things clean.
 */

prichk ()
{
	static	char	firstl [3],	/* First line on the form of the check
					   image (from named data) */
			lastl [3],	/* Last line on the form of the check
					   image (from named data) */
			line [81];	/* Line return as image of form for
					   check print */
	static	$DESCRIPTOR (_firstl, firstl);
	static	$DESCRIPTOR (_lastl, lastl);
	static	$DESCRIPTOR (_line, line);
	FILE	*check_file;
	int	i,	/* Index into lines of check */
    		line_length;	/* length of form line */



	/*
	 * Open check writing file.  Note there's a new version for every check.
	 * Switch workspaces
	 */
	check_file = fopen ("sampch.dat", "w");
	fdv$swksp (&_checkwksp);

	/*
	 * Get the top and bottom lines of the check from the named data
	 * (first two characters).
	 */
	fdv$retdn ($DESCR ("FIRST"), &_firstl,0);
	srvchk ();
	fdv$retdn ($DESCR ("LAST"), &_lastl,0);
	srvchk ();

	/*
	 * Get lines from form.
	 * Convert to line printer style.
	 * Write to file.
	 */
	for (i = atoi (firstl);  i <= atoi (lastl);  ++i)
	{
		fdv$retfl (&i, &_line, &line_length, &0);
		fprintf (check_file, "%s\n", line);
	}
	fdv$putl ($DESCR ("Check written to file"),0);
	fclose (check_file);
    	fdv$swksp (&_workspace);

}

/*
 * Subroutine MAKDEP
 *	Make a deposit, enter into check register
 *	Cancel on keypad period.
 *	Note that the form function key UAR allows only kpd period.
 *
 * Put up deposit form with current balance
 */

makdep ()
{
	static	char	done [80];	/* Form done message for Deposit */
	static	$DESCRIPTORM (_done, done);
	static	$DESCRIPTOR1 (_deposit, deposit);



	fdv$cdisp ($DESCR ("DEPOSIT"),0);
	srvchk ();
	fdv$put (itoa (balance), $DESCR ("CURBAL"),0);

	/*
	 * Get deposit amount and memo from operator.
	 * Abort on kpd period.
	 */
	fdv$getal (&_deposit, &terminator,0,0);
	if (terminator == FDV$K_KP_PER)
		return;

	/*
	 * Have deposit information now. If no room in check register
	 * must abort.
	 */
	if (lastregnum == REGSIZE)
	{
		fdv$putl ($DESCR ("Register full, can't enter deposit"),0);
		fdv$wait (0);
		return;
	}
	++lastregnum;

	/*
	 * Add to balance and session sum.
	 * Check for overflow (program and form keep only six digits).
	 * Display new balance.
	 * Make entry in register.
	 */
	balance += val (deposit.dep_amt, sizeof deposit.dep_amt);
	totdep += val (deposit.dep_amt, sizeof deposit.dep_amt);
	if (balance >= 1000000)
	{
		balance -= 1000000;
		fdv$putl ($DESCR ("Overflow in bank computer, \
only 6 digits allowed, we keep the rest of the money"),0);
		fdv$wait (0);
	}
	fdv$put (itoa (balance), $DESCR ("NEWBAL"),0);
	/* Blank since it's not a check: */
	strncpy (regarray [lastregnum].ri_num, "    ", 4);
	strncpy (regarray [lastregnum].ri_date, deposit.dep_date, sizeof deposit.dep_date);
	strncpy (regarray [lastregnum].ri_mempayto, deposit.dep_memo, sizeof deposit.dep_memo);
	strncpy (regarray [lastregnum].ri_amtdep, deposit.dep_amt, sizeof deposit.dep_amt);
	strncpy (regarray [lastregnum].ri_amtpay, "      ", 6);
	fdv$ret ($DESCR2 (regarray [lastregnum].ri_balance), $DESCR ("NEWBAL"),0);

	/*
	 * Sample of how to keep message texts stored with the form rather
	 * than in a program.  This is especially useful for multi-lingual
	 * environments: only the form text and the form named data must
	 * be changed and nothing in the program.  The trick is to store the
	 * response text in named data. This is the only example of how to do
	 * it in this program, but all messages could be stored like this.
	 * Message intent is: "Deposit made, press RETURN or ENTER to continue."
	 */
	fdv$retdn ($DESCR ("DONE"), &_done,0);
	fdv$putl (&_done,0);
	fdv$wait (0);

}

/*
 * Subroutine VUEREG
 *	View the check register and scroll through it.
 *	Also display totals for current session.
 *
 * Put up register form.
 * Check for current session totals overflow. If so, output "OVRFLO"
 * Put out summary of this session into indexed(4) fields.
 */

vuereg ()
{
	static	char	nscrols [3],	/* Number of lines in scrolled area
					   (from named data) */
			fake;		/* Value returned from fake field
					   in scrolled area */
	static	$DESCRIPTOR (_nscrols, nscrols);
	static	$DESCRIPTOR1 (_fake, fake);
	static	$DESCRIPTOR (_sumary, "SUMMARY");
	static	struct	dsc$descriptor_s
		_reg_temp_descr = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0 };
	int	nscrol;



	fdv$cdisp ($DESCR ("REGISTER"),0);
	srvchk ();
	fdv$put (itoa (sbalance),	&_sumary, &1);
	fdv$put (totdep < 1000000 ? itoa (totdep) : $DESCR ("OVRFLO"),
					&_sumary, &2);
	fdv$put (totpay < 1000000 ? itoa (totpay) : $DESCR ("OVRFLO"),
					&_sumary, &3);
	fdv$put (itoa (balance),	&_sumary, &4);

	/*
	 * Get number of lines in scroll area from form named data (item 1).
	 */
	fdv$retdi (&1, &_nscrols,0);
	srvchk ();
	nscrol = atoi (nscrols);

	/*
	 * Put lines from check register array into scrolled area.
	 * The window is initially from item 1 up to item
	 * min(nscrols,lastregnum), that is, up to the size of the scrolled
	 * area or the size of the register, whichever is less. Assume there
	 * is at least one line (the initial deposit).
	 */
	minwindow = 1;
	LENGTH (_reg_temp_descr) = sizeof regarray [0] - 2;
	POINTER (_reg_temp_descr) = & regarray [1];
	fdv$putsc ($DESCR ("NUMBER"), &_reg_temp_descr);	/* First line */
	curline = 1;				/* Reg item cursor is on */
	while (curline < lastregnum  &&  curline < nscrol)
	{
		++curline;
		fdv$pft (&FDV$K_FT_SFW, $DESCR ("NUMBER"),0,0,0);
		POINTER (_reg_temp_descr) = & regarray [curline];
		fdv$putsc ($DESCR ("NUMBER"), &_reg_temp_descr);
	}
	maxwindow = curline;

	/*
	 * Get input from fake field of scrolled line and do what it says:
	 *	kpd . or RETURN/ENTER	=> return to menu
	 *	UPARROW or TAB		=> scroll forward
	 *	DOWNARROW or BACKSPACE	=> scroll backward
	 *	all others	        => ignore
	 * Note that there is no form function key UAR so this routine
	 * handles all terminators itself (by ignoring illegal ones).
	 */
	fdv$get (&_fake, &terminator, $DESCR ("FAKE"),0);
	while ( ! (terminator == FDV$K_FT_NTR  ||  terminator == FDV$K_KP_PER))
	{
		if (terminator == FDV$K_FT_SFW  ||  terminator == FDV$K_FT_SNX)
			scrfwd ();
		if (terminator == FDV$K_FT_SBK  ||  terminator == FDV$K_FT_SPR)
			scrbak ();
		fdv$get (&_fake, &terminator, $DESCR ("FAKE"),0);
	}

}

/*
 * Subroutine SCRFWD -- Scroll forward.
 *	curline is the line in the register that the cursor is on.
 *	minwindow and maxwindow delimit the part of the register
 *	currently displayed in the scrolled area
 */

scrfwd ()
{
	static	struct	dsc$descriptor_s
		_scr_temp_descr = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0 };



	/*
	 * If cursor is at the end of the register, report, and return
	 */
	if (curline == lastregnum)
	{
		fdv$putl ($DESCR ("Last line of register"),0);
		return;
	}

	/*
	 * If cursor not at the last line of a window, just move down
	 * If cursor is  at the last line of a window,
	 *	move window forward one line,
	 *	write the new last line to the last line of the scrolled area
	 * Move current line pointer forward
	 */
	if (curline != maxwindow)
		fdv$pft (&FDV$K_FT_SFW, $DESCR ("NUMBER"),0,0,0);
	else
	{
		++minwindow;
		++maxwindow;
		LENGTH (_scr_temp_descr) = sizeof regarray [0] - 2;
		POINTER (_scr_temp_descr) = & regarray [maxwindow];
		fdv$pft (&FDV$K_FT_SFW, $DESCR ("NUMBER"), &_scr_temp_descr,0,0);
	}

	++curline;

}

/*
 * Subroutine SCRBAK -- Scroll backward
 *	curline is the line in the register that the cursor is on.
 *	minwindow and maxwindow delimit the part of the register
 *	currently displayed in the scrolled area
 */

scrbak ()
{
	static	struct	dsc$descriptor_s
		_scr_temp_descr = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0 };



	/*
	 * If the cursor is at the beginning of the register, report, and return
	 */
	if (curline == 1)
	{
		fdv$putl ($DESCR ("First line of register"),0);
		return;
	}

	/*
	 * If cursor not at first line of the window, just move up
	 * If cursor is  at first line of the window,
	 *	move window back one line,
	 *	write the new first line to the first line of the scrolled area
	 * Move current line pointer back
	 */
	if (curline != minwindow)
		fdv$pft (&FDV$K_FT_SBK, $DESCR ("NUMBER"),0,0,0);
	else
	{
		--minwindow;
		--maxwindow;
		LENGTH (_scr_temp_descr) = sizeof regarray [0] - 1;
		POINTER (_scr_temp_descr) = & regarray [minwindow];
		fdv$pft (&FDV$K_FT_SBK, $DESCR ("NUMBER"), &_scr_temp_descr,0,0);
	}

	--curline;

}

/*
 * Subroutine VUEACT
 *	View the account data.
 *	If operator knows the secret word, let operator change
 *	the account data for this session.
 */

vueact ()
{
	static	char	password [sizeof account.opw];
	static	$DESCRIPTORM (_password, password);
	static	struct	dsc$descriptor_s
		_account = { sizeof account - 2, DSC$K_DTYPE_T, DSC$K_CLASS_S,&account };



	fdv$cdisp ($DESCR ("ACCOUNT_DATA"),0);
	srvchk ();
	fdv$putal (&_account);
	fdv$putd ($DESCR ("SECRET"),0);

	/*
	 * This is not the best way to do protection, just a way of showing
	 * another FMS feature. At this point, supervisor mode is on, so the
	 * only input allowed is to the password field.
	 * If operator doesn't know password, return to menu.
	 */
	fdv$getal (0, &terminator,0,0);	/* Don't care about value now */
	if (terminator == FDV$K_KP_PER)
		return;
	fdv$ret (&_password, $DESCR ("SECRET"),0);
	if (strncmp (account.opw, password, sizeof account.opw))
		return;

	/*
	 * Allow input from other fields and read from them.
	 * If read is terminated by keypad period, don't change account.
	 */
	fdv$spoff ();
	simulate_getal ();	/* Read all fields */
	fdv$spon ();		/* Not really needed, just showing off. */
	if (terminator != FDV$K_KP_PER)
	{
		fdv$retal (&_account);
		fmtchk ();	/* Update the check workspace */
	}

}

/*
 * Simulate action of fdv$getal, using fdv$getaf and PFT.  Could
 * replace this whole routine with a call on fdv$getal, but this shows
 * how mainline program can allow same operator freedom of filling in
 * fields but still regain control after each or changed field.
 * Technique is to read any field, looking only at terminator, then do
 * a process field terminator call to do the operator's action.
 * This technique can be used with calls on fdv$get or fdv$getaf.
 * This example starts with a GET on field '*', first field on form.
 */

simulate_getal ()
{
	static	char	fieldname [31], junk[132];
	static	$DESCRIPTORM (_fieldname, fieldname);
	static	$DESCRIPTORM (_junk, junk);
	static	$DESCRIPTOR (_asterisk, "*");
	int	fieldindex;



	fdv$get (0, &terminator, &_asterisk,0);   /* Ignore field value     */
	fdv$retfn (&_fieldname, &fieldindex);	/* Get first field's name */
	while (1)
	{
		/*
		 * Do any special processing for field fieldname at this point.
		 * ...
		 * Go to next or previous field or leave form
		 */

		/* Note: PFT call will display error if FDV$DEBUG set thus the
		 * following check for special field terminators. This could be
		 * strengthened to (FDV$K_FT_NTR <= TERMINATOR <= FDV$K_FT_HLP)
		 * else PFT will return an error.
		 */

		if (terminator == FDV$K_KP_PER) /* user wants out */
			return;
		fdv$pft (&terminator,0,0,0,0);

		/*
		 * If status is error, then PFT failed because terminator was
		 * a keypad key, which means return to caller.
		 */
		if (fmsstatus < 0)
			return;
		if (terminator == FDV$K_FT_NTR)
			if (fmsstatus != 2)
				return;
			else
			{
				fdv$putl ($DESCR ("INPUT REQUIRED"),0);
				fdv$bell ();
			}

		/*
		 * Go get any other field, returning its name
		 */
		fdv$getaf (&_junk, &terminator, &_fieldname, &fieldindex);
	}

}

/*
 * Subroutine GETSTA
 * Check FMS status by calling fdv$stat.
 * If not success (>0), print and stop
 */

getsta ()
{
	fdv$stat (&fmsstatus, &rmsstatus);
	if (fmsstatus > 0)
		return;
	error ();	/* and never come back */
}



/*
 * Subroutine SRVCHK
 * Check FMS status by looking at the status recording variables.
 */

srvchk ()
{
	if (fmsstatus > 0)
		return;
	error ();	/* and never come back */
}





/*
 * There is an error returned in the status variables. Detach the
 * terminal to clean up, then print the errors, and stop.
 */

error ()
{
	fdv$dterm (&_tcarea);
	printf ("FDV ERROR.\n  FMS STATUS: %d\n  RMS STATUS: %d",
		fmsstatus, rmsstatus);
	exit (1);
}

/*
 * VALID1
 *	UAR for field validation of any one character field. The
 *	UAR associated data has in it the legal characters allowed,
 *	except that blank is not allowed unless it appears before
 *	the first trailing blank.  For example an assoc. value string
 *	"aqr" implies that only the letters a, q, and r are allowed.
 *	A string " aqr" means that blank is acceptable in addition
 *	to a, q, and r. Note that this routine is case sensitive
 *	(that is, it checks for correct case).  You can get around
 *	case sensitivity by using the force upper case field attribute
 *	and putting only capitals into the UAR associated value
 *	string.
 *
 *	This routine can be used with any form and field since
 *	it determines the context for itself.
 */

int	valid1 ()
{
	static	int	atca, awksp, curpos, fldtrm, insovr, helpnum;
	static	char	frmnam [31], uarval [82], fldname [31], fvalue;
	static	$DESCRIPTORM (_frmnam, frmnam);
	static	$DESCRIPTOR1 (_fvalue, fvalue);
	$DESCRIPTORM (_uarval, uarval);
	$DESCRIPTORM (_fldname, fldname);
	int	findex;



	/*
	 * Retrieve context: we will ignore tca address, wksp address, frmnam,
	 *	curpos, fldtrm, and insovr, using only uarval, and only the
	 *	initial, non-blank characters of it.
	 * Retrieve field name and index.
	 * Retrieve field value.
	 */
	fdv$retcx (&atca, &awksp, &_frmnam, &_uarval, &curpos, &fldtrm, &insovr, &helpnum );
	fdv$retfn (&_fldname, &findex);
	fdv$retfn (&_fldname, &findex);
	fdv$ret (&_fvalue, &_fldname, &findex);

	/*
	 * To be valid, fvalue must occur in the string uarval
	 */
	trim (&_uarval);
	uarval [LENGTH (_uarval)] = '\0';
	if (strchr (uarval, fvalue) != 0)
		return FDV$K_UVAL_SUC;		/* Success */

	fdv$putl ($DESCR ("Illegal value"),0);
	return FDV$K_UVAL_FAIL;

}

/*
 * TAKE15
 *	Function key User Action Routine for the MENU form of SAMP.
 *	Convert keypad 1-5 into field values 1-5.
 *	Convert keypad period into field value 1.
 *	Reject all other function keys with error message.
 */

int	take15 ()
{
	static	int	atca, awksp, curpos, fldtrm, insovr, helpnum;
	static	char	frmnam [31], uarval[82], value;
	static	$DESCRIPTORM (_frmnam, frmnam);
	static	$DESCRIPTORM (_uarval, uarval);
	static	$DESCRIPTOR1 (_value, value);



	/*
	 * Retrieve context: we will ignore tca address, wksp address, frmnam,
	 *	uarval, curpos, and insovr, using only fldtrm
	 */
	fdv$retcx (&atca, &awksp, &_frmnam, &_uarval, &curpos, &fldtrm, &insovr, &helpnum );

	/*
	 * Do the conversion, displaying the value converted if found.
	 * Reject if not one of the expected terminators.
	 */
	switch (fldtrm)
	{
	case FDV$K_KP_PER:
	case FDV$K_KP_1:
		value = '1';
		break;
	case FDV$K_KP_2:
		value = '2';
		break;
	case FDV$K_KP_3:
		value = '3';
		break;
	case FDV$K_KP_4:
		value = '4';
		break;
	case FDV$K_KP_5:
		value = '5';
		break;
	default:
		fdv$putl ($DESCR ("Illegal function key"),0);
		fdv$sigop ();
		/* Just ignore it now */
		return FDV$K_UKEY_SUC;
	}

	fdv$put (&_value, $DESCR ("OPTION"),0);
	/* Treat as if it is RETURN */
	return FDV$K_UKEY_NTR;

}

/*
 * PASSKY
 *	General function key uar to pass only those from the (small) list
 *	in the uar associated value string and reject all others.
 *	The list is of the form: n <oneblank> n <oneblank> ... n <manyblanks>
 *	For example the string "110 112" would accept keypad period and
 *	keypad zero but no other function keys.
 */

int	passky ()
{
	static	int	atca, awksp, curpos, fldtrm, insovr, helpnum;
	static	char	frmnam [31], uarval [82];
	static	$DESCRIPTORM (_frmnam, frmnam);
	static	$DESCRIPTORM (_uarval, uarval);
	char	*nonblank, *nextblank;



	/*
	 * Retrieve context: we will ignore tca address, wksp address, frmnam,
	 *	insovr, and curpos, using only fldtrm and uarval.
	 */
	fdv$retcx (&atca, &awksp, &_frmnam, &_uarval, &curpos, &fldtrm, &insovr, &helpnum );

	/*
	 * Break up the list into numbers.  Check each against the actual
	 * terminator. If terminator found in list, return success.
	 */
	nonblank = uarval;	/* Beginning of string */
	while (*nonblank != ' '  &&  nonblank < & uarval [80])
	{
		nextblank = strchr (nonblank, ' ');
		if (fldtrm == val (nonblank, nextblank - nonblank))
			return FDV$K_UKEY_TRM;	/* Pass key to application */
		nonblank = nextblank + 1;
	}

	return FDV$K_UKEY_ERR;	/* Let FDV do the beeping */

}

/*
 * CHKCHK
 *	UAR for SAMP CHECK form.  Makes sure that the check amount is
 *	less than or equal to the current balance.  If not, complain and
 *	change video attributes on balance field so the potential bouncer
 *	can see what there is to work with.
 */

int	chkchk ()
{
	static	char	balance [] = "000000", amtpay [] = "000000" ;
	static	$DESCRIPTOR (_balance, balance);
	static	$DESCRIPTOR (_amtpay, amtpay);
	int	blinkbold;



	fdv$ret (&_balance, $DESCR ("BALANCE"),0);
	fdv$ret (&_amtpay, $DESCR ("AMTPAY"),0);
	if (atoi (balance) >= atoi (amtpay))
	{
		blinkbold = -1;		/* Restore to original */
		fdv$afva (&blinkbold, $DESCR ("BALANCE"),0);
		return FDV$K_UVAL_SUC;
	}

	blinkbold = 3;			/* Make it very visible */
	fdv$afva (&blinkbold, $DESCR ("BALANCE"),0);
	fdv$putl ($DESCR ("Your balance doesn't cover that much, reenter amount"),0);
	return FDV$K_UVAL_FAIL;

}

/*
 * RANGE
 *	General purpose UAR to check the range of any numeric item.  The
 *	associated UAR data must have one of the four forms:
 *		L,U<space>{message}
 *		,U<space>{message}
 *		L,<space>{message}
 *		,<space>{message}
 *	where L is lower bound, U is upper bound, and {message} is an
 *	optional error message in case the field value is out of bounds.
 *	If one of the bounds isn't given, it isn't checked for.  If neither
 *	bound is given, nothing is checked, everything succeeds.  If the
 *	UAR value doesn't have a comma, a FDV$_UAR error message is returned
 *	to the calling program by the FDV so the form designer has to go
 *	back and do it right. If no {message} is given, a simple
 *	"out of range U:L" message is given to the hapless operator.
 *
 *	This UAR can work with any form and numeric field since it gets
 *	context itself.  Care must be taken with fields using field marker
 *	periods since those periods are not returned to the program.
 */

int	range ()
{
	static	int	atca, awksp, curpos, fldtrm, insovr, helpnum;
	static	char	frmnam [31], uarval [82], fldname [31],
			num_string [133], range_msg [81];
	static	$DESCRIPTORM (_frmnam, frmnam);
	static	$DESCRIPTOR (_range_msg, range_msg);
	$DESCRIPTOR (_uarval, uarval);
	$DESCRIPTORM (_fldname, fldname);
	$DESCRIPTOR (_num_string, num_string);
	char	*blank, *comma;
	int	index, number;



	/*
	 * Get context which yields associated data value (ignore other stuff).
	 * Get current field name and index.
	 * Get field value.
	 */
	fdv$retcx (&atca, &awksp, &_frmnam, &_uarval, &curpos, &fldtrm, &insovr, &helpnum );
	fdv$retfn (&_fldname, &index);
	fdv$ret (&_num_string, &_fldname, &index);
	number = atoi (num_string);

	/*
	 * Find comma and blank delimiters.
	 * Check for lower bound.
	 */
	uarval [LENGTH (_uarval)] = '\0';
	if ((comma = strchr (uarval, ',')) == 0)
		return 0;	/* Illegal uarval string, FDV returns error */

	blank = strchr (comma + 1, ' ');
	if (comma != uarval  &&  number < val (uarval, comma - uarval))
		goto bound_error;

	/*
	 * Check for upper bound
	 */
	if (blank != comma + 1  &&  number > val (comma + 1, blank - comma - 1))
		goto bound_error;

	/*
	 * Passed both tests successfully, return success for UAR value
	 */
	return FDV$K_UVAL_SUC;



bound_error:
	/*
	 * Error in one of the bounds.
	 * Give error message: either from the uarval or make one up.
	 */
	if (*(blank + 1) != ' ')
		strcpy (range_msg, blank + 1);
	else
		sprintf (range_msg, "Field value out of bounds.  Must be in range \"%.*s\".",
			 blank - uarval, uarval);

	LENGTH (_range_msg) = strlen (range_msg);
	fdv$putl (&_range_msg,0);

	fdv$sigop ();		/* Beep, too. */
	return FDV$K_UVAL_FAIL;

}

/*
 * The following functions were added for the VAX-11 C version of this program.
 * They are needed to perform some of the string handling functions which are
 * performed in other languages by means of built-in functions.
 */



/*
 * Function VAL
 *	Converts its ASCII string argument to an integer.
 */

static	int	val (string, size)

char	*string;
int	size;

{
	char	temp [16];

	strncpy (temp, string, size);
	temp [size] = '\0';
	return atoi (temp);
}



/*
 * Function ITOA
 *	Converts its int argument to an ASCII string,
 *	and returns a pointer to a string descriptor for it.
 */

static struct dsc$descriptor_s *itoa(i)

int	i;

{
	static	char	string [12];
	static	$DESCRIPTOR (_string, string);

	sprintf (string, "%d", i);
	LENGTH (_string) = strlen (string);

	return &_string;
}



/*
 * Function TRIM
 *	Removes trailing blanks and tabs from a string passed by descriptor.
 *	(Actually, it just adjusts the length field in the descriptor.)
 */

static	trim (dp)

struct	dsc$descriptor_s	*dp;

{
	char	*p;

	for (p = POINTER ((*dp)) + LENGTH ((*dp)) - 1;
	     p >= POINTER ((*dp));
	     --p)
		if (*p != ' '  &&  *p != '\t')
			break;
	LENGTH ((*dp)) = p - POINTER ((*dp)) + 1;
}