Google
 

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.