[INHERIT('SYS$LIBRARY:FORMS$PAS_DEFINITIONS', 'sys$library:starlet',
'sys$library:pascal$lib_routines')]

PROGRAM forms$checking_pascal (sample_data_file, output);

{
		    COPYRIGHT (c) 1986, 1988, 1995 BY
	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

 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 DIGITAL EQUIPMENT
 CORPORATION.

 DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
 SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
}

{
PROGRAM DESCRIPTION:

	This is the Sample Checking Account Application provided
          with the DECforms V2.0 product.

AUTHOR:

	Digital Equipment Corporation

CREATION DATE:	  Jan-1986

MODIFIED:         Jan-1991
		  Sep-1993
		  Mar-1995

}

{
  --------------- VMS - Character Cell and Motif Instructions -------------

  If your system manager copied the Sample from the DECforms kit onto your
  system, you can run the DECforms Sample Checking Application by doing the
  following:

   To run the Character Cell version of the Sample Checking Application:

      $ DEFINE FORMS$DEFAULT_DEVICE SYS$INPUT
      $ RUN FORMS$EXAMPLES:FORMS$CHECKING

   To run the Motif version of the Sample Checking Application:

      $ SET DISPLAY/CREATE/NODE=NODE_NAME
      $ DEFINE FORMS$DEFAULT_DEVICE DECW$DISPLAY
      $ RUN FORMS$EXAMPLES:FORMS$CHECKING

  Any printing you do while running the checking sample will end up in your
  SYS$SCRATCH directory (usually your login directory).

  The DECforms Sample Checking Application in the Pascal language consists
  of four files:

 	FORMS$CHECKING_DATA.DAT			A data file for reading by
 						   the program
 	FORMS$CHECKING_FORM.IFDL		The IFDL source form
 	FORMS$CHECKING_PASCAL.PAS		The application itself
 	FORMS$PASCAL_DEFINITIONS.PAS		An include file with DECforms
 						   definitions

  The first three files are copied from the DECforms kit to the FORMS$EXAMPLES
  directory and the last is put into SYS$LIBRARY. Putting the files in
  FORMS$EXAMPLES is an installation option; talk to your system manager if they
  aren't there. The FORMS$PASCAL_DEFINITIONS.PAS file is put into SYS$LIBRARY
  unconditionally, so that you should be able to use it from all your Pascal
  programs using DECforms.

  In addition, the binary form file, FORMS$CHECKING_FORM.FORM is also in the
  FORMS$EXAMPLES directory.

  A working version of the DECforms Sample Checking Application in the PASCAL
  language can be created in your own directory from these sources by doing
  the following:

    $! Set the default to your own directory:
    $ 	SET DEFAULT yourdirectory
    $
    $! Copy all the sources files from FORMS$EXAMPLES to your own directory:
    $	COPY FORMS$EXAMPLES:FORMS$CHECKING_FORM.IFDL, -
    			    FORMS$CHECKING_PASCAL.PAS, -
    			    FORMS$PASCAL_DEFINITIONS.PAS  []
    $
    $! Compile the Pascal sources:
    $ 	PASCAL SYS$LIBRARY:FORMS$PAS_DEFINITIONS.PAS
    $ 	PASCAL FORMS$EXAMPLES:FORMS$CHECKING_PASCAL.PAS
    $
    $! Translate the IFDL source form:
    $ 	FORMS TRANSLATE FORMS$EXAMPLES:FORMS$CHECKING_FORM.IFDL
    $
    $! Extract a vector module from the binary form:
    $	FORMS EXTRACT OBJECT/PORTABLE FORMS$CHECKING_FORM.FORM
    $
    $! Link the Pascal objects and the forms vector:
    $	LINK FORMS$CHECKING_PASCAL.OBJ, -
    $           FORMS$CHECKING_FORM.OBJ -
    $           SYS$INPUT/OPTIONS   <CR>
    $	        SYS$LIBRARY:VAXCRTL.EXE/SHARE      <CTRL/Z>

   You can then run the executable in your own directory by doing the
   following:

   To run the Character Cell executable:

      $ DEFINE FORMS$DEFAULT_DEVICE SYS$INPUT
      $ RUN FORMS$CHECKING_PASCAL

   To run the Motif executable:

      $ SET DISPLAY/CREATE/NODE=NODE_NAME
      $ DEFINE FORMS$DEFAULT_DEVICE DECW$DISPLAY
      $ RUN FORMS$CHECKING_PASCAL


  Note that the program expects the form file as well as the data file to
  be in the FORMS$EXAMPLES directory, or in the current directory.  By
  copying these files to your local directory you can change the form if
  you wish and retranslate it.

}


CONST
    sample_data_file_name = 'FORMS$EXAMPLES:FORMS$CHECKING_DATA';
    terminal		  = 'FORMS$DEFAULT_DEVICE';
    form_file 		  = 'FORMS$EXAMPLES:FORMS$CHECKING_FORM';
    reg_size 		  =  30;	{ Maximum 30 records in register. }

TYPE
    unsigned_byte = [BYTE] 0..255;
    unsigned_word = [WORD] 0..65535;
    sys_time      = RECORD I,J: UNSIGNED; END;
    char5	  = PACKED ARRAY [1..5] OF CHAR;
    char25	  = PACKED ARRAY [1..25] OF CHAR;

{ The ACCOUNT record is stored in the data file.
  It is sent to the form at the beginning of the program to set the
  form storage variables.
  It is received when account updating is to be done.
}
    account_rec =  RECORD
	account_number  	: UNSIGNED;
	date_established 	: PACKED ARRAY [1..8] OF CHAR;
	zip_code    		: INTEGER;
	last_name    		: PACKED ARRAY [1..20] of CHAR;
	first_name   		: PACKED ARRAY [1..15] of CHAR;
	middle_name   		: PACKED ARRAY [1..15] of CHAR;
	street  		: PACKED ARRAY [1..30] of CHAR;
	city    		: PACKED ARRAY [1..20] of CHAR;
	state   		: PACKED ARRAY [1..2]  of CHAR;
	home_phone		: PACKED ARRAY [1..10] of CHAR;
	work_phone		: PACKED ARRAY [1..10] of CHAR;
	password		: PACKED ARRAY [1..12] of CHAR;
	account_pad		: PACKED ARRAY [1..2] of CHAR;
    END;
    account_string = PACKED ARRAY [1..152] OF CHAR;

{
  A register entry stores information about a check or deposit.
}
    register_entry =  RECORD
       reg_check_num :	INTEGER;
       reg_date	:	PACKED ARRAY [1..8] OF CHAR;	{ VAX Date }
       reg_amount :	UNSIGNED;			{ cents }
       reg_balance :	UNSIGNED;			{ cents }
       reg_mem :	PACKED ARRAY [1..35] OF CHAR;	{ Memo }
       reg_tax_ded :	unsigned_byte;			{ 0 or 1 }
    END;
    reg_entry_string =	PACKED ARRAY [1..54] OF CHAR;

{
  The REGISTER keeps track of all checks written and all deposits made,
  one entry for each check or deposit. For simplicity in the application,
  we keep only 30 register records. A real application would be much
  more complex.
}
    register_rec = RECORD
	number_entries_used		: INTEGER;
	entry : ARRAY[1..reg_size] OF register_entry;
	END;

{ CHOICE record is the record that comes back with the operator's choice.
  The first record field, operator_choice, has the choice type.
  In the case of a check, a deposit, a withdrawal, or a transfer between
  accounts, there is also an amount, and possible some subsidiary information
  (memo and amount). For the other choices, the subsidiary information is
  not defined.
}
    choice_record = RECORD
	operator_choice : UNSIGNED;  {Action type}
	amount		: INTEGER;	  { Positive or negative for some cases}
	current_date	: PACKED ARRAY [1..8] OF CHAR;	  { VAX date }
	memo		: PACKED ARRAY [1..35] of CHAR;
					  { Reminder of transaction }
	choice_pad	: unsigned_byte;     { padding for VAX/AXP compatibility }
    END;



    { This is a list of all the internal procedures, in the order they occur }

    PROCEDURE check_forms_status(
		forms_status : INTEGER ); 	FORWARD;
    PROCEDURE initialize_account;		FORWARD;
    PROCEDURE name_and_address; 		FORWARD;
    PROCEDURE update_form; 			FORWARD;
    FUNCTION quit_requested : BOOLEAN;		FORWARD;
    PROCEDURE do_operator_choice;		FORWARD;
    PROCEDURE account_transfer;			FORWARD;
    PROCEDURE add_to_register(
    		chk_num	: INTEGER;
    		date	: PACKED ARRAY [$l1..$u1: INTEGER] OF CHAR;
    		mem	: PACKED ARRAY [$l2..$u2: INTEGER] OF CHAR;
    		amount	: INTEGER;
    		balance : UNSIGNED;
    		tax_ded	: unsigned_byte);	FORWARD;
    PROCEDURE view_register;			FORWARD;
    PROCEDURE view_account_data;		FORWARD;

[EXTERNAL, ASYNCHRONOUS] PROCEDURE str$trim(
    		%STDESCR source : PACKED ARRAY [$l1..$u1 : INTEGER] OF CHAR;
    		%STDESCR target : PACKED ARRAY [$l2..$u2 : INTEGER] OF CHAR;
    		VAR trim_length : unsigned_word ); EXTERNAL;

VAR
	sample_data_file : TEXT;
{
  Session_id is used to identify the form used on every call to the
  FORMS$... subroutines.
}
    session_id		: PACKED ARRAY[1..16] OF CHAR := '         ';
    last_check_num	: INTEGER;	{Last used}
    checking_balance	: UNSIGNED;
    savings_balance	: UNSIGNED;
    account		: account_rec;
    register		: register_rec;
    forms_status	: INTEGER;
    choice		: choice_record;

{
  Receive control text is an array of up to five five-character control text
  items returned by the FORMS$... calls. The call also returns a count.
}
    receive_ctl_txt_ct	: INTEGER;
    receive_ctl_txt   	: ARRAY [1..5] OF char5;

{
  Send control text is an array of up to five five-character control text
  items sent to the FORMS$... calls. The call also requires a count.
}
    send_ctl_txt_ct	  : INTEGER;
    send_ctl_txt	  : ARRAY [1..5] OF char5;


    PROCEDURE check_forms_status;
    {
      PROCEDURE check_forms_status( forms_status : INTEGER );
      Check the parameter for success. If not success, print error
      message and stop.
    }
    BEGIN

    IF NOT ODD( forms_status )
    THEN
	BEGIN
	LIB$SIGNAL( forms_status );
	HALT;
	END;
    END;


    PROCEDURE initialize_account;
    {
      Read from file FORMS$CHECKING_DATA.DAT into internal variables.
      Write the account information to the form.
      Reformat some account info and send that to the form.
    }
    TYPE
	savings_balance_string = PACKED ARRAY [1..4] OF CHAR;
    VAR
	i : unsigned_word;
	skip : PACKED ARRAY [1..2] OF CHAR;

    BEGIN

    { Open file, get account data. }

    OPEN( FILE_VARIABLE     := sample_data_file,
	  FILE_NAME         := sample_data_file_name,
	  HISTORY           := READONLY,
	  ACCESS_METHOD     := SEQUENTIAL,
	  RECORD_TYPE       := VARIABLE,
	  CARRIAGE_CONTROL  := FORTRAN,
	  ERROR             := MESSAGE );

    RESET (sample_data_file, ERROR := MESSAGE);

    { Read the account record and savings balance}
    READLN (sample_data_file, account::account_string, ERROR := MESSAGE);
    READLN (sample_data_file, savings_balance::savings_balance_string,
						  ERROR := MESSAGE);

    {
     Read the remaining records into the register, counting them.
     The last register record has the current balance, and some
     record has the last check number used (not necessarily
     the last record).
    }

    last_check_num := 0;
    register.number_entries_used := 0;
    WHILE (register.number_entries_used < reg_size) AND
		NOT EOF( sample_data_file ) DO
	BEGIN

	register.number_entries_used := register.number_entries_used + 1;
	READLN( sample_data_file,
		register.entry[register.number_entries_used]::reg_entry_string,
	        ERROR := MESSAGE);

	IF register.entry[register.number_entries_used].reg_check_num <> 0 THEN
	    last_check_num := register.entry[register.number_entries_used].reg_check_num;

	END;

    IF STATUS( sample_data_file ) = 0 THEN

	{ Reached here without hitting end of file, reading exactly reg_size
	  records. There's something wrong with the data file. }

	WRITELN( 'Data file probably too big, only using ', reg_size,
	    ' records.')

    ELSE
	{ Assume end of file. Check for data file in error. }
	BEGIN
	CLOSE (sample_data_file);
	IF register.number_entries_used = 0 THEN
	    BEGIN
	    WRITELN( 'Data file in error, no register entries read.');
	    HALT
	    END;
	END;

    { initialize the remaining memo and date fields because we send the
      whole register to the form, and we really shouldn't send illegal
      strings, i.e. strings with non printing characters. }

	FOR i := register.number_entries_used + 1 TO reg_size DO
	    BEGIN
	    register.entry[i].reg_date := '19850315';
	    register.entry[i].reg_mem := ' ';
	    END;

    { Take balance from last record read.
      Update check number to be the next check number to use. }

    checking_balance := register.entry[register.number_entries_used].reg_balance;
    last_check_num := last_check_num + 1;

    { Tell the form all the account-derived information:
 	The account record
  	The balances, next available check number, register status
  	The edited version of name and address
    }

    forms_status := forms$send(
				session_id,		{ session id }
				'account',              { record name in form }
				,			{ Number of records sent, default 1 }
				,,			{ Receive ctl text msg/count }
				,,			{ Send ctl text msg/count }
				,			{ timeout }
				,			{ parent request id }
				,			{ request options item list }
				account,		{ the record }
				);			{ shadow record }
    check_forms_status( forms_status );

    update_form;
    name_and_address;
    END;



    PROCEDURE name_and_address;

    { Format the account data name and address and send to the form }

    TYPE
	{
	  MAIL_FORMAT is a reformatting of the name and last address line
	  as they would appear on a mailing label, with extra spaces
	  squeezed out. This record is used only by a SEND from the program.
	}
	mail_format_rec = RECORD
	    mail_name	: PACKED ARRAY[1..39] OF CHAR;
	    mail_csz	: PACKED ARRAY[1..30] OF CHAR;
	END;

    VAR
	mail_format		:  mail_format_rec;
	trim_length_first	: unsigned_word;
	trim_length_city	: unsigned_word;
    	string_zip1		: VARYING [5] OF CHAR;
    	string_zip2		: VARYING [5] OF CHAR;

    BEGIN
    {
      Need to trim trailing blanks -- use the VMS RTL routine to find
      out how long the trimmed strings are, then do explicit concatenations
      and move.
    }
    str$trim (account.first_name, account.first_name, trim_length_first);
    str$trim (account.city,       account.city,       trim_length_city);

    {
      Format the name. Put only middle initial in, not full middle name.
    }
    mail_format.mail_name :=
		SUBSTR( account.first_name, 1, trim_length_first) + ' ' +
    		SUBSTR( account.middle_name, 1, 1) + '. ' +
    		account.last_name;

    { Convert the zip code to 5 digit numeric with leading zeros. }

    WRITEV( string_zip1, account.zip_code:1);
    WRITEV( string_zip2, '0':(5 - LENGTH( string_zip1 )), string_zip1 );
    mail_format.mail_csz :=
    		SUBSTR( account.city, 1, trim_length_city) + ', ' +
    		account.state + ' ' + string_zip2;

    forms_status := forms$send(
		 session_id,		{ session id }
		 'mail_format',         { record name in form }
		 ,			{ Number of records sent, default 1 }
		 ,,			{ Receive ctl text msg/count }
                 ,,			{ Send ctl text msg/count }
                 ,			{ timeout }
                 ,			{ parent request id }
		 ,			{ request options item list }
		 mail_format,		{ the record  }
		 );			{ shadow record }
    check_forms_status( forms_status );

    END;


    PROCEDURE update_form;
    {
     Update the balances, next check number, and room_in_reg flag in the form.
     If there's no room for more entries in the register, then
       the room_in_reg flag is sent as zero, else 1.
    }

    TYPE
	update_rec = RECORD
	    checking_balance	: UNSIGNED; 	     { passed as pennies }
	    savings_balance	: UNSIGNED; 	     { passed as pennies }
	    check_number	: unsigned_word;
	    room_in_reg		: unsigned_byte;     { 0 or 1 }
	    update_pad		: unsigned_byte;     { padding for VAX/AXP compatibility }
	END;

    VAR
	update	:  update_rec;

    BEGIN

   	update.checking_balance := checking_balance;
   	update.savings_balance  := savings_balance;
	update.check_number     := last_check_num;
	IF register.number_entries_used < reg_size
	THEN update.room_in_reg := 1
	ELSE update.room_in_reg := 0;

        forms_status := forms$send(
		     session_id,	{ session id }
		     'update',          { record name in form }
		     ,			{ Number of records sent, default 1 }
		     ,,			{ Receive ctl text msg/count }
		     ,,			{ Send ctl text msg/count }
		     ,			{ timeout }
		     ,			{ parent request id }
		     ,			{ request options item list }
		     update,		{ the record  }
		     );			{ shadow record }
	check_forms_status( forms_status );
    END;


    FUNCTION quit_requested;
    {
	FUNCTION quit_requested : BOOLEAN;

     	Check the receive control text.
	Return TRUE if operator requested QUIT, return FALSE otherwise.
    }
    VAR
	i : INTEGER;

    BEGIN
    { Assume false till proven otherwise. }

    quit_requested := FALSE;

    FOR i := 1 TO receive_ctl_txt_ct DO
	IF SUBSTR( receive_ctl_txt[i], 3, 3) = 'QUT'
	THEN quit_requested := TRUE;

    END;


    PROCEDURE do_operator_choice;
    {
     Accept inputs from the operator and dispatch to the appropriate
     routine.  Repeat until option 1 (exit) is chosen.  The validation
     in the form guarantees that we get back only inputs 1-8.
     Options are:
	1 => Exit
	2 => Write check (comes back from form only if there's room in the reg)
	3 => Make deposit                            (")
	4 => Cash withdrawal                         (")
	5 => Transfer money from checking to savings (")
	6 => Transfer money from savings to checking (")
	7 => View register
	8 => View account data
    }
    BEGIN

    REPEAT
	BEGIN
        forms_status := forms$receive(
		     session_id,	{ session id }
		     'choose',          { record name in form }
		     ,			{ Number of records sent, default 1 }
		     ,,			{ Receive ctl text msg/count }
		     ,,			{ Send ctl text msg/count }
		     ,			{ timeout }
		     ,			{ parent request id }
		     ,			{ request options item list }
		     choice,		{ the record  }
		     );			{ shadow record }
	check_forms_status( forms_status );

	CASE choice.operator_choice::INTEGER OF
	     1 		: ;
	     2,3,4,5,6	: account_transfer;
	     7 		: view_register;
	     8 		: view_account_data;
	     END;

	END
    UNTIL choice.operator_choice = 1;
    END;


    PROCEDURE account_transfer;

    { The transaction is a checking account transfer, found in global CHOICE:
	2 => Write check
	3 => Make deposit
	4 => Cash withdrawal
	5 => Transfer money from checking to savings
	6 => Transfer money from savings to checking

      Perform the indicated arithmetic on the checking account balance and enter
	the transaction into the register.
      The amount in the choice record is always positive, even for withdrawals
	so that arithmetic must be done with the proper sign.
      The memo in the choice record is set to the appropriate string so nothing
	special has to be done with it.
      In the case of a check, a new check number is generated.

      Note that validation in the form guarantees that the amount of the
	transfer is always greater than zero and less than or equal to the
	respective balance.
      Form validation also guarantees that none of these options is chosen if
	no room is left in the register.
    }

    VAR
	check_number	: INTEGER;

    BEGIN
    { Update balances in memory.
	The general idea is to do the specific thing needed for each choice and
	then always do the checking account update. This also changes the sign
	for checking withdrawals so that the register is updated properly.
    }

    check_number:=0;
    CASE choice.operator_choice::INTEGER OF
	1: ;
	2: { Write a check. The amount gets entered as a checking negative.}
	   BEGIN
	   last_check_num := last_check_num + 1;
	   choice.amount  := - choice.amount;
	   check_number   := last_check_num;
	   END;

	3: { Deposit into checking, use amount as it stands. } ;

	4: { Cash withdrawal. The amount gets entered as a checking negative.}
	   choice.amount  := - choice.amount;

	5: { Transfer from checking to savings. }
	   BEGIN
	   savings_balance := savings_balance + choice.amount;
	   choice.amount   := - choice.amount;
	   END;

	6: { Transfer from savings to checking. }
	   savings_balance := savings_balance - choice.amount;
	END;

    { Now update the checking balance, create new register item, and
      transfer new values to the form. }

    checking_balance := checking_balance + choice.amount;

    add_to_register(
		check_number, 		{ reg_chk_num }
		choice.current_date, 	{ reg_date }
		choice.memo,		{ reg_memo }
		choice.amount,		{ reg_amount }
		checking_balance,      	{ reg_balance }
		0 );	      		{ reg_tax_ded }

    update_form;
    END;


    PROCEDURE add_to_register;
    {
      PROCEDURE add_to_register(
    		chk_num	: INTEGER;
    		date   	: PACKED ARRAY [1..8] OF CHAR;
    		mem    	: PACKED ARRAY [$l1..$u1: INTEGER] OF CHAR;
    		amount 	: SIGNED;
    		balance	: UNSIGNED;
    		tax_ded	: unsigned_byte);

      Add an entry to the check register
      Assume that there is room in the register.
    }

    BEGIN

    register.number_entries_used := register.number_entries_used+1;
    register.entry[register.number_entries_used].reg_check_num := chk_num;
    register.entry[register.number_entries_used].reg_date      := date;
    register.entry[register.number_entries_used].reg_mem       := mem;
    register.entry[register.number_entries_used].reg_amount    := amount;
    register.entry[register.number_entries_used].reg_balance   := balance;
    register.entry[register.number_entries_used].reg_tax_ded   := tax_ded;

    END;


    PROCEDURE view_register;
    {
     View the check register, with the option of changing the tax-ded status.

     For the sake of a simple application (the form doesn't really care),
     we're dealing only with a fixed size register. We send the entire thing
     to the form and let it worry about scrolling or whatever. We get the entire
     register back, again for simplicity -- we really should get back just the
     tax deduction array, but that's more work and this is just a sample.

     Part of the record sent to the form is number_entries_used, which tells the
     number of meaningful entries, that is, how many are not blank.

     There are two possible returns from the form:
       	1. No  control text => TRANSMIT pressed: update has already happened
    			       because the record came back; return to menu
       	2. QUT control text => QUIT pressed: No update, return to menu
     In both cases, the routine doesn't really have to do anything
    }

    BEGIN
    { Transceive the record (send it and ask to get it back) }

    forms_status := forms$transceive(
		 session_id,		   { session id }
		 'register_record',        { send record name in form }
		 ,			   { Number of records sent, default 1 }
		 'register_record',        { receive record name in form }
		 ,			   { Number of records sent, default 1 }
		 receive_ctl_txt::char25,  { Receive ctl text msg }
		 receive_ctl_txt_ct,	   { Receive ctl text count }
                 ,,			   { Send ctl text msg/count }
                 ,			   { timeout }
                 ,			   { parent request id }
		 ,			   { request options item list }
		 register,	   	   { the send record  }
		 ,			   { send shadow record }
		 register,	   	   { the receive record  }
		 );			   { receive shadow record }
    check_forms_status( forms_status );

    END;


    PROCEDURE view_account_data;
    { Let the operator view and change the account data. }

    VAR
	account_temp		:  account_rec;	{temporary account data}
    BEGIN
    {
       Get new information for account record.  If termination was quit,
       then the operator might have changed a few things that the quit is
       supposed to ignore, so send the original account record back to the
       form and return to menu processing.
    }
        forms_status := forms$receive(
		     session_id,		{ session id }
		     'account',                 { record name in form }
		     ,			        { Number of records sent, default 1 }
		     receive_ctl_txt::char25,   { Receive ctl text msg }
		     receive_ctl_txt_ct,	{ Receive ctl text count }
		     ,,				{ Send ctl text msg/count }
		     ,				{ timeout }
		     ,				{ parent request id }
		     ,				{ request options item list }
		     account_temp,		{ the record  }
		     );				{ shadow record }
    check_forms_status( forms_status );

    IF quit_requested THEN
	BEGIN
	    {account data in form may have changed despite quit, change it back}
            forms_status := forms$send(
			 session_id,		{ session id }
		         'account',             { record name in form }
			 ,			{ Number of records sent, default 1 }
		         ,,			{ Receive ctl text msg/count }
			 ,,			{ Send ctl text msg/count }
			 ,			{ timeout }
			 ,			{ parent request id }
			 ,			{ request options item list }
			 account,		{ the record  }
			 );			{ shadow record }
	    check_forms_status( forms_status );
	END
    ELSE
	BEGIN
	{
	  This is where we would ordinarily update the account on the disk.
	  We don't do that because this is just a demo.  The new information
	  is available only during this session.
	}
			{...}

	{ Update the form with new name and city information. }
	account := account_temp;    {make changes permanent}
	name_and_address;
	END;

    END;


    [GLOBAL] PROCEDURE forms_checking_getsysinfo_(
	  VAR username : [ CLASS_S ] PACKED ARRAY [$l1..$u1: INTEGER] OF CHAR ;
	  VAR version  : [ CLASS_S ] PACKED ARRAY [$l2..$u2: INTEGER] OF CHAR) ;
   {
   Gets the user name and operating system name
   for display to the operator.
    }

    VAR
	len :  unsigned_word ;
    BEGIN

	lib$getjpi (
	    item_code := JPI$_USERNAME,
	    resultant_string := username);
	lib$getsyi (
	    item_code := SYI$_VERSION,
	    resultant_string := version,
	    resultant_length := len);
	version := 'VMS version:  ' + substr (version, 1, len);
    END;


VAR item_list: ARRAY[1..2] OF forms$item_list_type;

VAR print_file_name : [VOLATILE] PACKED ARRAY [1..31] OF CHAR :=
				'SYS$SCRATCH:FORMS$CHECKING_FORM';

BEGIN {Main program}

WRITELN( 'Pascal DECforms Sample Checking Account Application starting.');

{
  Set up printing to go to the operator's scratch directory. This involves
  passing a request_options parameter in the enable request, which in turn
  requires setting up an item list. This item list has one item and is ended
  with a zero longword.
}

item_list[1].length := 31;
item_list[1].code   := forms$k_printfile;
item_list[1].buff_addr := ADDRESS(print_file_name);
item_list[2].length := 0;
item_list[2].code   := 0;

{ Initialize the DECforms form & check for errors. }

forms_status := forms$enable(
        		    forms$ar_form_table,    { Vector address }
			    terminal,		    { Device name }
			    session_id,		    { returned from forms$ }
			    form_file,		    { Name of form file }
			    ,			    { Name of form }
			    ,			    { Receive ctl msg }
			    ,			    { Receive ctl ct }
			    ,			    { Send ctl msg }
			    ,			    { Send ctl ct }
			    ,			    { Timeout }
			    ,			    { Parent request id }
			    item_list);		    { Request options item list }
check_forms_status( forms_status );

{ Initialize account information }

initialize_account;

{ Process all operator requests }

do_operator_choice;

{ Clean up, Print ending message on console, leave. }

forms_status := forms$disable( Session_Id );
check_forms_status( forms_status );

WRITELN( 'Pascal DECforms Sample Checking Account Application ending.');

END.