HP 3000 Manuals HP 3000 Manuals
Pascal Sample Program
$code_offsets on$
$tables on$
{
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_EXAMPLE (OUTPUT);
TYPE
COMAREA_TYPE = ARRAY [1..75] OF INTEGER;
GLOBALPAK_REC = RECORD
EXPECTEDVUF : PACKED ARRAY [1..8] OF CHAR;
CALLPROTOCOL : INTEGER;
COMAREALEN : INTEGER;
COMAREA : COMAREA_TYPE;
END;
RETURNPAK_REC = RECORD
RETURNSTATUS : INTEGER;
SUBLAYERSTATUS : INTEGER;
RETURNMSGLEN : INTEGER;
RETURNMSG : PACKED ARRAY [1..256] OF CHAR;
LASTITEMTYPE : INTEGER;
LASTITEMNUM : INTEGER;
LASTITEMNAME : PACKED ARRAY [1..32] OF CHAR;
NUMDATAERRS : INTEGER;
NUMCHNGFLDS : INTEGER;
END;
FORMSFILE_REC = RECORD
FFNAME : PACKED ARRAY [1..88] OF CHAR;
END;
TERMPAK_REC = RECORD
TERMNAME : PACKED ARRAY [1..88] OF CHAR;
BYPASSFEATURE : INTEGER;
END;
SENDPAK_REC = RECORD
DONTENABLEINPUT : INTEGER;
WINDOWENH : PACKED ARRAY [1..8] OF CHAR;
BYPASSFEATURE : INTEGER;
END;
CHNGENTRY_REC = RECORD
FIELD_ID : PACKED ARRAY [1..32] OF CHAR;
CHANGE_TYPE : INTEGER;
CHANGE_SPEC : PACKED ARRAY [1..8] OF CHAR;
END;
FORMPAK_REC = RECORD
FORMNAME : PACKED ARRAY [1..32] OF CHAR;
FORMPOSITION : INTEGER;
LISTTYPE : INTEGER;
LISTCOUNT : INTEGER;
CHNGENTRY : ARRAY [1..3] OF CHNGENTRY_REC;
END;
MSG_REC = RECORD
MSGLEN : INTEGER;
MSGAREA : PACKED ARRAY [1..79] OF CHAR;
END;
DATADESCRPT_REC = RECORD
DESCRPTTYPE : INTEGER;
BUFLEN : INTEGER;
RTNBUFLEN : INTEGER;
END;
DATABUF_REC = RECORD
DATAAREA : PACKED ARRAY [1..200] OF CHAR;
END;
READPAK_REC = RECORD
READTIME : INTEGER;
ENABLEREFORMAT : INTEGER;
DOREREAD : INTEGER;
END;
PROMPTPAK_REC = RECORD
REPAINTDATA : INTEGER;
WINDOWENH : PACKED ARRAY [1..8] OF CHAR;
RESETHILITED : INTEGER;
END;
VAR
ARRAY_INDEX : INTEGER;
DATABUF : DATABUF_REC;
DATADESCRPT : DATADESCRPT_REC;
DATA_ENTRY_ERRS : BOOLEAN;
DONE_WITH_TXNS : BOOLEAN;
ERROR_LOCATION : PACKED ARRAY [1..70] OF CHAR;
FORMPAK : FORMPAK_REC;
FORMSFILE : FORMSFILE_REC;
GLOBALPAK : GLOBALPAK_REC;
MSGFORWINDOW : MSG_REC;
NBR_TXNS_COLLECTED : INTEGER;
PAYTXN_FILE : TEXT;
PROMPTPAK : PROMPTPAK_REC;
READPAK : READPAK_REC;
RETURNPAK : RETURNPAK_REC;
SENDPAK : SENDPAK_REC;
STOP_NOW : BOOLEAN;
TERMPAK : TERMPAK_REC;
UNUSED_PARM : INTEGER;
PROCEDURE HPDOPENFORMS ; INTRINSIC;
PROCEDURE HPDENABLETERM ; INTRINSIC;
PROCEDURE HPDSEND ; INTRINSIC;
PROCEDURE HPDREAD ; INTRINSIC;
PROCEDURE HPDPROMPT ; INTRINSIC;
PROCEDURE HPDCLOSEFORMS ; INTRINSIC;
PROCEDURE HPDDISABLETERM ; INTRINSIC;
$TITLE ' Display System Error'$
{
*****************************************************************
* *
* Display System Error *
* *
*****************************************************************
}
PROCEDURE DISPLAY_SYSTEM_ERROR;
BEGIN
WRITELN ('Transaction entry facility detected system error at:');
WRITELN (ERROR_LOCATION);
WRITELN ('**** The error message returned is:');
WRITELN (MSGFORWINDOW.MSGAREA:MSGFORWINDOW.MSGLEN);
END; { PROCEDURE DISPLAY_SYSTEM_ERROR }
$TITLE ' Unblock Message'$
{
*****************************************************************
* *
* Unblock Message *
* *
*****************************************************************
}
PROCEDURE UNBLOCK_MESSAGE;
BEGIN
ARRAY_INDEX := 1;
WHILE ARRAY_INDEX <= RETURNPAK.RETURNMSGLEN DO
BEGIN
MSGFORWINDOW.MSGAREA [ARRAY_INDEX]
:= RETURNPAK.RETURNMSG [ARRAY_INDEX];
ARRAY_INDEX := ARRAY_INDEX + 1;
END;
MSGFORWINDOW.MSGLEN := RETURNPAK.RETURNMSGLEN;
END; { PROCEDURE UNBLOCK_MESSAGE }
$TITLE ' Cleanup After Work'$
{
*****************************************************************
* *
* Cleanup After Work *
* *
*****************************************************************
}
PROCEDURE CLEANUP_AFTER_WORK;
BEGIN
{ Note that this routine unconditionally attempts to close
the Forms File and Terminal. }
CLOSE (PAYTXN_FILE,
'SAVE');
HPDCLOSEFORMS (GLOBALPAK,
RETURNPAK,
FORMSFILE);
HPDDISABLETERM (GLOBALPAK,
RETURNPAK,
TERMPAK,
UNUSED_PARM);
END; { PROCEDURE CLEANUP_AFTER_WORK }
$TITLE ' Prompt Operator'$
{
*****************************************************************
* *
* Prompt Operator *
* *
*****************************************************************
}
PROCEDURE PROMPT_OPERATOR;
BEGIN
{ Get error message. }
UNBLOCK_MESSAGE;
{ No special Prompt instructions. }
PROMPTPAK.REPAINTDATA := 0;
PROMPTPAK.WINDOWENH := ;
PROMPTPAK.RESETHILITED := 0;
{ Display form with highlighted fields and error message
in window. }
HPDPROMPT (GLOBALPAK,
RETURNPAK,
PROMPTPAK,
UNUSED_PARM,
MSGFORWINDOW,
UNUSED_PARM,
UNUSED_PARM,
UNUSED_PARM);
IF RETURNPAK.RETURNSTATUS
0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION :=
'**** Routine: Prompt Operator - Display Updates';
UNBLOCK_MESSAGE;
END;
END; { PROCEDURE PROMPT_OPERATOR }
$TITLE ' Read Edit and File'$
{
!***************************************************************!
! !
! Read Edit and File !
! !
!***************************************************************!
}
PROCEDURE READ_EDIT_AND_FILE;
BEGIN
{ Enable data finishing. }
READPAK.ENABLEREFORMAT := 1;
{ No other special Read instructions. }
READPAK.READTIME := 0;
READPAK.DOREREAD := 0;
{ Indicate that all data in form, up to 200 bytes, is to be
copied into application work space. }
DATADESCRPT.DESCRPTTYPE := 10;
DATADESCRPT.BUFLEN := 200;
{ Read form. }
HPDREAD (GLOBALPAK,
RETURNPAK,
READPAK,
UNUSED_PARM,
UNUSED_PARM,
DATADESCRPT,
DATABUF,
UNUSED_PARM);
IF RETURNPAK.RETURNSTATUS < 0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION :=
'**** Routine: Read Edit and File - Terminal Read';
UNBLOCK_MESSAGE;
END;
{ Determine if operator wants to stop transaction collection. }
IF NOT STOP_NOW
AND (RETURNPAK.RETURNSTATUS = 0) THEN
IF (RETURNPAK.LASTITEMTYPE = 0)
AND (RETURNPAK.LASTITEMNUM = 8) THEN
DONE_WITH_TXNS := TRUE;
{ Determine if edit errors detected. }
IF NOT STOP_NOW
AND NOT DONE_WITH_TXNS THEN
IF RETURNPAK.RETURNSTATUS = 0 THEN
DATA_ENTRY_ERRS := FALSE
ELSE
DATA_ENTRY_ERRS := TRUE;
{ Do we have a transaction that can be filed? }
IF NOT STOP_NOW
AND NOT DONE_WITH_TXNS THEN
IF NOT DATA_ENTRY_ERRS
AND (RETURNPAK.LASTITEMTYPE = 0)
AND (RETURNPAK.LASTITEMNUM = 0) THEN
BEGIN
{ Write Databuf to Transaction File. }
WRITELN (PAYTXN_FILE,
DATABUF.DATAAREA : DATADESCRPT.RTNBUFLEN);
NBR_TXNS_COLLECTED := NBR_TXNS_COLLECTED + 1;
END;
{ Do we need to prompt the operator to correct errors? }
IF NOT STOP_NOW
AND NOT DONE_WITH_TXNS THEN
IF DATA_ENTRY_ERRS THEN
IF (RETURNPAK.LASTITEMTYPE = 0)
AND (RETURNPAK.LASTITEMNUM = 0) THEN
PROMPT_OPERATOR
ELSE
{ Operator pressed some key other than ENTER or
EXIT so, clear data error flag to break loop
(display refresh results). }
DATA_ENTRY_ERRS := FALSE;
END; { PROCEDURE READ_EDIT_AND_FILE }
$TITLE ' Collect Transactions'$
{
!***************************************************************!
! !
! Collect Transactions !
! !
!***************************************************************!
}
PROCEDURE COLLECT_TRANSACTIONS;
BEGIN
{ No special Send instructions. }
SENDPAK.DONTENABLEINPUT := 0;
SENDPAK.WINDOWENH := ";
SENDPAK.BYPASSFEATURE := 0;
{ Setup to get and modify data entry form, toggling three
fields to 'input allowed'. }
FORMPAK.FORMNAME := 'DEDUCTION';
{ Position form to start at top left of display (home). }
FORMPAK.FORMPOSITION := 0;
{ Indicate that the fields in the form which will be modified
are identified by name. }
FORMPAK.LISTTYPE := 2;
{ Indicate the number of fields to modify. }
FORMPAK.LISTCOUNT := 3;
{ List fields to be modified, indicate modification type, and
new value. }
FORMPAK.CHNGENTRY [1].FIELD_ID := 'BADGE_NUMBER';
FORMPAK.CHNGENTRY [1].CHANGE_TYPE := 5;
FORMPAK.CHNGENTRY [1].CHANGE_SPEC := 'O';
FORMPAK.CHNGENTRY [2].FIELD_ID := 'LAST_NAME';
FORMPAK.CHNGENTRY [2].CHANGE_TYPE := 5;
FORMPAK.CHNGENTRY [2].CHANGE_SPEC := 'O';
FORMPAK.CHNGENTRY [3].FIELD_ID := 'SUR_NAME';
FORMPAK.CHNGENTRY [3].CHANGE_TYPE := 5;
FORMPAK.CHNGENTRY [3].CHANGE_SPEC := 'O';
{ Setup window message. }
MSGFORWINDOW.MSGLEN := 79;
MSGFORWINDOW.MSGAREA :=
'Fill in Deduction Transaction according to worksheet.';
{ Don't copy application data out to display. }
DATADESCRPT.DESCRPTTYPE := -1;
{ Show Form. }
HPDSEND (GLOBALPAK,
RETURNPAK,
SENDPAK,
FORMPAK,
UNUSED_PARM,
MSGFORWINDOW,
DATADESCRPT,
UNUSED_PARM,
UNUSED_PARM,
UNUSED_PARM);
IF RETURNPAK.RETURNSTATUS
0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION :=
'**** Routine: Collect Transactions - Form display';
UNBLOCK_MESSAGE;
END;
{ Setup and loop on transaction until it can be filed. }
DATA_ENTRY_ERRS := TRUE;
WHILE DATA_ENTRY_ERRS
AND NOT STOP_NOW
AND NOT DONE_WITH_TXNS DO
READ_EDIT_AND_FILE;
END; { PROCEDURE COLLECT_TRANSACTIONS }
$TITLE ' Setup For Work'$
{
*****************************************************************
* *
* Setup For Work *
* *
*****************************************************************
}
PROCEDURE SETUP_FOR_WORK;
BEGIN
{ Init Unused Parm which is used whenever intrinsic input
parameter is not active. }
UNUSED_PARM := 0;
{ Init Comarea to all zeros. }
ARRAY_INDEX := 1;
WHILE ARRAY_INDEX <= 75 DO
BEGIN
GLOBALPAK.COMAREA [ARRAY_INDEX] := 0;
ARRAY_INDEX := ARRAY_INDEX + 1;
END;
{ Set Expected HP32424A Version. }
GLOBALPAK.EXPECTEDVUF := 'A.00.00';
{ Set Language for Pascal. }
GLOBALPAK.CALLPROTOCOL := 500;
{ Set Comarealen for 300 bytes. }
GLOBALPAK.COMAREALEN := 300;
{ Open the Transaction File. }
APPEND (PAYTXN_FILE,
'PAYTXN');
{ Open the Forms File. }
FORMSFILE.FFNAME := 'PAYROLL.WORK.ADMIN';
HPDOPENFORMS (GLOBALPAK,
RETURNPAK,
FORMSFILE);
IF RETURNPAK.RETURNSTATUS
0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION :=
'**** Routine: Setup For Work - Forms File Open';
UNBLOCK_MESSAGE;
END;
IF NOT STOP_NOW THEN
BEGIN
TERMPAK.TERMNAME := 'HPTERM';
TERMPAK.BYPASSFEATURE := 0;
HPDENABLETERM (GLOBALPAK,
RETURNPAK,
TERMPAK,
UNUSED_PARM);
IF RETURNPAK.RETURNSTATUS
0 THEN
BEGIN
STOP_NOW := TRUE;
ERROR_LOCATION :=
'**** Routine: Setup For Work - Terminal Setup';
UNBLOCK_MESSAGE;
END;
END;
END; { PROCEDURE SETUP_FOR_WORK }
$TITLE ' Main Program'$
{
*****************************************************************
* *
* Main Program *
* *
*****************************************************************
}
BEGIN
STOP_NOW := FALSE;
DONE_WITH_TXNS := FALSE;
NBR_TXNS_COLLECTED := 0;
SETUP_FOR_WORK;
WHILE NOT STOP_NOW
AND NOT DONE_WITH_TXNS DO
COLLECT_TRANSACTIONS;
CLEANUP_AFTER_WORK;
WRITELN ('Deduction transactions collected this session = ',
NBR_TXNS_COLLECTED);
IF STOP_NOW THEN
DISPLAY_SYSTEM_ERROR;
END. { Main Program }"