Trailing-Edge
-
PDP-10 Archives
-
TRAFFIC-20_V4_840514
-
traffic-demonstrations/demo1.cbl
There are no other files named demo1.cbl in the archive.
ID DIVISION.
PROGRAM-ID. DEMO1.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY DEM1.
COPY DEM2.
COPY DEM3.
COPY DEM4.
COPY DEM6.
COPY DEM7.
01 DEMFIL PIC X(8) VALUE "DEM1.DAT".
01 ERR PIC S9(10) COMP.
01 ENDWAS PIC S9(10) COMP.
01 TEMP PIC 999999V99.
01 CT PIC S9(10) COMP.
PROCEDURE DIVISION.
L1.
CALL TFRINI USING FM-DEM1,DEMFIL,0,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING FN-QGO,ENDWAS,ERR.
PERFORM ERROR-CHECK.
IF QGO="Y" GO TO PART1.
GO TO ALL-DONE.
PART1.
CALL TFRINI USING FM-DEM2,"DEM2.DAT",0,ERR.
PERFORM ERROR-CHECK.
PT1A.
ENTER MACRO TFRRD USING -1,ENDWAS,ERR.
PERFORM ERROR-CHECK.
MOVE "THANK YOU" TO TA.
ENTER MACRO TFRWRT USING FN-TA,ERR.
ENTER MACRO TFRRD USING FN-QAGEN2,ENDWAS,ERR.
IF QAGEN2="N" GO TO PART2.
ENTER MACRO TFRCLR USING FN-TA,ERR.
GO TO PT1A.
PART2.
CALL TFRINI USING FM-DEM3,"DEM3.DAT",0,ERR.
PERFORM ERROR-CHECK.
MOVE FNAME2 TO FNAME3.
MOVE SNAME2 TO SNAME3.
ENTER MACRO TFRWRT USING -2,ERR.
PT2A.
ENTER MACRO TFRRD USING -1,ENDWAS,ERR.
DIVIDE ININ INTO TOGO GIVING TEMP.
MOVE TEMP TO GIVES3.
ENTER MACRO TFRWRT USING FN-GIVES3,ERR.
IF TEMP < 10
ENTER MACRO TFRERR USING
"Its not worth putting less than 10 tons on a truck."
GO TO PT2A.
IF TEMP > 25
ENTER MACRO TFRERR USING
"You can't put more than 25 tons on a truck"
GO TO PT2A.
ENTER MACRO TFRRD USING FN-COST3,ENDWAS,ERR.
MULTIPLY COST3 BY TOGO GIVING TEMP.
MOVE TEMP TO TOTAL3.
ENTER MACRO TFRWRT USING FN-TOTAL3,ERR.
* ENTER MACRO TFRERR USING
* "Exceeds credit limit for any one customer".
ENTER MACRO TFRRD USING FN-QCHANGE3,ENDWAS,ERR.
PERFORM ERROR-CHECK.
IF QCHANGE3="Y" GO TO PT2A.
PART3.
ENTER MACRO TFRINI USING FM-DEM4,"DEM4.DAT",0,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING -2,ENDWAS,ERR.
* MOVE ZERO TO TOTAL4.
PT3A.
ADD 1 TO CT.
IF CT > 50 GO TO PT3B.
* ADD COST4(CT) TO TOTAL4.
GO TO PT3A.
PT3B.
* ENTER MACRO TFRWRT USING FN-TOTAL4,ERR.
ENTER MACRO TFRRD USING FN-QGO4,ENDWAS,ERR.
IF QGO4 = "Y" GO TO PART3.
PART4.
L60.
ENTER MACRO TFRINI USING FM-DEM6,"DEM6.DAT",-1,ERR.
ENTER MACRO TFRRD USING FN-QSEE6,ENDWAS,ERR.
IF QSEE6 = "N" GO TO L70.
L61.
ENTER MACRO TFRINI USING FM-DEM6,"DEM6.DAT",-2,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING -2,ENDWAS,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING -3,ENDWAS,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING -4,ENDWAS,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING -5,ENDWAS,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING -6,ENDWAS,ERR.
PERFORM ERROR-CHECK.
IF QAGEN6 = "N" GO TO L70.
ENTER MACRO TFRCLR USING -6,ERR.
PERFORM ERROR-CHECK.
GO TO L61.
L70.
ENTER MACRO TFRINI USING FM-DEM7,"DEM7.DAT",0,ERR.
PERFORM ERROR-CHECK.
ENTER MACRO TFRRD USING FN-QDUN7,ENDWAS,ERR.
* GO TO NOCLEAREND.
ALL-DONE.
ENTER MACRO TFRCLR.
NOCLEAREND.
STOP RUN.
ERROR-CHECK.
IF ERR NOT = 0
ENTER MACRO TFRBLK
DISPLAY "FAILED FOR SOME REASON - ERROR ",ERR.