HP 3000 Manuals HP 3000 Manuals
SPL
$PAGE "HP32209B.04.17 VPLUS/V S40S209B, ENTRY"
$COPYRIGHT " " , &
$ " " , &
$ " (c) COPYRIGHT HEWLETT-PACKARD. 1986 " , &
" , &
$ "This program may be used with one computer system at a time " , &
$ "and shall not otherwise be recorded, transmitted or stored " , &
$ "in a retrieval system. Copying or other reproduction of this " , &
$ "program except for archival purposes is prohibited without " , &
$ "the prior written consent of the Hewlett-Packard Company. " , &
<< >>
$CONTROL USLINIT, LIST, MAP, CODE
<<****************************************************************>>
<< >>
<< ENTRY--VPLUS/V Data Entry Program >>
<< >>
<< 9/1/79 >>
<< >>
<<****************************************************************>>
<<
This program controls source data entry for any forms file.
It opens a forms file, based on user input; it opens a batch
file, also named by the user. If all is ok, it displays the
head form, accepts input, edits the data, and if no errors,
writes it to the batch file. The program continues to do this
until $END is reached, or until the EXIT function key has been
pressed.
This program also controls browsing through the data collected,
and supports modification of that data.
The function keys have defined meanings as follows:
f1 f2 f3 f4
HEAD DELETE PRINT REFRESH
f5 f6 f7 f8
PREV NEXT BROWSE/ EXIT
COLLECT
>>
$PAGE " "ENTRY DECLARATIONS"
<<****************************************************************>>
<< >>
<< ENTRY Global Declarations >>
<< >>
<<****************************************************************>>
BEGIN
DEFINE
VERSION = " B.04.17" #
,ID'MSG=("HP32209",VERSION," ENTRY (C) HEWLETT-PACKARD CO. 1986")#
;
DEFINE
COM'STATUS = COMAREA (0) #
,COM'LANGUAGE = COMAREA (1) #
,COM'COMAREALEN = COMAREA (2) #
,COM'MODE = COMAREA (4) #
,COM'LASTKEY = COMAREA (5) #
,COM'NUMERRS = COMAREA (6) #
,COM'LABEL'OPTION = COMAREA (9) #
,COM'CFNAME = COMAREA'B (10*2) #
,COM'NFNAME = COMAREA'B (18*2) #
,COM'REPEATOPT = COMAREA (26) #
,COM'NFOPT = COMAREA (27) #
,COM'DBUFLEN = COMAREA (29) #
,COM'DELETEFLAG = COMAREA (32) #
,COM'SHOWCONTROL = COMAREA (33) #
,COM'NUMRECS = COMAREA'D (21) #
,COM'RECNUM = COMAREA'D (22) #
,COM'TERMFILENUM = COMAREA (48) #
,COM'TERMOPTIONS = COMAREA (55) #
,com'term'type = comarea (58) #
,com'keyboard'type = comarea (74) #
,com'form'stor'size = comarea (38) #
;
DEFINE
CHECK'ERROR = IF COM'STATUS <>' 0 THEN
ERROR #
,CHECK'EDIT'ERROR = IF COM'STATUS <> 0 OR COM'NUMERRS <> 0 THEN
ERROR #
;
EQUATE << MISCELLANEOUS VALUES >>
COMAREALEN = 85
,SPL'LANG = 3
,COLLECT'MODE = 0
,BROWSE'MODE = 1
,MAXWINDOWLEN = 150
,NAMELEN = 15
,NORM = 0
,NOREPEAT = 0
,REPEAT = 1
,REPEATAPP = 2
,ESC = 27
,FORWARDS = 1
,BACKWARDS = -1
;
EQUATE << FUNCTION KEY ASSIGNMENTS >>
ENTERKEY = 0
,HEADKEY = 1
,DELETEKEY = 2
,PRINTKEY = 3
,REFRESHKEY = 4
,PREVKEY = 5
,NEXTKEY = 6
,BROWSEKEY = 7
,EXITKEY = 8
;
EQUATE << ENTRY ERROR EQUATES >>
PREV'NOT'ALLOWED = 1
,NO'PREV'RECS = 2
,NOT'REPEATING = 3
,DELETE'NOT'DEFINED = 4
,NO'BATCH'RECS = 5
,NO'BATCH = 6
,NO'NEXT'RECS = 7
;
EQUATE << NATIVE LANGUAGE SUPPORT EQUATES >>
INTERNATIONAL = -1
;
INTEGER ARRAY
COMAREA (O:COMAREALEN-1) := COMAREALEN (0)
;
BYTE ARRAY
COMAREA'B (*) = COMAREA
;
DOUBLE ARRAY
COMAREA'D (*) = COMAREA
;
LOGICAL
ERRORS := FALSE
,BATCH
;
ARRAY
MESSAGE'WBUF (0:MAXWINDOWLEN/2)
;
BYTE ARRAY
MESSAGE'BUF (*) = MESSAGE'WBUF
;
INTEGER
PARMVAL := 20
,UNDERLINE := 1
,MESSAGE'BUF'LEN := MAXWINDOWLEN
,MSGLEN
,PAGE'EJECT := %61
;
DOUBLE
LAST'REC'NUM
;
$PAGE " VPLUS/V INTRINSIC DECLARATIONS"
<<****************************************************************>>
<< >>
<< VPLUS/V INTRINSICS >>
<< >>
<<****************************************************************>>
INTRINSIC
VCLOSEBATCH
,VCLOSEFORMF
,VCLOSETERM
,VERRMSG
,VFIELDEDITS
,VFINISHFORM
,VGETNEXTFORM
,VINITFORM
,VOPENBATCH
,VOPENFORMF
,VOPENTERM
,VPOSTBATCH
,VPRINTFORM
,VPUTWINDOW
,VREADBATCH
,VREADFIELDS
,VSHOWFORM
,VWRITEBATCH
,VGETKEYLABELS
,VSETKEYLABELS
,VSETKEYLABEL
,VSETLANG
,VGETLANG
;
<<****************************************************************>>
<< >>
<< DO'COLLECT'LABELS >>
<< >>
<<****************************************************************>>
PROCEDURE DO'COLLECT'LABELS;
BEGIN
BYTE ARRAY LABELS(0:127);
INTEGER NUMBER'OF'LABELS,GLOB'FORM;
MOVE LABELS := (
<< FUNCTION KEY 1 >> " HEAD FORM "
<< FUNCTION KEY 2 >> ," "
<< FUNCTION KEY 3 >> ," PRINT "
<< FUNCTION KEY 4 >> ,"REFRESH "
<< FUNCTION KEY 5 >> ," "
<< FUNCTION KEY 6 >> ," NEXT FORM "
<< FUNCTION KEY 7 >> ," BROWSE "
<< FUNCTION KEY 8 >> ," EXIT
);
GLOB'FORM := 0; << GLOBAL LABELS >>
NUMBER'OF'LABELS := 8;
VSETKEYLABELS(COMAREA,GLOB'FORM,NUMBER'OF'LABELS, LABELS);
END;
<<****************************************************************>>
<< >>
<< DO'BROWSE'LABELS >>
<< >>
<<****************************************************************>>
PROCEDURE DO'BROWSE'LABELS;
BEGIN
BYTE ARRAY LABELS(0:127);
INTEGER NUMBER'OF'LABELS,GLOB'FORM;
MOVE LABELS := (
<< FUNCTION KEY 1 >> " FIRST REC "
<< FUNCTION KEY 2 >> ," DELETE REC "
<< FUNCTION KEY 3 >> ," PRINT "
<< FUNCTION KEY 4 >> ,"REFRESH "
<< FUNCTION KEY 5 >> ," PREV REC "
<< FUNCTION KEY 6 >> ," NEXT REC "
<< FUNCTION KEY 7 >> ," COLLECT "
<< FUNCTION KEY 8 >> ," EXIT "
);
GLOB'FORM := 0; << GLOBAL LABELS >>
NUMBER'OF'LABELS := 8;
VSETKEYLABELS(COMAREA,GLOB'FORM,NUMBER'OF'LABELS, LABELS);
END;
$PAGE " FORMAT'STATUS'LINE"
<<****************************************************************>>
<< >>
<< FORMAT'STATUS'LINE >>
<< >>
<<****************************************************************>>
PROCEDURE FORMAT'STATUS'LINE;
BEGIN
INTEGER CNT;
INTRINSIC ASCII, DASCII;
if com'term'type = 15 or << HP3075 >>
com'term'type = 16 then << hp3076 >>
move message'buf := (" ENTRY ", version, " "), 2
else
MOVE MESSAGE'BUF := (" ENTRY ", VERSION, ESC, "&a31C"), 2;
MSGLEN := TOS - @MESSAGE'BUF;
MOVE MESSAGE'BUF(MSGLEN) := "Batch Record #", 2;
MSGLEN := TOS - @MESSAGE'BUF;
MSGLEN := MSGLEN + DASCII (COM'RECNUM+1D, 10, MESSAGE'BUF (MSGLEN));
if com'term'type = 15 or << hp3075 >>
com'term'type = 16 then << hp3O76 >>
move message'buf(msglen) := (" Mode: "), 2
else
MOVE MESSAGE'BUF (MSGLEN) := (ESC, "&a65CMode: "), 2;
MSGLEN := TOS - @MESSAGE'BUF;
IF COM'MODE = COLLECT'MODE THEN
MOVE MESSAGE'BUF (MSGLEN) := "Collect", 2
ELSE
if com'term'type = 15 or << hp3075>>
com'term'type = 16 then << hp3076 >>
move message'buf(msglen):= ("Browse"), 2
else
MOVE MESSAGE'BUF (MSGLEN) : = (ESC, "&dKBrowse") , 2;
MSGLEN := TOS - @MESSAGE'BUF;
VPUTWINDOW (COMAREA, MESSAGE'BUF, MSGLEN);
END; << FORMAT'STATUS'LINE >>
$PAGE " ENTRY'ERROR"
<<****************************************************************>>
<< >>
<< ENTRY'ERROR >>
<< >>
<<****************************************************************>>
PROCEDURE ENTRY'ERROR (ENTRY'ERROR'NUM);
VALUE ENTRY'ERROR'NUM;
INTEGER ENTRY'ERROR'NUM;
BEGIN
IF ERRORS THEN
RETURN;
ERRORS := TRUE;
CASE ENTRY'ERROR'NUM OF
BEGIN
<< 0 IS NOT DEFINED >>
;
<< PREV'NOT'DEFINED: >>
MOVE MESSAGE'BUF :=
" The PREV key is only defined for browse mode.", 2;
<< NO'PREV'RECS: >>
MOVE MESSAGE'BUF :=
" There are no previous batch records.", 2;
<< NOT'REPEATING: >>
MOVE MESSAGE'BUF :=
" The NEXT key is not defined for a non-repeating form.", 2;
<< DELETE'NOT'DEFINED: >>
MOVE MESSAGE'BUF :=
" The DELETE key is only defined for browse mode.", 2;
<< NO'BATCH'RECS: >>
MOVE MESSAGE'BUF :=
" There are no batch records to browse.", 2;
<< NO'BATCH: >>
MOVE MESSAGE'BUF :=
" No batch file was specified, so browse is not allowed.",2;
<< NO'NEXT'REC >>
MOVE MESSAGE'BUF :=
" There are no more batch records.", 2;
END;
MSGLEN := TOS - @MESSAGE'BUF;
VPUTWINDOW (COMAREA, MESSAGE'BUF, MSGLEN);
END; << ENTRY'ERROR >>
$PAGE" ERROR"
<<****************************************************************>>
<< >>
<< ERROR >>
<< >>
<<****************************************************************>>
PROCEDURE ERROR;
BEGIN
IF ERRORS THEN << WILL ONLY HANDLE FIRST ERROR! >>
RETURN;
ERRORS := TRUE;
MESSAGE'BUF := " ";
VERRMSG (COMAREA, MESSAGE'BUF(1), MESSAGE'BUF'LEN, MSGLEN);
MSGLEN := MSGLEN + 1;
COM'STATUS := 0;
VPUTWINDOW (COMAREA MESSAGE'BUF, MSGLEN);
END; << ERROR >>
$PAGE " ENTRY INITIALIZATION PROCEDURE"
<<****************************************************************>>
<< >>
<< INIT >>
<< >>
<<****************************************************************>>
PROCEDURE INIT;
BEGIN
EQUATE
VERSIONS'DIFF = 70
,DIF'FF = 73
,FILENAMELEN = 36
,LANGID'LEN = 17
;
EQUATE
BLANK'LINE = 0
,GET'FF'NAME = 1
,GET'BF'NAME = 2
,DIF'FF'WARN = 3
,VERS'DIF'WARN = 4
,Y'TO'CONT = 5
,PRODUCT'ID = 6
,GET'LANGID = 7
,NOT'CONFIG = 8
,NOT'INSTALL = 9
;
INTEGER
INDEX
,READ'LEN
,LANGID
,VERROR
;
LOGICAL
CONTINUE
;
LOGICAL ARRAY
NLERROR(0:1)
;
LOGICAL ARRAY
LANGID'STR'L(0:9)
;
BYTE ARRAY
LANGID'STR(*) = LANGID'STR'L
;
BYTE ARRAY
FILENAME (0:FILENAMELEN)
;
INTRINSIC
TERMINATE
,QUIT
,PRINT
,READ
;
INTRINSIC
NLGETLANG
,NLINFO
;
SUBROUTINE HANDLE'PROMPT'ERR (QUIT'NUM);
VALUE QUIT'NUM;
INTEGER QUIT'NUM;
BEGIN
MOVE MESSAGE'BUF := "Terminal access failed unexpectedly.", 2;
MSGLEN := TOS - @MESSAGE'BUF;
PRINT (MESSAGE'WBUF, -MSGLEN, 0);
QUIT (QUIT'NUM);
END; << HANDLE'PROMPT'ERR >>
SUBROUTINE WRITE'MSG;
BEGIN
VERRMSG (COMAREA, MESSAGE'BUF, MESSAGE'BUF'LEN, MSGLEN);
PRINT (MESSAGE'WBUF, -(MSGLEN), %60);
IF <> THEN << CANT WRITE TO PROMPT FILE! >>
HANDLE'PROMPT'ERR (%60);
END; << WRITE'MSG >>
SUBROUTINE PRINT'TO'TERM (MSG'NUM, CCTL);
VALUE MSG'NUM, CCTL;
INTEGER MSG'NUM;
LOGICAL CCTL;
BEGIN
CASE MSG'NUM OF
BEGIN
<< 0, BLANK'LINE >>
MOVE MESSAGE'BUF:=" ",2;
<< 1, FF'NAME'PROMPT >>
MOVE MESSAGE'BUF:=" ENTER FORMS FILE NAME AND PRESS RETURN: ",
2;
<< 2, BF NAME PROMPT >>
MOVE MESSAGE'BUF:=" ENTER BATCH FILE NAME AND PRESS RETURN: ",
2;
<< 3, DIFFERENT FF WARNING >>
MOVE MESSAGE'BUF:=(" WARNING: A different forms file was used",
" to create this batch."),2;
<< 4, FF MOD WARN >>
MOVE MESSAGE'BUF:=(" WARNING: Forms File was recompiled since",
" this batch was created."), 2;
<< 5, Y'TO'CONTINUE >>
MOVE MESSAGE'BUF := (" Enter ""Y"" to continue: "), 2;
<< 6, PRODUCT'ID >>
MOVE MESSAGE'BUF := ID'MSG, 2;
<< 7, GET'LANGID >>
MOVE MESSAGE'BUF :=(" ENTER LANGUAGE ID NUMBER AND PRESS",
" RETURN: "),2;
<< 8, NOT'CONFIG >>
MOVE MESSAGE'BUF := " Specified language is not configured ",2;
<< 9, NOT'INSTALL >>
MOVE MESSAGE'BUF := " Native language Software not installed",2
;
END; << CASE >>
MSGLEN := TOS - @MESSAGE'BUF;
PRINT (MESSAGE'WBUF, -MSGLEN, CCTL);
IF <> THEN
HANDLE'PROMPT'ERR (2);
END; << PRINT'TO'TERM >>
INTEGER SUBROUTINE READ'FROM'TERM (READBUF, READLEN);
VALUE READLEN;
BYTE ARRAY READBUF;
INTEGER READLEN;
BEGIN
<< BLANK BUF FIRST >>
READBUF := " ";
MOVE READBUF (1) := READBUF (0), (READLEN-1);
READ'FROM'TERM := READ (READBUF, -READLEN);
IF <> THEN
HANDLE'PROMPT'ERR (3);
END; << READ'FROM'TERM >>
$PAGE
<< INITIALIZE COMAREA; IS ALL 0'S TO START >>
COM'LANGUAGE := SPL'LANG;
COM'COMAREALEN := COMAREALEN;
<< SET COM'LABEL'OPTION TO 1 TO ENABLE FUNCTION KEY LABEL >>
<< SUPPORT FOR TERMINALS SUPPORTING FUNCTION KEY LABELS >>
COM'LABEL'OPTION := 1;
<< Set form storage buffer size (2626 terminal only) to 4 >>
COM'FORM'STOR'SIZE := 4;
BATCH := TRUE; << INIT >>
PRINT'TO'TERM (PRODUCT'ID, %60);
ENTRY IDENTIFICATION
WHILE TRUE DO
BEGIN
DO << UNTIL COM'STATUS = 0 >>
BEGIN
COM'STATUS := 0;
PRINT'TO'TERM (GET'FF'NAME, %320);
READ'LEN := READ'FROM'TERM (FILENAME, FILENAMELEN);
IF READ'LEN = 0 THEN << ALL DONE >>
TERMINATE;
VOPENFORMF (COMAREA, FILENAME);
IF COM'STATUS <> 0 THEN
WRITE'MSG; << WRITES VERRMSG >>
END
UNTIL COM'STATUS = 0; << KEEP GOING TILL OK >>
<< NOW, OPEN BATCH FILE >>
PRINT'TO'TERM (GET'BF'NAME, %320);
READ'LEN := READ'FROM'TERM (FILENAME, FILENAMELEN);
IF READ'LEN = 0 OR FILENAME = " " THEN << NO BATCH FILE! >>
BATCH := FALSE << ALL OK >>
ELSE
BEGIN
VOPENBATCH (COMAREA, FILENAME);
IF COM'STATUS <> 0 THEN
IF COM'STATUS = VERSIONS'DIFF OR
COM'STATUS = DIF'FF THEN
BEGIN
PRINT'TO'TERM ((IF COM'STATUS=DIF'FF THEN DIF'FF'WARN
ELSE VERS'DIF'WARN), 0);
PRINT'TO'TERM (Y'TO'CONT, %320);
READ'LEN := READ'FROM'TERM (MESSAGE,BUF, 1);
IF READ'LEN > 0 THEN
IF READ'LEN=1 AND (MESSAGE'BUF = "Y" OR
MESSAGE'BUF = "y") THEN
COM'STATUS := 0; << GO AHEAD >>
END
ELSE << IS REAL ERROR >>
WRITE'MSG;
END;
IF COM'STATUS = 0 THEN
BEGIN
VGETLANG( COMAREA, LANGID );
IF COM'STATUS <> 0 THEN WRITE'MSG
ELSE IF LANGID = INTERNATIONAL THEN BEGIN
<< IF INTERNATIONAL FORMS FILE PROMPT FOR LANGID >>
CONTINUE := TRUE;
LANGID := NLGETLANG( 1, NLERROR );
IF NLERROR = 0 THEN BEGIN
VSETLANG( COMAREA LANGID, VERROR );
COM'STATUS := 0;
END;
WHILE CONTINUE DO BEGIN
PRINT'TO'TERM( BLANK'LINE, %40 );
PRINT'TO'TERM( GET'LANGID, %320 );
READ'LEN := READ'FROM'TERM( LANGID'STR, LANGID'LEN );
IF READ'LEN = 0 THEN CONTINUE := FALSE
ELSE BEGIN
LANGID'STR( READ'LEN ) :=" ";
NLINFO( 22, LANGID'STR'L, LANGID, NLERROR );
IF NLERROR = 0 THEN BEGIN
VSETLANG( COMAREA LANGID, VERROR );
IF VERROR = 0 AND COM'STATUS = 0 THEN
CONTINUE := FALSE;
IF COM'STATUS <> 0 THEN WRITE'MSG;
END
ELSE IF NLERROR = 1
THEN PRINT'TO'TERM(NOT'INSTALL,%40)
ELSE PRINT'TO'TERM(NOT'CONFIG,%40);
END;
END; << WHILE CONTINUE >>
END; << IF LANGID = INTERNATIONAL >>
END; << IF COM'STATUS = 0 >>
<< ALL OK HERE, SO OPEN TERMINAL >>
IF NOT BATCH OR COM'STATUS = 0 THEN
BEGIN
<< OPEN TERMINAL IN BLOCKMODE ... >>
MOVE FILENAME := "A264X ";
VOPENTERM (COMAREA, FILENAME);
IF COM'STATUS <> 0 THEN
BEGIN
WRITE'MSG;
QUIT (6);
END;
COM'TERMOPTIONS.(11:2) := 1; << DONT HARD RESET TERM >>
RETURN; << ALL DONE INITIALIZING >>
END
ELSE << IS NORMAL ERROR >>
BEGIN
COM'STATUS := 0;
VCLOSEBATCH (COMAREA);
VCLOSEFORMF (COMAREA);
END;
END; << WHILE TRUE >>
END; << INIT >>
$PAGE " EXIT"
<<****************************************************************>>
<< >>
<< EXIT >>
<< >>
<<****************************************************************>>
PROCEDURE EXIT;
BEGIN
BYTE ARRAY LOCAL'MESSAGE'BUF (0:80);
INTEGER LOCAL'MSGLEN;
INTRINSIC PRINT;
SUBROUTINE PRINT'MSG;
BEGIN
VERRMSG (COMAREA, LOCAL'MESSAGE'BUF, MESSAGE'BUF'LEN,
LOCAL'MSGLEN);
PRINT (LOCAL'MESSAGE'BUF, -LOCAL'MSGLEN, 0);
COM'STATUS := 0;
END;
<< FIRST, CLOSE TERMINAL >>
COM'STATUS := 0;
VCLOSETERM (COMAREA);
IF COM'STATUS <> 0 THEN
PRINT'MSG;
<< NOW, BATCH FILE >>
IF BATCH THEN
IF ERRORS THEN
PRINT (MESSAGE'WBUF, -MSGLEN, 0) << MSG FROM COLLECT >>
ELSE << OK TO GO AHEAD >>
BEGIN
VCLOSEBATCH (COMAREA);
IF COM'STATUS <> 0 THEN
PRINT'MSG;
end
else
if errors then
print (message'wbuf, -msglen, 0); << msg from collect >>
<< NOW, CLOSE FORMS FILE >>
VCLOSEFORMF (COMAREA);
IF COM'STATUS <> 0 THEN
PRINT'MSG;
END; << EXIT >>
$PAGE " BROWSE"
<<****************************************************************>>
<< >>
<< BROWSE >>
<< >>
<<****************************************************************>>
PROCEDURE BROWSE;
BEGIN
EQUATE
FORWARDS = 1
,BACKWARDS = -1
;
INTEGER
PAGE'EJECT := %61
,UNDERLINE := 1
,DIRECTION
;
DOUBLE
LOCAL'COM'REC
;
DO'BROWSE'LABELS;
LOCAL'COM'REC := COM'RECNUM;
COM'RECNUM := COM'RECNUM - 1D;
DIRECTION := BACKWARDS;
WHILE TRUE DO << UNTIL EXIT OR COLLECTKEY >>
BEGIN
IF COM'NUMRECS = 0D THEN
RETURN;
IF COM'RECNUM = LAST'REC'NUM THEN
BEGIN
ENTRY'ERROR (NO'NEXT'RECS);
COM'RECNUM := COM'RECNUM - 1D;
DIRECTION := BACKWARDS;
END;
IF COM'RECNUM < 0D THEN
BEGIN
ENTRY'ERROR (NO'PREV'RECS);
COM'RECNUM := 0D;
DIRECTION := FORWARDS;
END;
VREADBATCH (COMAREA);
CHECK'ERROR;
IF COM'DELETEFLAG = FALSE THEN << NOT DELETED >>
BEGIN
IF COM'RECNUM <> LOCAL'COM'REC OR COM'LASTKEY = REFRESHKEY THEN
BEGIN
IF DIRECTION = BACKWARDS OR COM'LASTKEY = REFRESHKEY THEN
COM'REPEATOPT := COM'NFOPT := NORM
ELSE << MUST BE FORWARDS >>
IF COM'CFNAME <> COM'NFNAME, (15) THEN
COM'REPEATOPT := NORM; << CLEAR SINCE NOT REPT >>
IF COM'LASTKEY = REFRESHKEY THEN
MOVE COM'NFNAME := "$REFRESH ";
VGETNEXTFORM (COMAREA);
CHECK'ERROR;
LOCAL'COM'REC := COM'RECNUM;
END;
IF NOT ERRORS THEN
FORMAT'STATUS'LINE;
DO << WHILE ERRORS >>
BEGIN
ERRORS := FALSE;
VSHOWFORM (COMAREA);
CHECK'ERROR
COM'SHOWCONTROL := 0; << RESET JUST IN CASE >>
VREADFIELDS (COMAREA);
CHECK'ERROR;
if com'lastkey <> 0 then
if com'term'type = 15 or << HP3075 >>
com'term'type = 16 then << HP3076 >>
if com'keyboard'type = 1 then << Numeric keyboard >>
com'lastkey := com'lastkey - 16;
IF NOT ERRORS THEN
CASE COM'LASTKEY OF
BEGIN
<< ENTERKEY: >>
BEGIN
DIRECTION := FORWARDS;
VFIELDEDITS (COMAREA);
CHECK'EDIT'ERROR;
IF NOT ERRORS THEN
BEGIN
VFINISHFORM (COMAREA);
CHECK'EDIT'ERROR;
IF COM'REPEATOPT=NOREPEAT AND COM'NFOPT <> NORM
OR COM'REPEATOPT=REPEATAPP THEN
BEGIN
COM'SHOWCONTROL.(10:1) := 1;
VSHOWFORM (COMAREA);
COM'SHOWCONTROL. (10:1) := 0;
CHECK'ERROR;
END;
IF NOT ERRORS THEN
BEGIN
VWRITEBATCH (COMAREA);
CHECK'ERROR;
IF NOT ERRORS THEN
COM'RECNUM := COM'RECNUM+1D;
END;
END;
END;
<< HEADKEY: >>
BEGIN
DIRECTION := FORWARDS;
COM'RECNUM := 0D;
COM'REPEATOPT := COM'NFOPT := NORM;
END;
<< DELETEKEY: >>
BEGIN
DIRECTION := FORWARDS;
COM'DELETEFLAG := TRUE;
VWRITEBATCH (COMAREA);
CHECK'ERROR;
COM'DELETEFLAG := FALSE;
IF NOT ERRORS THEN
COM'RECNUM := COM'RECNUM + 1D;
COM'REPEATOPT := COM'NFOPT := NORM;
END;
<< PRINTKEY: >>
BEGIN
VPRINTFORM (COMAREA, UNDERLINE, PAGE'EJECT);
CHECK'ERROR;
END;
<< REFRESHKEY: >>
;
<< PREVKEY: >>
BEGIN
DIRECTION := BACKWARDS;
COM'RECNUM := COM'RECNUM - 1D;
END;
<< NEXTKEY: >>
BEGIN
DIRECTION := FORWARDS;
COM'RECNUM := COM'RECNUM + 1D;
IF COM'REPEATOPT=NOREPEAT AND COM'NFOPT <> NORM
OR COM'REPEATOPT=REPEATAPP THEN
BEGIN
COM'SHOWCONTROL.(10:1) := 1;
VSHOWFORM (COMAREA);
COM'SHOWCONTROL.(10:1) := 0;
CHECK'ERROR;
END;
END;
<< COLLECTKEY: >>
RETURN;
<< EXIT: >>
RETURN;
END; << CASE >>
END
UNTIL NOT ERRORS AND COM'LASTKEY <> PRINTKEY;
END << IN NOT COM'DELETEFLAG >>
ELSE << REC WAS DELETED >>
COM'RECNUM := IF DIRECTION = BACKWARDS THEN COM'RECNUM - 1D
ELSE COM'RECNUM + 1D;
END; << WHILE TRUE DO >>
END; << BROWSE >>
$PAGE " COLLECT"
<<****************************************************************>>
<< >>
<< COLLECT >>
<< >>
<<****************************************************************>>
PROCEDURE COLLECT;
BEGIN
LOGICAL
FIRST'TIME := TRUE
;
BYTE ARRAY
SAVED'FORM'NAME (0:NAMELEN-1)
;
DO'COLLECT'LABELS;
COM'MODE := COLLECT'MODE;
COM'DELETEFLAG := FALSE;
DO << UNTIL COM'NFNAME <> EXIT AND COM'DO <> NORM >>
BEGIN
IF COM'LASTKEY=ENTERKEY OR COM'LASTKEY=NEXTKEY THEN
IF COM'REPEATOPT=NOREPEAT AND COM'NFOPT <> NORM OR
COM'REPEATOPT=REPEATAPP THEN
BEGIN
COM'SHOWCONTROL.(10:1) := 1;
<< TO SUPPRESS KEYBOARD ENABLE >>
VSHOWFORM (COMAREA);
COM'SHOWCONTROL.(10:1) := 0;
CHECK'ERROR;
END;
VGETNEXTFORM (COMAREA);
IF FIRST'TIME AND COM'STATUS <> 0 THEN << IS FIRST TIME >>
BEGIN
VERRMSG (COMAREA, MESSAGE'BUF, MESSAGE'BUF'LEN, MSGLEN);
ERRORS := TRUE; << DONT WANT TO CLOSE BATCH IF ERROR! >>
RETURN;
END;
CHECK'ERROR;
FIRST'TIME := FALSE;
VINITFORM (COMAREA);
CHECK'EDIT'ERROR;
IF NOT ERRORS THEN
FORMAT'STATUS'LINE;
DO << WHILE ERRORS >>
BEGIN
ERRORS := FALSE;
VSHOWFORM (COMAREA);
CHECK'ERROR;
COM'SHOWCONTROL := 0; << CLEAR >>
IF COM'DBUFLEN <= 0 AND << DONT READ!!! >>
COM'REPEATOPT=NOREPEAT AND COM'NFOPT <> NORM THEN
BEGIN
IF NOT ERRORS AND BATCH THEN
BEGIN
VWRITEBATCH (COMAREA);
CHECK'ERROR;
IF NOT ERRORS THEN
BEGIN
COM'RECNUM := COM'RECNUM + 1D;
IF (COM'RECNUM MOD DOUBLE(PARMVAL) = 0D) THEN
VPOSTBATCH (COMAREA);
END;
END;
END
ELSE << IS NORMAL FORM >>
BEGIN
VREADFIELDS (COMAREA);
CHECK'ERROR;
if com'lastkey <> 0 then
if com'term'type = 15 or << HP3075 >>
com'term'type = 16 then << Hp3076 >>
if com'keyboard'type = 1 then << Numeric keyboard >>
com'lastkey := com'lastkey - 16;
IF NOT ERRORS THEN
CASE COM'LASTKEY OF
BEGIN
<< ENTERKEY: >>
BEGIN
VFIELDEDITS (COMAREA);
CHECK'EDIT'ERROR;
IF NOT ERRORS THEN
BEGIN
VFINISHFORM (COMAREA);
CHECK'EDIT'ERROR;
IF NOT ERRORS AND BATCH THEN
BEGIN
VWRITEBATCH (COMAREA);
CHECK'ERROR;
IF NOT ERRORS THEN
BEGIN
COM'RECNUM := COM'RECNUM + 1D;
IF (COM'RECNUM MOD DOUBLE(PARMVAL) = 0D) THEN
VPOSTBATCH (COMAREA);
END;
END;
END;
END;
<< HEADKEY: >>
BEGIN
COM'REPEATOPT := NORM;
COM'NFOPT := NORM;
MOVE COM'NFNAME := "$HEAD ";
END;
<< DELETEKEY: >>
ENTRY'ERROR (DELETE'NOT'DEFINED);
<< PRINTKEY: >>
BEGIN
VPRINTFORM (COMAREA, UNDERLINE, PAGE'EJECT);
CHECK'ERROR;
END;
<< REFRESHKEY: >>
MOVE COM'NFNAME := "$REFRESH ";
<< PREVKEY: >>
ENTRY'ERROR (PREV'NOT'ALLOWED);
<< NEXTKEY: >>
BEGIN
IF COM'REPEATOPT = NORM THEN
ENTRY'ERROR (NOT'REPEATING)
ELSE
COM'REPEATOPT := NORM;
END;
<< BROWSEKEY: >>
BEGIN
IF NOT BATCH THEN
ENTRY'ERROR (NO'BATCH)
ELSE
IF COM'NUMRECS = 0D THEN
ENTRY'ERROR (NO'BATCH'RECS)
ELSE
BEGIN
LAST'REC'NUM := COM'RECNUM;
MOVE SAVED'FORM'NAME := COM'CFNAME,(NAMELEN);
COM'MODE := BROWSE,MODE;
COM'REPEATOPT := COM'NFOPT := NORM;
COM'SHOWCONTROL.(14:1):=1;
BROWSE;
COM'SHOWCONTROL.(14:1):=0;
COM'MODE := COLLECT'MODE;
MOVE COM'NFNAME := SAVED'FORM'NAME,(NAMELEN);
COM'RECNUM := LAST'REC'NUM;
COM'REPEATOPT := COM'NFOPT := NORM;
COM'DELETEFLAG := FALSE; << IF NO RECS >>
IF COM'LASTKEY = EXITKEY THEN
BEGIN
MOVE COM'CFNAME :=
SAVED'FORM'NAME,(NAMELEN);
RETURN;
END;
DO'COLLECT'LABELS;
END;
END; << BROWSEKEY >>
<< EXIT: >>
RETURN;
END; << CASE COM'LASTKEY >>
END; << IS COM'DBUFLEN > O? >>
END
UNTIL NOT ERRORS AND COM'LASTKEY <> PRINTKEY;
END
UNTIL COM'NFNAME = "$END " AND
COM'REPEATOPT = NORM;
END; << COLLECT >>
$PAGE " ENTRY OUTER BLOCK"
<<****************************************************************>>
<< >>
<< OUTER BLOCK >>
<< >>
<<****************************************************************>>
INTRINSIC PRINT; << FOR ID MESSAGE >>
<< FOR INTERNAL TESTING ONLY >>
INIT;
COLLECT;
EXIT;
END.