Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50346/cbltst.cbl
There are 2 other files named cbltst.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLTST.
DATA DIVISION.
WORKING-STORAGE SECTION.
77  IOINDX PIC 9(10) COMP VALUE 65536.
77  IERROR PIC 9(10) COMP.
77  ITYPE PIC 9(10) COMP.
77  N PIC 999 COMP.
77  ANS PIC X(7).
01 IDIAL.
	02 IDIG1 PIC 99 COMP VALUE 9.
	02 IDIG2 PIC 99 COMP VALUE 14.
	02 IDIG3 PIC 99 COMP VALUE 8.
	02 IDIG4 PIC 99 COMP VALUE 9.
	02 IDIG5 PIC 99 COMP VALUE 7.
	02 IDIG6 PIC 99 COMP VALUE 5.
	02 IDIG7 PIC 99 COMP VALUE 7.
	02 IDIG8 PIC 99 COMP VALUE 10.
	02 IDIG9 PIC 99 COMP VALUE 2.
01 ISEND DISPLAY-7.
	02 CHAR1 PIC X SYNC RIGHT VALUE 'A'.
	02 CHAR2 PIC X SYNC RIGHT VALUE 'B'.
	02 CHAR3 PIC X SYNC RIGHT VALUE 'C'.
	02 CHAR4 PIC X SYNC RIGHT VALUE 'D'.
	02 CHAR5 PIC X SYNC RIGHT VALUE 'E'.
	02 CHAR6 PIC X SYNC RIGHT VALUE 'F'.
	02 CHAR7 PIC X SYNC RIGHT VALUE 'G'.
	02 CHAR8 PIC X SYNC RIGHT VALUE 'H'.
	02 CHAR9 PIC X SYNC RIGHT VALUE 'I'.
	02 CHAR10 PIC X SYNC RIGHT VALUE 'J'.
01 IRECV.
	02 CHARX PIC X SYNC RIGHT OCCURS 10 TIMES.
PROCEDURE DIVISION.
START.
	DISPLAY " SEND OR RECEIVE ? " WITH NO ADVANCING.
	ACCEPT ANS.
	IF ANS = "SEND" GO TO SEND-ROUTINE.
RECEIVE-ROUTINE.
	ENTER MACRO INIT USING IOINDX, IERROR,ITYPE.
	IF IERROR EQUAL TO 0 GO TO ONE.
	MOVE 10 TO N.
	ENTER MACRO RECV USING IRECV,N,IERROR,ITYPE.
	IF IERROR EQUAL TO 0 GO TO TWO.
	DISPLAY "SUCCESSFUL TRANSFER ".
RECV-XIT.
	ENTER MACRO HNGUP.
	STOP RUN.
ONE.
	DISPLAY "? COMMUNICATIONS LINE INITIALIZATION FAILURE".
	IF ITYPE = 1  DISPLAY "  TTY NOT AVAILABLE".
	IF ITYPE = 2  DISPLAY "  TTY NOT ASSIGNED".
	GO TO RECV-XIT.
TWO.
	DISPLAY "? RECEIVE ERROR".
	DISPLAY "  TIME OUT".
	GO TO RECV-XIT.
*
*
SEND-ROUTINE.
	ENTER MACRO INIT USING IOINDX,IERROR,ITYPE.
	IF IERROR = 0 GO TO ONE.
	MOVE 9 TO N.
	ENTER MACRO DIAL USING IDIAL,N,IERROR,ITYPE.
	IF IERROR = 0 GO TO THREES.
	MOVE 10 TO N.
	ENTER MACRO SEND USING ISEND,N,IERROR,ITYPE.
	IF IERROR = 0 GO TO TWOS.
	DISPLAY " SUCCESSFUL TRANSFER".
SEND-XIT.
	ENTER MACRO HNGUP.
	STOP RUN.
TWOS.
	DISPLAY "? TRANSMISSION ERROR".
	IF IERROR = 0 DISPLAY "  TIME OUT".
	IF IERROR = 1 DISPLAY "  DATA MESSAGE RECEIVED".
	GO TO SEND-XIT.
THREES.
	DISPLAY "? ERROR IN DIAL".
	IF ITYPE = 1 DISPLAY "  TTY NOT A DATASET".
	IF ITYPE = 2 DISPLAY "  CALL DID NOT GO THROUGH".
	GO TO SEND-XIT.