$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 = 0..65535
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;
FIEL_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,
SKIF_51 : 0,
SKIP_52 : 0,
SKIP_53 : 0,
SKIP_54 : 0,
RETRIES : 0,
TERM_OPTIONS : 0,
ENVIR0N : 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 messaged 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 }
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.
