Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0081/tpdemo.cbl
There is 1 other file named tpdemo.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. TPDEMO.
DATE-WRITTEN.   19-APR-74.
DATE-COMPILED.
REMARKS.  THIS IS A MULTI-USER  COBOL -DEMO-   TO BE USED WITH
	  THE  TRANSACTION PROCESSOR  (TP.MAC).
	  IT ALSO ILLUSTRATES THE USE OF AN "UNSTRING" ROUTINE WHICH BREAKS UP
	  A STRING OF CHARACTERS INTO FIELDS USING COMMAS
	  AS FIELD DELIMITERS.
 
DATA DIVISION.

WORKING-STORAGE SECTION.
 
77	HOLD-MM		PIC 9(2).
 
01	DATE-TIME.
	02 YY	PIC 99.
	02 MO	PIC 99.
	02 DD	PIC 99.
	02 HH	PIC 99.
	02 MM	PIC 99.
	02 SS	PIC 99.
 
01	MISC.
	03  A			PIC S9(8)V99.
	03  A-R	REDEFINES A	PIC X(11).
	03  B			PIC S9(8)V99.
	03  B-R  REDEFINES B	PIC X(11).
	03  C			PIC S9(8)V99.
	03  C-R  REDEFINES C	PIC X(11).
	03  D			PIC S9(8)V99 COMP.
 
**
**  IN-LINE    IS ANSWER RETURNED FROM USERS TERMINAL
**
 
01	IN-LINE.
	02 IL-1-6.
		03 IL-1-2	PIC X(2).
		03 IL-3-6	PIC X(4).
	02 FILLER		PIC X(69).
 
 
*************************************************************
**                                                     
******************** FOR TRANSACTION PROCESSOR **************
**                                                     
**     DO NOT CHANGE FROM HERE TO NEXT "***" LINE      
**             [EXCEPT FOR OCCURS VALUES]              
**                                                     
*************************************************************
 
 
01 MORE-TO-COME		PIC X USAGE IS DISPLAY-7.
01 LINES-OUT		PIC S9(2) COMP.
01 I-O-TTY			PIC S9(3) COMP VALUE 1.
01 OUT-STRING		USAGE IS DISPLAY-7.
	02 OUT-LINE			OCCURS 12 TIMES.
		03 OL-1-74		PIC X(74).
		03 OL-CARRIAGE-CTL	PIC X.
 
01 USER-TABLES.
	02 USER-TABLE OCCURS 12 TIMES.
 
*****************************************************************
**                                                              
************ END FIXED AREA FOR TRANSACTION PROCESSOR ***********
**                                                              
**                                                              
**       HAVE THE NUMBER OF OCCURANCES OF THE TABLE ONE         
**       MORE THAN THE # OF USERS SINCE THE FIRST      
**       OCCURANCE OF THE ARRAY IS USED AS A WORK AREA,        
**       THEREBY ALLOWING DIRECT SUBSCRIPTING.  THE          
**       APPROPRIATE ENTRY IN THE ARRAY IS "ROLLED" INTO         
**       ENTRY 1 EACH TIME A MESSAGE IS PICKED UP AND "ROLLED"
**       OUT BEFORE A MESSAGE IS SENT.                       
**       FROM HERE TO THE NEXT "***" LINE IS THE VARIABLE       
**       AREA FOR EACH TERMINAL CONNECTED .                     
**                                                              
**	   ADD ALL YOUR TERMINAL DEPENDENT VARIABLES BELOW         
**   	AS   03   LEVELS  OR  GREATER			        
**							       
****************************************************************
 
 
	03 LOGIN-TRIES			PIC 9.
	03 LOGGED-IN			PIC X.
	03 LAST-MINUTE			PIC 9(2).
	03 LINES-TO-PRINT		PIC S9(10) COMP.
	03 LINES-LEFT-THIS-BURST	PIC S9(10) COMP.
	03 LINES-PER-BURST		PIC S9(10) COMP.
	03 CURRENT-LINE			PIC S9(10) COMP.
 
 
 
*****************************************************************
**							       
************** END VARIABLE AREA FOR EACH TERMINAL **************
**							       
****************************************************************
 
 
***************************************************************
**
**  MESSAGE LINES FOR USER TERMINALS MUST BE FORMATTED IN
**  WORKING STORAGE SINCE DISPLAYS CANNOT BE USED.  DISPLAYS
**  WILL GO TO THE LOG FILE.
**
**************************************************************
 
01	DATE-MESSAGE DISPLAY-7.
	02 FILLER	PIC X(6) VALUE "DATE: ".
	02 DM-MO	PIC 9(2).
	02 FILLER	PIC X    VALUE "-".
	02 DM-DD	PIC 9(2).
	02 FILLER	PIC X    VALUE "-".
	02 DM-YY	PIC 9(2).
	02 FILLER	PIC X(9) VALUE "   TIME: ".
	02 DM-HH	PIC 9(2).
	02 FILLER	PIC X    VALUE ":".
	02 DM-MM	PIC 9(2).
 
01	DUMMY-LINE USAGE IS DISPLAY-7.
	02 FILLER		PIC X(6) VALUE "LINE #".
	02 DUMMY-LINE-NO	PIC ZZ9.
	02 FILLER		PIC X(18) VALUE " - DEMO MULTI-USER".
 
01	ADD-ANSWER-LINE USAGE IS DISPLAY-7.
	03  FILLER		PIC X(14)
		VALUE "YOUR TOTAL IS ".
	03  ADD-ANSWER		PIC Z(8).99-.
 
******************************************************************
**
**  SINCE ACCEPTS CANNOT BE USED IN CONNECTION WITH USER
**  TERMINALS, THE INCOMING MESSAGE  STRING MAY
**  HAVE TO BE BROKEN UP INTO A NUMBER OF FIELDS.
**  THE WORKING STORAGE ELEMENTS NECESSARY FOR THE UNSTRING
**  ROUTINE BEGINS HERE.
**
******************************************************************
 
01  BREAK-UP.
*
* ** THE BREAK UP ARRAY IS USED TO PASS DATA TO AND 
* ** GET DATA FROM  THE UNSTRING ROUTINE.
* ** IT BREAKS A STRING OF CHARACTERS
* ** UP INTO THE APPROPRIATE NUMBER OF DATA FIELDS
* ** WHERE COMMAS ARE USED AS FIELD DELIMITERS.
* ** ITS ELEMENTS ARE:
* **    BU-NOFLDS       THE NUMBER OF FIELDS TO BE BROKEN UP (MAX 7).
* **    BU-LGTH	THE LENGTH OF EACH FIELD (MAX 35).
* **    BU-TYP          THE TYPE OF EACH FIELD - ALPHA (A) OR NUMERIC (N).
* **    BU-JUST         JUSTIFICATION (RIGHT (R) OR
* **                    LEFT (L)) OF EACH FIELD - DEFAULT
* **                    ON ALPHA FIELDS IS LEFT - NUMERIC
* **                    FIELDS ARE ALWAYS RIGHT.
* **    BU-DEC          NUMBER OF DECIMALS IN NUMERIC
* **                    FIELDS - NOT USED FOR ALPHA FIELDS.
* **    BU-ANSWER       PLACE WHERE BROKEN UP FIELD IS
* **                    PUT.  NUMERIC FIELDS ARE INITIALIZED
* **                    TO ZEROS, ALPHA FIELDS TO SPACES.
* **                    THE LAST CHARACTER OF BU-ANSWER IS USED AS AN
* **                    ERROR FLAG WHERE:
* **                     A - RIGHT TRUNCATION ON LEFT JUSTIFIED ALPHA
* **                     B - LEFT TRUNCATION ON RIGHT JUSTIFIED
* **                         ALPHA OR NUMERIC
* **                     C - RIGHT TRUNCATION ON DECIMAL PART OF NUMBER
* **                     D - RIGHT TRUNCATION ON RIGHT JUSTIFIED
* **                         ALPHA OR NUMERIC WHEN MOVING TO TEMP FIELD
* **    BU-STOR         TEMPORARY WORK AREA FOR RIGHT JUSTIFIED FIELDS
*
 
 
     03  BU-NOFLDS           PICTURE  9.
     03  FILLER          OCCURS 7.
        04  BU-ARRAY.
         05  BU-LGTH         PICTURE 99.
         05  BU-TYP          PICTURE  X.
         05  BU-JUST         PICTURE  X.
         05  BU-DEC          PICTURE  9.
        04  FILLER.
         05  BU-ANSWER.
            07  BU-ANS  PIC X OCCURS 36 TIMES.
     03  BU-STOR             PICTURE  X  OCCURS 35.
     03  CH-COMMA               PICTURE  X  VALUE ",".
 
 
*
* ** THE STRING OF CHARACTERS TO BE BROKEN UP MUST BE IN IMA-DATA
*
01  IMA-DATA.
    03  IMA-ARRAY          PICTURE X  OCCURS 72 TIMES.
 
 01 INDEXES.
*
* ** INDEX1 IS USED TO SUBSCRIPT THRU THE INPUT DATA ARRAY (IMA-ARRAY)
*
    03  INDEX1                   INDEX.
*
* ** INDEX2 IS USED TO SUBSCRIPT THRU THE OUTPUT DATA FIELD ARRAY (BU-ANS)
* ** WHEN MOVING LEFT JUSTIFIED FIELDS TO THE OUTPUT
* ** DATA AREA OR RIGHT JUSTIFIED FIELDS TO THE TEMPORARY AREA
*
    03  INDEX2                   INDEX.
*
* ** INDEX3 IS USED TO REFER TO THE NUMBER OF THE DATA FIELD
* ** CURRENTLY BEING WORKED ON (BU-LGTH, BU-TYP, BU-JUST, BU-DEC, BU-ANSWER)
*
    03  INDEX3                   INDEX.
*
* ** INDEX4 IS USED TO SUBSCRIPT THRU THE TEMPORARY WORK AREA (BU-STOR)
*
    03  INDEX4                   INDEX.
*
* ** INDEX5 IS USED AS THE SUBSCRIPT IN THE OUTPUT DATA FIELD
* ** (BU-ANS) WHEN MOVING RIGHT JUSTIFIED FIELDS FROM
* ** THE TEMPORARY AREA TO THE OUTPUT DATA AREA
*
    03  INDEX5                   INDEX.
 
**********************************************************
**
**  END WORKING STORAGE ELEMENTS FOR UNSTRING ROUTINE
**
**********************************************************
PROCEDURE DIVISION.
 
*ONLY SECTION.
 
BEGIN.
 
*****************************************************************
**							        
**************   DO ALL INITALIZATION FUNCTIONS HERE ************
**							        
**           [OPEN FILES  /  BUILD TABLES   ETC.]               
**							        
**       WHEN INITALIZATION IS DONE    GO TO ENTER-MACRO.       
**							        
*****************************************************************
 
 
 
 
	GO TO ENTER-MACRO.
 
 
 
*****************************************************************
**						                
**************** BEGIN FIXED PROCEDURE DIVISION *****************
**							        
**       THE ONLY THING THAT MAY CHANGE BETWEEN HERE AND        
**       THE END OF FIXED PROCEDURE DIVISION IS THE NUMBER      
**       OF "START"  ENTRIES IN THE GO TO DEPENDING ON - -      
**							        
**     THE TOTAL NUMBER OF "START" ENTRIES + 1 (FOR WRAP-UP)    
**     MUST EQUAL THE NUMBER OF OCCURS IN USER-TABLE IN THIS       
**     PROGRAM, AND    MAXTTY + 1    IN  TP.MAC                 
**							        
*****************************************************************
 
 
**  
**  IF A CONTROL C IS TYPED AT A USER TERMINAL THE
**  TRANSACTION PROCESSOR WILL SEND THE USER TO HERE FOR THE
**  COBOL PROGRAM TO PROCESS APPROPRIATELY
**
 
CONTROL-C-DISPATCH.
	GO TO 1000-PROCESS-CONTROL-C.
 
**
**  THIS IS THE PARAGRAPH THAT IS "ALTERED" BEFORE SENDING
**  OUT A MESSAGE TO A USER.  IT WILL INDICATE WHAT PARAGRAPH TO
**  BEGIN WITH WHEN THE RESPONSE IS RECEIVED FROM THIS USER.
**
 
DISPATCHER.
	GO TO DISPATCHER.
 
ENTER-MACRO.
**
**  THIS ROLLS OUT THE WORK TABLE BACK TO WHERE IT BELONGS.
**
 
	MOVE USER-TABLE(1) TO USER-TABLE(I-O-TTY).
**
**  THE ENTER MACRO WILL SEND THE MESSAGE IN THE OUTPUT MESSAGE
**  AREA TO THE APPROPRIATE USER AND PICK UP A MESSAGE
**  FROM ANOTHER USER.
**
	
	ENTER MACRO TP USING LINES-OUT, OUT-STRING, I-O-TTY.
**
**  INITIALIZE COUNT OF LINES TO SEND
**
 
	MOVE ZERO TO LINES-OUT.
**
**  THIS "ROLLS" IN THE APPROPRIATE USER TABLE TO THE WORK TABLE
**
 
	MOVE USER-TABLE(I-O-TTY) TO USER-TABLE(1).
**
**  MOVE INCOMING MESSAGE TO WORK AREA
**
 
	MOVE OUT-LINE(1) TO IN-LINE.
 
        GO TO    WRAP-UP START   START   START   START
 
                 START   START   START   START   START
 
	START	START	DEPENDING ON I-O-TTY.
 
 
 
	DISPLAY "?? TRANSACTION PROCESSOR HAS MORE TTY'S THAN COBOL PROGRAM - -".
	DISPLAY "?? CALL APPLICATIONS PROGRAMMER".
	STOP RUN.
 
*************************************************************
**
**     END FIXED PROCEDURE DIVISION AREA FOR T/P
**
*************************************************************
 
 
 
***************************************************************
**  
**  IN PLACE OF A DISPLAY AND ACCEPT SEQUENCE YOU SEND
**  AND RECEIVE MESSAGES TO A USER IN THE FOLLOWING MANNER:
**
**  1. IF NECESSARY FILL A WORKING STORAGE FORMATTED MESSAGE
**     WITH DATA.
**
**  2. INCREMENT THE COUNT OF LINES TO SEND TO USER (LINES-OUT).
**     THIS CAN BE USED AS A SUBSCRIPT FOR THE OUTPUT ARRAY,
**     HOWEVER, DIRECT SUBSCRIPTING SHOULD BE USED  WHEREVER POSSIBLE.
**
**  3. MOVE MESSAGE FOR USER TO THE OUTPUT ARRAY (OUT-LINE).
**
**  4. IF THERE ARE MORE LINES TO GO TO THE USER BEFORE HE
**     INPUTS A MESSAGE SET THE MORE-TO-COME SWITCH TO "Y"
**     OTHERWISE LEAVE IT BLANK.
**
**  5. IF YOU WANT THE CARRIAGE RETURN /LINE FEED
**     WHICH WOULD NORMALLY FOLLOW AN OUTPUT MESSAGE
**     LINE SUPPRESSED SET OL-CARRIAGE-CTL (1) TO "N"
**     OTHERWISE LEAVE IT BLANK.
**
**  6. ALTER DISPATCHER TO PROCEED TO THE PARAGRAPH NAME
**     TO PROCESS THE USERS RESPONSE.
**
**  7. GO TO ENTER MACRO.
**
**
**  SEE THE START PARAGRAPH NOTES WHICH FOLLOW AS AN EXAMPLE.
**
****************************************************************
 
**
**  TURN OFF USERS ECHO SO HE CAN ENTER PASSWORD
**
 
START.
**
**  THE MESSAGE "!STOPECHOF" WILL BE INTERCEPTED BY THE
**  TRANSACTION PROCESSOR AND THE APPROPRIATE ACTION TAKEN
**
 
	MOVE '!STOPECHOF' TO OUT-LINE(1).
**
**  INCREMENT COUNT OF OUTPUT LINES
**
 
	SET LINES-OUT UP BY 1.
**
**  INDICATE THAT MORE LINES WILL BE SENT TO THE USER
**  BEFORE A RESPONSE IN EXPECTED
**
	MOVE 'Y' TO MORE-TO-COME.
**
**  SET SWITCH TO SUPPRESS CARRIAGE RETURN/LINE FEED AFTER
**  THE MESSAGE PRINTS ON THE TERMINAL
**
 
	MOVE 'N'  TO  OL-CARRIAGE-CTL(1).
**
**  ALTER DISPATCHER TO PROCEED TO THE APPROPRIATE PARAGRAPH
**
 
	ALTER DISPATCHER TO PROCEED TO  NO-ECHO.
	GO TO ENTER-MACRO.
 
**
**  SEND USER WELCOME MESSAGE
**
 
NO-ECHO.
	MOVE 'WELCOME TO MULTI-USER COBOL -DEMO- USING T/P - - PASSWORD: '
		 TO OUT-LINE(1).
	MOVE 'N'  TO  OL-CARRIAGE-CTL(1).
	SET LINES-OUT UP BY 1.
	MOVE SPACES TO USER-TABLE(1).
	ALTER DISPATCHER TO PROCEED TO PASSWORD-CHECK.
	GO TO ENTER-MACRO.
 
**
**  VALIDATE PASSWORD ENTERED
**
 
PASSWORD-CHECK.
	IF IL-1-6  =  "GOTYA"  MOVE 'Y' TO LOGGED-IN(1)    GO TO RESTORE-ECHO.
	ADD 1 TO LOGIN-TRIES(1).
**
**  3 TRIES AT A PASSWORD WERE ALLOWED. AFTER THAT
**  THE ECHO IS RESTORED AND THE USER IS UNSLAVED.
**
 
	IF LOGIN-TRIES(1) = 3
		MOVE '!STOPECHON' TO OUT-LINE(1)
		SET LINES-OUT UP BY 1
		MOVE 'Y' TO MORE-TO-COME
		ALTER DISPATCHER TO PROCEED TO PASSWORD-ERRORS
		GO TO ENTER-MACRO.
	MOVE 'ERROR - -  PASSWORD: ' TO OUT-LINE(1).
	SET LINES-OUT UP BY 1.
	ALTER DISPATCHER TO PROCEED TO PASSWORD-CHECK.
	GO TO ENTER-MACRO.
 
PASSWORD-ERRORS.
	MOVE '!STOPBADPW' TO OUT-LINE(1).
	SET LINES-OUT UP BY 1.
	ALTER DISPATCHER TO PROCEED TO START.
	GO TO ENTER-MACRO.
 
**
**  TURN USERS ECHO BACK ON 
**
 
RESTORE-ECHO.
	MOVE '!STOPECHON' TO OUT-LINE(1).
	SET LINES-OUT UP BY 1.
	MOVE 'Y' TO MORE-TO-COME.
	ALTER DISPATCHER TO PROCEED TO 100-BEGIN.
	GO TO ENTER-MACRO.
 
**
**  GIVE THE USER AN ASTERISK AND  SEE WHICH BRANCH
**  OF THE PROGRAM HE WANTS.
**
 
100-BEGIN.
	SET LINES-OUT UP BY 1.
	MOVE SPACES TO OUT-LINE(LINES-OUT).
	SET LINES-OUT UP BY 1.
	MOVE "*"  TO OUT-LINE(LINES-OUT).
	MOVE 'N'  TO OL-CARRIAGE-CTL(LINES-OUT).
	ALTER DISPATCHER TO PROCEED TO  200-MAJOR-BRANCH.
	GO TO ENTER-MACRO.
 
200-MAJOR-BRANCH.
	IF IL-1-6 = "DATE  "   GO TO 300-DATE.
	IF IL-1-6 = "HELP  "   GO TO 400-HELP.
	IF IL-1-6 = "PRINT "   GO TO 500-PRINT.
	IF IL-1-6 = "REPEAT"   GO TO 600-REPEAT.
	IF IL-1-6 = "ADD   "	GO TO 700-ADD.
	IF IL-1-6 = "STOP  "   GO TO 999-STOP.
	MOVE "INVALID COMMAND  -  TRY     HELP" TO OUT-LINE(1).
	SET LINES-OUT UP BY 1.
	GO TO 100-BEGIN.
 
**
**  USER WANTS TO KNOW DATE AND TIME.
**  IF HE ASKS MORE THAN ONCE WITHIN 5 MINUTES, LET HIM KNOW.
**
 
300-DATE.
	MOVE TODAY TO DATE-TIME.
**
**  OUTPUT MESSAGE MUST BE SET UP IN WORKING STORAGE
**
 
	MOVE MO TO DM-MO.
	MOVE DD TO DM-DD.
	MOVE YY TO DM-YY.
	MOVE HH TO DM-HH.
	MOVE MM TO DM-MM.
	MOVE DATE-MESSAGE TO OUT-LINE(1).
	SET LINES-OUT UP BY 1.
	MOVE MM TO HOLD-MM.
	IF LAST-MINUTE(1) = SPACE
		GO TO 350-DATE.
	IF LAST-MINUTE(1) GREATER THAN MM
		ADD 60 TO MM.
	SUBTRACT LAST-MINUTE(1) FROM MM.
	IF MM > 5   GO TO 350-DATE.
 
	SET LINES-OUT UP BY 1.
	MOVE "(P.S. - YOU ASKED FOR DATE LESS THAN 5 MIN. AGO!!)" TO OUT-LINE(LINES-OUT).
 
350-DATE.
	MOVE HOLD-MM TO LAST-MINUTE(1).
	GO TO 100-BEGIN.
 
**
**  USER WANTS TO KNOW WHAT THE PROGRAM CAN DO
**
 
400-HELP.
	MOVE SPACES TO OUT-LINE(1).
	MOVE "DATE = TODAYS DATE & TIME" TO OUT-LINE(2).
	MOVE "HELP = THIS TEXT" TO OUT-LINE(3).
	MOVE "PRINT= PRINT NN LINES; XX LINES @ A BURST" TO OUT-LINE(4).
	MOVE "REPEAT= TYPE BACK TO THE USER EXACTLY WHAT HE TYPED" TO OUT-LINE(5).
	MOVE "ADD  = ADD 3 NUMBERS AND PRINT THE RESULT" TO OUT-LINE (6).
	MOVE "STOP = GET OUT OF THIS PROGRAM & UNSLAVE SELF" TO OUT-LINE(7).
	SET LINES-OUT UP BY 7.
	GO TO 100-BEGIN.
 
**
**  USER WANTS TO SEE SOME LINES PRINTED - FIND OUT HOW MANY.
**
 
500-PRINT.
	SET LINES-OUT UP BY 1.
	MOVE 'HOW MANY TEST LINES DO YOU WANT TO PRINT (01-99) ?  ' TO OUT-LINE(LINES-OUT).
	MOVE 'N' TO OL-CARRIAGE-CTL(LINES-OUT).
	ALTER DISPATCHER TO PROCEED TO 505-PRINT.
	GO TO ENTER-MACRO.
 
505-PRINT.
	MOVE IL-1-2 TO LINES-TO-PRINT(1).
	IF LINES-TO-PRINT(1) IS GREATER THAN ZERO
	   AND LINES-TO-PRINT(1) IS LESS THAN 100   GO TO 510-PRINT.
	SET LINES-OUT UP BY 1.
	MOVE '?? NOT WITHIN RANGE' TO OUT-LINE(LINES-OUT).
	GO TO 500-PRINT.
 
510-PRINT.
	SET LINES-OUT UP BY 1.
	MOVE 'HOW MANY LINES PER BURST (01-99) ?  ' TO OUT-LINE(LINES-OUT).
	MOVE 'N'  TO  OL-CARRIAGE-CTL(LINES-OUT).
	ALTER DISPATCHER TO PROCEED TO 515-PRINT.
	GO TO ENTER-MACRO.
 
515-PRINT.
	MOVE IL-1-2 TO LINES-PER-BURST(1).
	IF LINES-PER-BURST(1) IS GREATER THAN ZERO
	   AND LINES-PER-BURST(1) IS LESS THAN 100 
		MOVE ZERO TO CURRENT-LINE(1)
		GO TO 520-PRINT.
	SET LINES-OUT UP BY 1.
	MOVE '?? NOT WITHIN RANGE' TO OUT-LINE(LINES-OUT).
	GO TO 510-PRINT.
 
520-PRINT.
	MOVE LINES-PER-BURST(1) TO LINES-LEFT-THIS-BURST(1).
 
525-PRINT.
	ADD 1 TO CURRENT-LINE(1).
	MOVE CURRENT-LINE(1) TO DUMMY-LINE-NO.
	SUBTRACT 1 FROM LINES-LEFT-THIS-BURST(1).
	SET LINES-OUT UP BY 1.
	MOVE DUMMY-LINE TO OUT-LINE(LINES-OUT).
**
**  DUE TO BUFFER SPACE ONLY 15 LINES ARE SEND OUT AT ONE TIME.
**  IF THERE ARE MORE THAN 15 THE MORE-TO-COME SWITCH IS SET
**  SO THE USER NEVER KNOWS HE IS ONLY GETTING 15 LINES AT
**  A WHACK.
**
	IF LINES-OUT = 15
		MOVE 'Y' TO MORE-TO-COME
		ALTER DISPATCHER TO PROCEED TO 525-PRINT
		GO TO ENTER-MACRO.
**
**  SEE IF ALL USER WANTED IS SENT
**
 
	IF CURRENT-LINE(1) = LINES-TO-PRINT(1)
		GO TO 100-BEGIN.
**
**  SEE IF ENTIRE BURST IS READY TO SEND.  LOOK FOR A
**  CARRIAGE RETURN TO SIGNAL HE WANTS THE NEXT BURST.
**
 
	IF LINES-LEFT-THIS-BURST(1) = ZERO
		SET LINES-OUT UP BY 1
		MOVE '(TYPE <CR> FOR MORE)  ' TO OUT-LINE(LINES-OUT)
		MOVE 'N'  TO  OL-CARRIAGE-CTL(LINES-OUT)
		ALTER DISPATCHER TO PROCEED TO 520-PRINT
		GO TO ENTER-MACRO.
	GO TO 525-PRINT.
 
 
 
**
**  GIVE USER BACK WHAT HE ENTERED
**
 
600-REPEAT.
	SET LINES-OUT UP BY 1.
	GO TO 100-BEGIN.
 
**
**  SHOW USER THAT YOU CAN ADD
**
 
700-ADD.
	SET LINES-OUT UP BY 1.
	MOVE "ENTER 3 NUMBERS (SEPARATED BY COMMAS) TO ADD TOGETHER" TO 
		OUT-LINE (LINES-OUT).
	ALTER DISPATCHER TO PROCEED TO 720-ANSWER.
	GO TO ENTER-MACRO.
720-ANSWER.
**
**  SINCE MORE THAT ONE PIECE OF DATA IS ENTERED USE THE
**  UNSTRING ROUTINE TO BREAK UP THE FIELDS.
**
 
*
* ** THE WAY YOU PASS PARAMETERS TO THE UNSTRING ROUTINE IS AS FOLLOWS:
* ** 
* **    1. MOVE  THE NUMBER OF FIELDS TO EXPECT TO BU-NOFLDS.
* ** 
* **    2. MOVE THE INFORMATION ABOUT EACH FIELD TO BU-ARRAY
* **      THIS CAN BE DONE PIECE MEAL BUT IN ONE FELL SWOOP IS EASIER.
* **    
* **  EX:      NUMBER OF FIELDS TO EXPECT - 1
* ** 
* **           FIELD # - 1
* **           FIELD LENGTH - 2
* **           FIELD TYPE - A
* **           FIELD JUSTIFICATION - R
* **           NO DECIMALS
* ** 
* **      CODING WOULD BE:
* **         MOVE 1 TO BU-NOFLDS.
* **         MOVE "02AR " TO BU-ARRAY (1).
* **               --                  -
* **               / -                /
* **         LENGTH / -        FIELD #
* **            TYPE / -
* **    JUSTIFICATION /
* **          DECIMALS
*
	MOVE IN-LINE TO IMA-DATA.
	MOVE 3 TO BU-NOFLDS.
	MOVE "10N 2" TO BU-ARRAY (1), BU-ARRAY (2), BU-ARRAY (3).
	PERFORM 9000-UNSTRING THRU 9035-EXIT-9000.
**
**  FIELDS MUST BE FIRST CHECKED TO BE SURE THEY'RE NUMERIC BEFORE
**  ADDING.  MINUS SIGNS MUST BE LOOKED FOR AND DEALT WITH
**  ACCORDINGLY.
**
 
	MOVE BU-ANSWER (1) TO A-R.
	EXAMINE A-R TALLYING ALL "-" REPLACING BY ZERO.
	IF A NUMERIC NEXT SENTENCE ELSE
		GO TO 740-ERROR.
	IF TALLY > 0 COMPUTE A = 0 - A.
	MOVE BU-ANSWER (2) TO B-R.
	EXAMINE B-R TALLYING ALL "-" REPLACING BY ZERO.
	IF B NUMERIC NEXT SENTENCE ELSE
		GO TO 740-ERROR.
	IF TALLY > 0 COMPUTE B = 0 - B.
	MOVE BU-ANSWER (3) TO C-R.
	EXAMINE C-R TALLYING ALL "-" REPLACING BY ZERO.
	IF C NUMERIC NEXT SENTENCE ELSE
		GO TO 740-ERROR.
	IF TALLY > 0 COMPUTE C = 0 - C.
**
**  IF ALL FIELDS NUMERIC ADD THEM.
**
 
	COMPUTE D = A + B + C.
	MOVE D TO ADD-ANSWER.
	MOVE SPACE TO OUT-LINE (1).
	MOVE ADD-ANSWER-LINE TO OUT-LINE (2).
	SET LINES-OUT UP BY 2.
	GO TO 100-BEGIN.
740-ERROR.
	SET LINES-OUT UP BY 1.
	MOVE "NUMBERS ENTERED NOT NUMERIC " TO OUT-LINE (LINES-OUT).
	GO TO 700-ADD.

**
**  USER WANTS OUT
**

999-STOP.
	MOVE "!STOP     " TO OUT-LINE(1).
	SET LINES-OUT UP BY 1.
	ALTER DISPATCHER TO PROCEED TO START.
	GO TO  ENTER-MACRO.
 
**
**  IF CONTROL-C ENTERED USER WANTS TO START OVER.
**  IF HE WAS LOGGED IN GO SEE WHICH BRANCH HE WANTS
**  OTHERWISE CHECK HIS PASSWORD
**
 
1000-PROCESS-CONTROL-C.
	IF LOGGED-IN(1) = 'Y'
		GO TO 100-BEGIN.
	GO TO PASSWORD-CHECK.
 
**
**********************************************************
**      FOLLOWING IS THE UNSTRING ROUTINE
**
**********************************************************
 
 9000-UNSTRING.
*
* ** THIS ROUTINE BREAKS APART A STRING OF CHARACTERS INTO
* ** DATA FIELDS, WHERE COMMAS ARE FIELD DELIMITERS,
* ** GIVEN THE NUMBER OF DATA FIELDS (BU-NOFLDS), PLUS
* ** THE LENGTH (BU-LGTH), TYPE (BU-TYP),  JUSTIFICATION
* ** (BU-JUST), AND NUMBER OF DECIMALS (BU-DEC)
* ** OF EACH OF THE FIELDS.  THE RESULTANT DATA FIELDS ARE PUT IN
* ** BU-ANSWER. IF ANY ERRORS WERE DETECTED THE LAST CHARACTER
* ** OF BU-ANSWER WILL CONTAIN THE ERROR CODE.
*
     MOVE  0 TO  INDEX1, INDEX3.
9002-SET-RETURN-AREAS.
*
* ** LOOP THRU ALL THE DATA FIELDS INITIALIZING THE
* ** OUTPUT AREA (BU-ANSWER) TO SPACES IF THE DATA FIELD
* ** IS ALPHA AND ZEROS IF THE DATA FIELD IS NUMERIC.
*
     ADD 1 TO INDEX3.
     IF BU-TYP (INDEX3) = "A"
       MOVE SPACE TO BU-ANSWER (INDEX3)
       ELSE MOVE ZERO TO BU-ANSWER (INDEX3).
     IF INDEX3 < BU-NOFLDS GO TO 9002-SET-RETURN-AREAS.
     MOVE 0 TO INDEX3.
 9005-START.
     ADD 1 TO  INDEX3.
*
* ** IF ALL THE OUTPUT DATA FIELDS HAVE BEEN WORKED ON, EXIT.
*
     IF INDEX3 >  BU-NOFLDS GO TO  9035-EXIT-9000.
9006-IF.
*
* ** IF THE END OF THE INPUT DATA IS REACHED, EXIT.
*
     IF INDEX1 = 72 GO TO 9035-EXIT-9000.
     ADD 1 TO  INDEX1.
*
* ** IF THERE ARE LEADING SPACES IGNORE THEM
*
     IF IMA-ARRAY (INDEX1) = SPACE GO TO 9006-IF.
*
* ** IF THIS IS A NUMERIC FIELD GO TO THE NUMERIC PROCESSING AREA
*
     IF BU-TYP (INDEX3) = "N" GO TO 9010-NUMERIC.
*
* ** THE FIELD IS THEREFORE ALPHA.
* ** IF IT IS A RIGHT JUSTIFIED  FIELD GO TO 9012-RIGHT
*
     IF  BU-JUST (INDEX3)  = "R"  GO TO 9012-RIGHT.
     MOVE 0  TO  INDEX2.
*
* ** THIS SECTION HANDLES ALPHA DATA FIELDS LEFT JUSTIFIED
*
 9007-ALPHA-LEFT.
*
* ** LOOK FOR A COMMA TO END THE FIELD
*
     IF IMA-ARRAY (INDEX1) = CH-COMMA  GO TO  9005-START.
     ADD 1 TO INDEX2.
*
* ** IF THE OUTPUT DATA FIELD IS FULL, SET ERROR FLAG TO "A" AND
* ** BYPASS FILLING IT
*
     IF INDEX2 > BU-LGTH (INDEX3) MOVE "A" TO BU-ANS (INDEX3,36) GO  TO  9009-ADD.
*
* ** OTHERWISE PUT THE INPUT CHARACTER INTO THE OUTPUT DATA FIELD AREA
*
     MOVE IMA-ARRAY (INDEX1) TO BU-ANS (INDEX3, INDEX2).
 9009-ADD.
*
* ** IF ENTIRE INPUT RECORD IS READ, EXIT.
*
     IF INDEX1 = 72 GO TO 9035-EXIT-9000.
*
* ** OTHERWISE PICK UP THE NEXT CHARACTER
*
     ADD 1 TO INDEX1.
     GO TO 9007-ALPHA-LEFT.
 9010-NUMERIC.
*
* ** CHECK TO SEE IF THERE ARE ANY DECIMAL PLACES
*
     IF BU-DEC (INDEX3)   = 0 NEXT SENTENCE
      ELSE GO TO 9020-NUMERIC-DECIMAL.
 9012-RIGHT.
*
* ** THIS SECTION HANDLES ALPHA DATA FIELDS RIGHT JUSTIFIED
* ** AND NUMERICS WITH NO DECIMAL.
* ** THESE FIELDS ARE FIRST MOVED TO A TEMPORARY AREA (BU-STOR)
* ** THEN TO THE OUTPUT AREA (BU-ANS).
*
     MOVE 0 TO  INDEX4.
 9014-IF.
*
* ** LOOK FOR THE COMMA TO END THE FIELD
*
     IF IMA-ARRAY (INDEX1) = CH-COMMA GO TO 9018-MOVE.
*
* ** IF YOU HIT A SPACE AND THIS IS THE LAST DATA FIELD DON'T
* ** BOTHER LOOKING FOR THE COMMA BEFORE MOVING THIS FIELD TO THE
* ** OUTPUT AREA BECAUSE THESE FIELDS SHOULD NOT CONTAIN SPACES.
* ** IF THERE ARE MORE DATA FIELDS LOOP
* ** UNTIL THE COMMA OR END OF INPUT DATA IS FOUND.
*
     IF IMA-ARRAY (INDEX1) NOT = SPACE NEXT SENTENCE
      ELSE IF INDEX3 = BU-NOFLDS GO TO 9018-MOVE
      ELSE GO TO 9016-ADD.
*
* ** IF THE TEMPORARY DATA FIELD IS FULL SET ERROR FLAG TO "D"  BYPASS FILLING I
*
     IF INDEX4 = 35 MOVE "D" TO BU-ANS (INDEX3,36)  GO TO 9016-ADD.
*
* ** OTHERWISE MOVE INPUT CHARACTER TO TEMPORARY DATA FIELD
*
     ADD 1 TO INDEX4.
     MOVE IMA-ARRAY (INDEX1) TO  BU-STOR (INDEX4).
 9016-ADD.
*
* ** CHECK IF ALL THE INPUT DATA  READ
*
     IF INDEX1 = 72 GO TO 9018-MOVE.
*
* ** OTHERWISE READ THE NEXT CHARACTER
*
     ADD 1 TO INDEX1.
     GO TO 9014-IF.
*
* ** NOW MOVE THE DATA FIELD FROM ITS TEMPORARY HOME (BU-STOR) TO THE
* ** OUTPUT DATA AREA (BU-ANS)
*
 9018-MOVE.
*
* ** IF NOTHING WAS PUT IN THE TEMP FIELD, PROCESS NEXT FIELD.
*
     IF INDEX4 = 0 GO TO 9005-START.
*
* ** SET INDEX5 TO THE LENGTH OF THE OUTPUT FIELD
*
     MOVE BU-LGTH (INDEX3) TO INDEX5.
*
* ** MOVE TEMP FIELD TO OUTPUT AREA ONE CHARACTER AT A TIME
* ** MOVING THE RIGHTMOST INPUTTED CHARACTER
* ** TO THE RIGHTMOST CHARACTER OF THE OUTPUT DATA FIELD AND
* ** WORK TO THE LEFT
*
9019-MOVE.
*
* ** IF THE TEMP FIELD IS EMPTY, PROCESS NEXT FIELD.
*
     IF INDEX4 = 0  GO TO 9005-START.
*
* ** IF THE DATA OUTPUT FIELD IS FULL AND THERE WAS MORE DATA TO
* ** MOVE SET ERROR FLAG TO "B" AND   PROCESS NEXT FIELD.
*
     IF INDEX5 = 0 MOVE "B" TO BU-ANS (INDEX3,36)  GO TO 9005-START.
     MOVE BU-STOR (INDEX4)  TO BU-ANS (INDEX3, INDEX5).
     SUBTRACT 1 FROM INDEX4.
     SUBTRACT 1 FROM INDEX5.
     GO TO 9019-MOVE.
*
* ** THIS SECTION HANDLES NUMERICS WITH A POSSIBLE DECIMAL.
* ** THE PART OF THIS FIELD TO THE LEFT OF THE DECIMAL POINT
* ** (THE WHOLE PART) IS FIRST MOVED TO A TEMPORARY AREA (BU-STOR).
* ** THE DECIMAL PART IS THEN MOVED TO THE OUTPUT AREA (BU-ANS)
* ** AFTER WHICH THE WHOLE PART IS MOVED FROM THE TEMPORARY
* ** AREA TO THE OUTPUT AREA.
*
 9020-NUMERIC-DECIMAL.
     MOVE 0 TO INDEX2, INDEX4.
 9022-IF.
*
* ** LOOK FOR THE COMMA TO END THE DATA FIELD
*
     IF IMA-ARRAY (INDEX1) =  CH-COMMA  GO TO 9029-COMP.
*
* ** IF YOU HIT A SPACE AND THIS IS THE LAST DATA FIELD
* ** DON'T BOTHER LOOKING FOR THE COMMA BEFORE
* ** MOVING THIS FIELD TO THE TEMP AREA BECUASE NUMERIC FIELDS 
* ** SHOULD NOT CONTAIN SPACES.
* ** IF THERE ARE MORE DATA FIELDS
* ** LOOP UNTIL THE COMMA OR END OF DATA IS FOUND
*
     IF IMA-ARRAY (INDEX1) NOT = SPACE NEXT SENTENCE
        ELSE IF INDEX3 = BU-NOFLDS GO TO 9029-COMP
        ELSE GO TO 9024-ADD.
*
* ** LOOK FOR THE DECIMAL POINT. IF FOUND JUMP TO WHERE
* ** YOU READ THE DECIMAL PART OF THE NUMBER.
*
     IF IMA-ARRAY (INDEX1) =  "."  
       ADD 1 TO INDEX1 GO TO 9026-ADD.
*
* ** IF TEMPORARY DATA FIELD FULL, SET ERROR FLAG TO "D" AND BYPASS FILLING IT
*
     IF INDEX4 = 35 MOVE "D" TO BU-ANS (INDEX3,36)  GO TO 9024-ADD.
*
* ** OTHERWISE MOVE INPUT CHARACTER TO TEMP DATA FIELD
*
     ADD 1 TO INDEX4.
     MOVE  IMA-ARRAY (INDEX1)  TO  BU-STOR (INDEX4).
 9024-ADD.
*
* ** CHECK IF ENTIRE INPUT RECORD READ
*
     IF INDEX1 = 72 GO TO 9029-COMP.
*
* ** OTHERWISE READ THE NEXT CHARACTER
*
     ADD 1 TO  INDEX1.
     GO TO 9022-IF.
*
* ** THIS SECTION MOVES DECIMAL PART OF DATA FIELD TO THE
* ** OUTPUT DATA FIELD
*
 9026-ADD.
*
* ** FIGURE OUT WHERE THE DECIMAL PART
* ** OF THE NUMBER SHOULD START IN THE OUTPUT DATA FIELD.
* ** THE FIELD LENGTH MINUS THE NUMBER OF DECIMAL PLACES
* ** WILL GIVE YOU ONE CHARACTER TO THE LEFT OF THE DESIRED POSITION.
*
     COMPUTE INDEX5 = BU-LGTH (INDEX3) - BU-DEC (INDEX3).
9027-IF.
*
* ** CHECK IF COMMA HIT WHILE LOOKING FOR DECIMAL PART OF NUMBER
*
     IF IMA-ARRAY (INDEX1) = CH-COMMA GO TO 9029-COMP.
*
* ** IF YOU HIT A SPACE AND THIS IS THE LAST DATA FIELD DON'T
* ** BOTHER LOOKING FOR THE COMMA BEFORE MOVING THE WHOLE
* ** PART OF THE NUMBER TO THE OUTPUT AREA BECAUSE NUMERIC FIELDS
* ** SHOULD NOT CONTAIN SPACES.
* ** IF THERE ARE MORE DATA FIELDS LOOP UNTIL
* ** THE COMMA OR END OF DATA IS FOUND.
*
     IF IMA-ARRAY (INDEX1) NOT = SPACE NEXT SENTENCE
      ELSE IF INDEX3 = BU-NOFLDS GO TO 9029-COMP
      ELSE GO TO 9028-ADD.
     ADD 1 TO  INDEX5.
*
* ** IF OUTPUT DATA FIELD FULL AND THERE ARE MORE DECIMALS TO MOVE
* ** SET ERROR FLAG TO "C" AND JUMP TO WHERE THE
* ** WHOLE PART OF THE NUMBER IS MOVED TO THE OUTPUT AREA
*
     IF INDEX5  >  BU-LGTH  (INDEX3) MOVE "C" TO BU-ANS (INDEX3,36)   GO  TO 9028-ADD.
*
* ** OTHERWISE MOVE INPUT CHARACTER TO OUTPUT DATA FIELD
*
     MOVE  IMA-ARRAY (INDEX1)  TO  BU-ANS (INDEX3, INDEX5).
9028-ADD.
*
* ** CHECK IF ALL INPUT DATA READ
*
     IF INDEX1 = 72 GO TO 9029-COMP.
*
* ** OTHERWISE READ THE NEXT CHARACTER
*
     ADD 1 TO INDEX1.
     GO TO 9027-IF.
*
* ** THIS SECTION MOVES THE WHOLE PART OF THE NUMBER FROM THE
* ** TEMPORARY AREA TO THE OUTPUT AREA
*
 9029-COMP.
*
* ** IF THERE IS NO WHOLE PART OF THE NUMBER, PROCESS NEXT FIELD.
*
     IF INDEX4 = 0 GO TO 9005-START.
*
* ** OTHERWISE COMPUTE THE RIGHTMOST CHARACTER FOR THE WHOLE
* ** PART OF THE NUMBER IN THE OUTPUT FIELD.
* ** NAMELY, THE FIELD LENGTH MINUS THE NUMBER OF DECIMALS.
*
     COMPUTE  INDEX5 =  BU-LGTH (INDEX3) - BU-DEC (INDEX3).
 9030-IF.
*
* ** IF ALL THE DATA IS MOVED, PROCESS NEXT FIELD.
*
     IF INDEX4 = 0  GO TO 9005-START.
*
* ** IF THE OUTPUT AREA IS FULL AND THERE STILL IS DATA TO MOVE
* ** SET ERROR FLAG TO "B" AND  PROCESS NEXT FIELD.
*
     IF INDEX5 = 0 MOVE "B" TO BU-ANS (INDEX3,36)  GO TO 9005-START.
*
* ** MOVE WHOLE PART OF THE NUMBER FROM THE TEMP AREA TO THE
* ** OUTPUT DATA FIELD WORKING FROM RIGHT TO LEFT
*
     MOVE BU-STOR (INDEX4)  TO  BU-ANS (INDEX3, INDEX5).
     SUBTRACT 1 FROM INDEX4.
     SUBTRACT 1 FROM INDEX5.
     GO TO  9030-IF.
 9035-EXIT-9000.
     EXIT.
 
*********************************************************
**
**       THE UNSTRING ROUTINE ENDETH
**
*********************************************************
 
 
*****************************************************************
**								
**	CLOSE FILES ETC. BETWEEN WRAP-UP  AND  STOP RUN		
**								
**	THIS CODE IS ONLY REACHED WHEN THE OPERATOR AT		
**	THE MASTER TERMINAL WANTS TO STOP THIS JOB /		
**	WHEN YOU GET HERE, ALL OF YOUR SLAVE TERMINALS		
**	HAVE BEEN UN-SLAVED & RETURNED TO MONITOR MODE		
**								*
*****************************************************************
 
WRAP-UP.

	STOP RUN.