Trailing-Edge
-
PDP-10 Archives
-
BB-5372D-BM
-
traffic/demonstration/tfrtst.cbl
There is 1 other file named tfrtst.cbl in the archive. Click here to see a list.
ID DIVISION.
PROGRAM-ID. TFRTST.
remarks.
TFRTST will display all or a portion of an arbitrary
form on the screen so the programmer can determine
if the form description is correct;
The prompt for form name expects the full data file
name for the form;
The field-id is the same as in a call the TFRRD:
0 indicates the whole form is displayed;
-n displays section "n";
n displays filed "n";
after the requested portion of the form is displayed,
a TFRRD is automatically done so that the attributes of
the fields can be tested for correctness;
Hitting carriage return for field-id will go back to
the form-name prompt and a new form can be tested;
Carriage return to the form prompt will cause TFRTST
to exit.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DUMMY-RECORD PICTURE X(1920) DISPLAY-7.
01 FORM-NAME PICTURE X(50) DISPLAY-7.
77 ERR PIC S9(10) COMP.
77 XERR PIC S9(10) COMP.
77 TRM PIC S9(10) COMP.
77 FID PIC S9(10) COMP.
77 FID7 PIC XXX VALUE SPACE.
77 CMD PIC X.
PROCEDURE DIVISION.
LOOP.
ENTER MACRO TFRSET.
enter macro tfrclr.
ENTER MACRO TFRRST.
DISPLAY 'FORM NAME: ' WITH NO ADVANCING.
ACCEPT FORM-NAME.
IF FORM-NAME = SPACE ENTER MACRO TFRSET; ENTER MACRO TFRCLR STOP RUN.
display ' '. note xtra cr-lf.
GO TO LOOPX.
LOOP2.
ENTER MACRO TFRSET.
ENTER MACRO TFRCLR.
LOOPX.
ENTER MACRO TFRRST.
DISPLAY 'FIELD ID (999 TO QUIT): ' WITH NO ADVANCING.
ACCEPT FID.
IF FID = 999 GO TO LOOP.
ENTER MACRO TFRSET.
ENTER MACRO TFRCLR.
ENTER MACRO TFRINI USING DUMMY-RECORD FORM-NAME FID ERR.
IF ERR = 7 NEXT SENTENCE ELSE
IF ERR NOT = 0 MOVE ERR TO XERR
enter macro tfrclr; ENTER MACRO TFRRST; display 'ERROR = ' XERR
ACCEPT FID
if err not = 2 go to loop2
else GO TO LOOP.
ENTER MACRO TFRSET.
ENTER MACRO TFRERR USING 'READ FORM' 0 ERR.
ENTER MACRO TFRRD USING FID TRM ERR.
IF ERR NOT = 0 MOVE ERR TO XERR
enter macro tfrclr
ENTER MACRO TFRERR USING 'ERROR = ' 0 ERR
ENTER MACRO TFRRST
DISPLAY XERR WITH NO ADVANCING
ACCEPT FID
GO TO LOOP2.
ENTER MACRO TFRERR USING 'TERMINATOR = ' 0 ERR.
ENTER MACRO TFRRST.
DISPLAY TRM WITH NO ADVANCING.
accept fid.
GO TO LOOP2.