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 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 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) = 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) = 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) = 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) = 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.