HP 3000 Manuals HP 3000 Manuals
PASCAL
$TITLE 'VPLUS/V Data Entry Sample Program'$
{
This application collects employee payroll deduction transactions
and places the edited transactions into a file.
For this application: Enter key = edit and file transaction;
f8 = exit application;
all other f keys = redo transaction.
Each transaction entered by the operator is subjected to the data
edits embedded within the input form.
The application continues to collect transactions until either
the operator signals to exit or a system error is detected.
}
PROGRAM Pascal_Sample (output);
CONST
MAXWINDOWLEN = 150;
FILENAMELEN = 86;
TYPE
SMALL_INT = -32768..32767
PAC_ 2 = PACKED ARRAY [1..2] OF CHAR;
PAC_ 4 = PACKED ARRAY [1..4] OF CHAR;
PAC_ 8 = PACKED ARRAY [1..8] OF CHAR;
PAC_ 16 = PACKED ARRAY (1..16] OF CHAR;
PAC_ 70 = PACKED ARRAY [1..70] OF CHAR;
PAC_ 80 = PACKED ARRAY [1..80] OF CHAR;
PAC_ 200 = PACKED ARRAY [l..200] OF CHAR;
PAC_ FILENAME = PACKED ARRAY [1..FILENAMELEN] OF CHAR;
PAC_ MAXWINDOWLEN = PACKED ARRAY [1..MAXWINDOWLEN]
OF CHAR;
TWO_BYTE_SUB_RANGE = PACKED ARRAY [ 1. .2] OF 0. .255;
COMAREA REC = RECORD
CSTATUS : SMALL_INT;
LANGUAGE : SMALL_INT;
COMAREALEN : SMALL_INT;
USERBUFLEN : SMALL_INT;
CMODE : SMALL_INT;
LASTKEY : SMALL_INT;
NUMERRS : SMALL_INT;
WINDOWENH : SMALL_INT;
MULTIUSAGE : SMALL_INT;
LABELOPTIONS : SMALL_INT;
CFNAME : PAC_16;
NFNAME : PAC_16;
REPEATAPP : SMALL_INT;
FREEZEAPP : SMALL_INT;
CFNUMLINES : SMALL_INT;
DBUFLEN : SMALL_INT;
SKIP_31 : SMALL_INT;
LOOKAHEAD : SMALL_INT;
DELETEFLAG : SMALL_INT;
SHOWCONTROL : SMALL_INT;
SKIP_35 : SMALL_INT;
PRINTFILENUM : SMALL_INT;
FILERRNUM : SMALL_INT;
ERRFILENUM : SMALL_INT;
FORMSTORESIZE : SMALL_INT;
SKIP_40 : SMALL_INT;
SKIP_41 : SMALL_INT;
SKIP_42 : SMALL_INT;
NUMRECS : INTEGER;
RECNUM : INTEGER;
SKIP_47 : SMALL_INT;
SKIP_48 : SMALL_INT;
TERM_FILEN : SMALL_INT;
SKIP 50 : SMALL_INT;
SKIP_51 : SMALL_INT;
SKIP_52 : SMALL_INT;
SKIP_53 : SMALL_INT;
SKIP_54 : SMALL_INT;
RETRIES : SMALL_INT;
TERM_OPTIONS : SMALL_INT;
ENVIRON : SMALL_INT;
USERTIME : SMALL_INT;
IDENTIFIER : SMALL_INT;
LABELINFO :TWO_BYTE_SUB_RANGE;
END;
FIELDENTRY_REC = PACKED RECORD
FIELD_NAME : PAC_16;
SCREEN_ORDER : SMALL_INT;
END;
FIELDINFO REC = PACKED RECORD
NUM_ENTRIES : SMALL_INT;
ENTRY_LEN : SMALL_INT;
FORM_NAME : PAC 16;
FIELDENTRY_ENTRY : PACKED ARRAY [1..3] OF FIELDENTRY_REC;
END;
FIELDSPECS_REC = RECORD
FIELD_ID : SMALL_INT;
CHANGE_TYPE : SMALL_INT;
CHANGE_SPEC : PAC_4;
END;
CONST
LABELINFO_INIT = TWO_BYTE_SUB_RANGE [2 OF 0];
{ Comarea initialization constant record }
COMAREA_INIT = COMAREA REC
[ CSTATUS : 0,
LANGUAGE : 5, {Pascal }
COMAREALEN :60,
USERBUFLEN : 0,
CMODE : 0,
LASTKEY : 0,
NUMERRS : 0,
WINDOWENH : 0,
MULTIUSAGE : 0,
LABELOPTIONS : 1, {activate labels}
CFNAME : ",
NFNAME : ",
REPEATAPP : 0,
FREEZEAPP : 0,
CFNUMLINES : 0,
DBUFLEN : 0,
SKIP_31 : 0,
LOOKAHEAD : 0, {no form background loading}
DELETEFLAG : 0,
SHOWCONTROL : 0,
SKIP_35 : 0,
PRINTFILENUM : 0,
FILERRNUM : 0,
ERRFILENUM : 0,
FORMSTORESIZE : 4, {local form storage}
SKIP_40 : 0,
SKIP_41 : 0,
SKIP_42 : 0,
NUMRECS : 0,
RECNUM : 0,
SKIP_47 : 0,
SKIP_48 : 0,
TERM_FILEN : 0,
SKIP_50 : 0,
SKIP_51 : 0,
SKIP_52 : 0,
SKIP_53 : 0,
SKIP_54 : 0,
RETRIES : 0,
TERM_OPTIONS : 0,
ENVIRON : 0,
USERTIME : 0,
IDENTIFIER : 0,
LABELINFO : LABELINFO_INIT ];
VAR
COMAREA : COMAREA_REC;
DATABUF : PAC_200;
DATABUFLEN : SMALL_INT;
DONE_WITH_TRANSACTIONS : BOOLEAN;
ERROR_LOCATION : PAC_70;
FIELDINFO : FIELDINFO_REC;
FIELDSPECS : ARRAY [1..3] OF FIELDSPECS_REC;
FILENAME : PAC_FILENAME;
FOUND_DATA_ERRORS : BOOLEAN;
INFOBUFLEN : SMALL_INT;
MSGBUF : PAC MAXWINDOWLEN;
MSGBUFLEN : SMALL_INT;
ERRMSGLEN : SMALL_INT;
NBR_TXN_COLLECTED : INTEGER;
NUMSPECS : SMALL_INT;
STOP_NOW : BOOLEAN;
TXN_FILE : TEXT;
{ Procedure Declarations }
PROCEDURE VCHANGEFIELD ; INTRINSIC;
PROCEDURE VCLOSEFORMF ; INTRINSIC;
PROCEDURE VCLOSETERM ; INTRINSIC;
PROCEDURE VERRMSG ; INTRINSIC;
PROCEDURE VFIELDEDITS ; INTRINSIC;
PROCEDURE VFINISHFORM ; INTRINSIC;
PROCEDURE VGETBUFFER ; INTRINSIC;
PROCEDURE VGETFIELDINFO ; INTRINSIC;
PROCEDURE VGETNEXTFORM ; INTRINSIC;
PROCEDURE VINITFORM ; INTRINSIC;
PROCEDURE VOPENFORMF ; INTRINSIC;
PROCEDURE VOPENTERM ; INTRINSIC;
PROCEDURE VPUTWINDOW ; INTRINSIC;
PROCEDURE VREADFIELDS ; INTRINSIC;
PROCEDURE VSHOWFORM ; INTRINSIC;
PROCEDURE DISPLAY_SYSTEM_ERROR;
BEGIN
WRITELN ('**** Transaction collection facility detected system ',
'error at: ',
ERROR_LOCATION);
WRITELN ('**** The error message returned is:');
WRITELN ('**** ', MSGBUF : MSGBUFLEN);
END;
PROCEDURE CLEANUP_AFTER_WORK;
{ Note that this procedure unconditionally attempts to close
the forms file and terminal }
BEGIN
CLOSE (TXN_FILE);
COMAREA.CSTATUS := 0;
VCLOSEFORMF (COMAREA);
COMAREA.CSTATUS := 0;
VCLOSETERM (COMAREA);
END;
PROCEDURE GET_ERROR_MESSAGE;
BEGIN
MSGBUFLEN := MAXWINDOWLEN;
VERRMSG (COMAREA,
MSGBUF,
MSGBUFLEN,
ERRMSGLEN);
END;
PROCEDURE PROMPT_OPERATOR;
BEGIN
GET_ERROR_MESSAGE;
VPUTWINDOW (COMAREA,
MSGBUF,
ERRMSGLEN);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_ NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Prompt Operator - Window Load';
GET ERROR_MESSAGE;
END;
IF NOT (STOP_NOW) THEN
BEGIN
{ Display update }
VSHOWFORM {COMAREA};
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
: = '**** procedure: Collect Transactions - Display Update';
GET_ERROR_MESSAGE;
END;
END; { Display update }
END; {Procedure Prompt Operator }
PROCEDURE READ_EDIT_FILE_TRANSACTION;
BEGIN
VREADFIELDS (COMAREA);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Read, Edit, and File - Terminal Read';
GET ERROR_MESSAGE;
END;
IF NOT (STOP_NOW) THEN
{ Determine if operator wants to stop transaction collection }
IF COMAREA.LASTKEY = 8 THEN
DONE_WITH_TRANSACTIONS := TRUE;
IF (NOT (STOP_NOW))
AND (NOT (DONE_WITH_TRANSACTIONS)) THEN
BEGIN
{ Edit data }
VFIELDEDITS (COMAREA);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Read, Edit, and File - Data Edit';
GET ERROR_MESSAGE;
END;
IF NOT (STOP_NOW) THEN
{ Determine if edit errors }
IF COMAREA.NUMERRS < 1 THEN
FOUND_DATA_ERRORS := FALSE; { Was true before }
END; { Edit data }
IF (NOT (STOP_NOW))
AND (NOT (DONE WITH TRANSACTIONS))
AND (NOT (FOUND_DATA_ERRORS)) THEN
BEGIN
{ Finish form data }
VFINISHFORM (COMAREA);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Read, Edit, and File - Data Finishing';
GET_ERROR_MESSAGE;
END;
IF NOT (STOP_NOW) THEN
{ Determine if finishing errors }
IF COMAREA.NUMERRS > 0 THEN
FOUND_DATA_ERRORS := TRUE; { Was false before }
END; { Finish form data }
IF (NOT (STOP_NOW))
AND (NOT (DONE_WITH_TRANSACTIONS)) THEN
{ Do we have a transaction that can be filed? }
IF NOT (FOUND_DATA_ERRORS) THEN
IF COMAREA.LASTKEY = 0 { Enter key } THEN
BEGIN
{ Get transaction from form and file it }
DATABUF := ";
DATABUFLEN := 200;
VGETBUFFER (COMAREA,
DATABUF,
DATABUFLEN);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Read, Edit, and File - Data Get';
GET_ERROR_MESSAGE;
END;
IF NOT (STOP_NOW) THEN
BEGIN
WRITELN (TXN_FILE, DATABUF : DATABUFLEN);
NBR_TXN_COLLECTED := NBR_TXN_COLLECTED + 1;
END;
END; { Get transaction from form and file it }
IF (NOT (STOP_NOW))
AND (NOT (DONE_WITH_TRANSACTIONS)) THEN
{ Do we need to prompt the operator to correct errors? }
IF FOUND_DATA_ERRORS THEN
IF COMAREA.LASTKEY = 0 { Enter key } THEN
PROMPT_OPERATOR;
IF (NOT (STOP_NOW))
AND (NOT (DONE_WITH_TRANSACTIONS)) THEN
{ Do we need to refresh the display? }
IF COMAREA.LASTKEY <> 0 THEN
{ Operator pressed some key other than Enter or Exit
so clear data error flag to break loop }
FOUND_DATA_ERRORS := FALSE;
END; { Procedure Read, Edit, and File Transaction }
PROCEDURE COLLECT_TRANSACTIONS;
BEGIN
{ Setup for and get transaction entry form }
COMAREA.REPEATAPP := 0;
COMAREA.FREEZEAPP := 0;
COMAREA.NFNAME := 'DEDUCTION';
VGETNEXTFORM (COMAREA);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Collect Transactions - Form Retrieval';
GET_ERROR_MESSAGE;
END;
IF NOT (STOP_NOW) THEN
BEGIN
{ Toggle three fields in form to "input allowed" }
{ Screen order is indicated to field change intrinsic
as negative number }
FIELDSPECS [1].FIELD ID
:= FIELDINFO.FIELDENTRY [1].SCREEN_ORDER * (-1);
FIELDSPECS [1].CHANGE_TYPE := 5; { change field type }
FIELDSPECS [1].CHANGE_SPEC := 'O'; {input and output }
FIELDSPECS [2].FIELD ID
:= FIELDINFO.FIELDENTRY [2].SCREEN_ORDER * (-1);
FIELDSPECS [2].CHANGE_TYPE := 5; { change field type }
FIELDSPECS [2].CHANGE_SPEC := 'O'; {input and output }
FIELDSPECS [3].FIELD ID
:= FIELDINFO.FIELDENTRY [3].SCREEN_ORDER * (-1);
FIELDSPECS [3].CHANGETYPE := 5; { change field type }
FIELDSPECS [3].CHANGESPEC := 'O'; {input and output }
NUMSPECS := 3;
VCHANGEFIELD (COMAREA,
FIELDSPECS,
NUMSPECS);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Collect Transactions - Field Type Updates';
GET_ERROR_MESSAGE;
END;
END; { Toggle three fields in form }
IF NOT (STOP_NOW) THEN
BEGIN
{ Load window message }
MSGBUFLEN := 79;
MSGBUF
:= 'Fill in Deduction Transaction according to worksheet.';
VPUTWINDOW (COMAREA,
MSGBUF,
MSGBUFLEN);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Collect Transactions - Window Load';
GET_ERROR_MESSAGE;
END,
END; { Load window message }
IF NOT (STOP_NOW) THEN
BEGIN
{ Init form }
VINITFORM (COMAREA);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Collect Transactions - Form Init';
GET_ERROR_MESSAGE;
END;
END; { Init form }
IF NOT (STOP_NOW) THEN
BEGIN
{ Show form }
VSHOWFORM (COMAREA);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
: = '**** procedure: Collect Transactions - Form Display';
GET_ERROR_MESSAGE;
END;
END; { Show form }
IF NOT (STOP_NOW) THEN
BEGIN
{ Setup and loop on transaction until it can be filed }
FOUND_DATA_ERRORS := TRUE;
WHILE (FOUND_DATA_ERRORS)
AND (NOT (STOP_NOW))
AND (NOT (DONE_WITH_TRANSACTIONS)) DO
READ_EDIT_FILE_TRANSACTION;
END;
END; { Procedure Collect Transactions }
PROCEDURE SETUP_FOR_WORK;
BEGIN
{ Init Comarea }
COMAREA := COMAREA_INIT;
{ Open Transaction File so that new transactions are
added to those already in the file }
APPEND (TXN_FILE, 'PAYTXN');
{ Open forms file }
FILENAME := 'PAYROLL.WORK.ADMIN';
VOPENFORMF (COMAREA,
FILENAME);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Setup For Work - Forms File Open';
GET_ERROR_MESSAGE;
END;
IF NOT (STOP_NOW) THEN
BEGIN
{ Open terminal }
FILENAME := 'HPTERM';
VOPENTERM (COMAREA,
FILENAME);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
:= '**** procedure: Setup For Work - Terminal Open';
GET_ERROR_MESSAGE;
END;
END; { Open terminal }
IF NOT (STOP_NOW) THEN
BEGIN
{ Translate field names to screen orders }
{ Three of the fields in the form used by this application
need to be toggled from "display only" to "input allowed".
In order to do this, we first translate field names to
screen orders. }
{ Setup to retrieve screen order for three specified fields }
FIELDINFO.NUM_ENTRIES := 3;
FIELDINFO.ENTRY_LEN := 9; { Field name key and screen order }
FIELDINFO.FORM_NAME := 'DEDUCTION';
FIELDINFO.FIELDENTRY [1].FIELD_NAME := 'BADGE_NUMBER';
FIELDINFO.FIELDENTRY [1].SCREEN_ORDER := 8224; {ASCII blanks}
FIELDINFO.FIELDENTRY [2].FIELD_NAME := 'LAST_NAME';
FIELDINFO.FIELDENTRY [2].SCREEN_ORDER := 8224; {ASCII blanks}
FIELDINFO.FIELDENTRY [3].FIELD_NAME := 'SUR_NAME';
FIELDINFO.FIELDENTRY [3].SCREEN_ORDER := 8224; {ASCII blanks}
{ Set length of entire info buffer }
INFOBUFLEN
:= (FIELDINFO.NUM_ENTRIES * FIELDINFO.ENTRY_LEN) + 10;
VGETFIELDINFO (COMAREA,
FIELDINFO,
INFOBUFLEN);
IF COMAREA.CSTATUS <> 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION
: = '**** procedure: Setup For Work - Field Info Retrieval';
GET_ERROR_MESSAGE;
END;
END; { Translate field names to screen orders }
END; { Procedure Setup For Work }
BEGIN
{ Sample program outer block }
STOP_NOW := FALSE;
DONE_WITH_TRANSACTIONS := FALSE;
NBR_TXN_COLLECTED := 0;
SETUP_FOR_WORK;
WHILE (NOT (STOP_NOW))
AND (NOT (DONE_WITH_TRANSACTIONS)) DO
COLLECT_TRANSACTIONS;
CLEANUP_AFTER_WORK;
WRITELN ('Deduction transactions collected this session = ',
NBR_TXN_COLLECTED);
IF STOP NOW THEN
DISPLAY_SYSTEM_ERROR;
END.