*COMDECK DMSIO
      /*****************************************************************
      * UTILITIES COMMON TO DMS GENERATION
      ******************************************************************
  
  
      ******************************************************************
      ******************************************************************
      * 
      * MAST1 MANIPULATION ROUTINES.
  
  
      ******************************************************************
      * 
      * MOVE-CAT-LINE.
      * 
      * MOVE-CAT-LINE MOVES THE REQUESTED DETAIL LINE FROM "DATA-DTL" 
      * TO "CAT-WORK", FIRST READING THE ENTRY'S CORRECT RECORD INTO
      * "DATA-RECORD" IF NECESSARY.  ENTRY-NAME, CATEGORY, LINE-NUMBER, 
      * AND LINE-TYPE MAY ALL BE SPECIFIED TO SELECT THE LINE.
      * ENTRY-NAME IS REQUIRED, BUT THE OTHER THREE ARE OPTIONAL.  IF 
      * CATEGORY IS BLANK, THE ENTRY'S FIRST RECORD IS READ INTO
      * "DATA-RECORD", BUT NO DETAIL LINES ARE MOVED.  IF LINE-NUMBER 
      * AND/OR LINE-TYPE ARE LEFT BLANK, THE CORRESPONDING FIELDS IN
      * THE DETAIL LINE ARE IGNORED BY THE SELECTION PROCESS. 
      * 
      * INPUT:   DATA-ENTRY-NAME  - CATNAME OF REQUESTED ENTRY
      *          DATA-ENTRY-CAT   - CATEGORY-ID OF REQUESTED CATEGORY 
      *          DATA-ENTRY-LINE  - LINE NUMBER OF REQUESTED LINE 
      *          DATA-ENTRY-LINETYPE - TYPE OF REQUESTED LINE 
      * 
      * OUTPUT:  DATA-RETURN-CODE - 0 IF ALL OK 
      *                           - 1 IF END OF ENTRY 
      *                           - 2 IF END OF CATEGORY
      *          DATA-NEXT-REC    - CONTINUATION COUNT OF RECORD IN 
      *                             "DATA-RECORD" -- MUST NOT BE ALTERED
      *                             BY CALLING PROGRAM
      *          DETAIL-LEN       - LENGTH OF DETAIL LINE IN
      *                             "CAT-DETAIL"
  
       MOVE-CAT-LINE. 
           MOVE ZERO TO DATA-RETURN-CODE. 
           MOVE SPACES TO CAT-WORK. 
           MOVE "N" TO FOUND-CAT. 
           MOVE 1 TO COLUMN-IN. 
  
      * IF FIRST RECORD OF GIVEN ENTRY-NAME NOT IN "DATA-RECORD", READ
      * IT IN.
           IF DATA-REC-ID NOT = DATA-ENTRY-NAME 
             OR DATA-REC-ID-TRLR NOT = ZERO 
           THEN 
             MOVE ZERO TO DATA-NEXT-REC 
             PERFORM READ-MAST1 THRU READ-MAST1-XIT 
             IF DATA-RETURN-CODE NOT = ZERO 
             THEN 
               GO TO MOVE-CAT-LINE-XIT
             END-IF 
           END-IF 
  
      * IF SPECIFIC CATEGORY NOT REQUESTED, NO FURTHER WORK DONE. 
           IF DATA-ENTRY-CAT = SPACES 
           THEN 
             GO TO MOVE-CAT-LINE-XIT
           END-IF 
  
       100-FIND-CAT.
  
      * IF END OF ENTRY, SET RETURN CODE AND EXIT.
           IF DATA-DTL (COLUMN-IN : 3) = HIGH-VALUES
           THEN 
             MOVE END-OF-ENTRY TO DATA-RETURN-CODE
             GO TO MOVE-CAT-LINE-XIT
           END-IF 
  
      * IF END OF RECORD BUT NOT END OF ENTRY, READ IN CONTINUATION 
      * RECORD. 
           IF DATA-DTL (COLUMN-IN : 3) = "***"
           THEN 
             ADD 1 TO DATA-NEXT-REC 
             PERFORM READ-MAST1 THRU READ-MAST1-XIT 
  
      * IF CONTINUATION RECORD MISSING, THE MAST1 FILE HAS BEEN 
      * DAMAGED BEYOND RECOVERY.
             IF DATA-RETURN-CODE NOT = ZERO 
             THEN 
               GO TO UNRECOV-MAST1-ERR
             END-IF 
  
      * GO BACK AND RESUME SEARCH AT BEGINNING OF CONTINUATION RECORD.
             MOVE 1 TO COLUMN-IN
             GO TO 100-FIND-CAT 
           END-IF 
  
           MOVE DATA-DTL (COLUMN-IN + 3 : 3) TO DETAIL-LEN. 
  
      * IF THE LINE IS NOT IN THE RIGHT CATEGORY, SKIP OVER IT.  IF 
      * PAST THE END OF THE RIGHT CATEGORY, SET RETURN CODE AND EXIT. 
           IF DATA-DTL (COLUMN-IN : 3) NOT = DATA-ENTRY-CAT 
           THEN 
             IF FOUND-CAT = "Y" 
             THEN 
               MOVE END-OF-CAT TO DATA-RETURN-CODE
               GO TO MOVE-CAT-LINE-XIT
             END-IF 
  
             ADD DETAIL-LEN, DTL-HDR-LEN TO COLUMN-IN 
             IF COLUMN-IN > DATA-LIMIT
             THEN 
               GO TO UNRECOV-MAST1-ERR
             END-IF 
  
             GO TO 100-FIND-CAT 
           END-IF 
  
           MOVE "Y" TO FOUND-CAT. 
  
      * IF A SPECIFIC LINE-NUMBER WAS REQUESTED, CHECK IT AGAINST 
      * DETAIL-LINE.  IF LINE-NUMBER NOT A MATCH, SKIP OVER LINE. 
           IF DATA-ENTRY-LINE NOT = ZERO
             AND NOT = DATA-DTL (COLUMN-IN + 11 : 4)
           THEN 
             ADD DETAIL-LEN, DTL-HDR-LEN TO COLUMN-IN 
             IF COLUMN-IN > DATA-LIMIT
             THEN 
               GO TO UNRECOV-MAST1-ERR
             END-IF 
  
             GO TO 100-FIND-CAT 
           END-IF 
  
      * IF A SPECIFIC LINE-TYPE WAS REQUESTED, CHECK SPECIFIED LINE-TYPE
      * AGAINST DETAIL-LINE.  IF LINE-TYPE NOT A MATCH, SKIP OVER LINE. 
           IF DATA-ENTRY-LINETYPE NOT = SPACES
             AND NOT = DATA-DTL (COLUMN-IN + 15 : 1)
           THEN 
             ADD DETAIL-LEN, DTL-HDR-LEN TO COLUMN-IN 
             IF COLUMN-IN > DATA-LIMIT
             THEN 
               GO TO UNRECOV-MAST1-ERR
             END-IF 
  
             GO TO 100-FIND-CAT 
           END-IF 
  
      * THIS IS THE RIGHT LINE.  MOVE IT INTO "CAT-WORK" AND EXIT.
           MOVE DATA-DTL (COLUMN-IN : DETAIL-LEN + DTL-HDR-LEN) 
             TO CAT-WORK. 
  
       MOVE-CAT-LINE-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * DIAGNOSE AN UNRECOVERABLE ERROR IN THE MAST1 FILE AND ABORT.
  
       UNRECOV-MAST1-ERR. 
           MOVE IDX-900 TO MSG-IDX. 
           MOVE "12" TO RETURN-CODE.
           PERFORM ERROR-TYPE0 THRU ERROR-TYPE0-XIT.
           MOVE REQ-ABORT TO GTBL-REQ.
           EXIT PROGRAM.
  
  
      ******************************************************************
      * 
      * MOVE-NEXT-LINE. 
      * 
      * MOVE-NEXT-LINE MOVES THE NEXT LINE OF THE CURRENT ENTRY AND 
      * CATEGORY FROM "DATA-DTL" TO "CAT-WORK".  IF A LINE-TYPE IS
      * GIVEN, ALL LINES OF ANOTHER TYPE WILL BE SKIPPED.  LINE-NUMBER
      * IS IGNORED. 
      * 
      * INPUT:   DATA-ENTRY-LINETYPE - TYPE OF NEXT REQUESTED LINE
      *          COLUMN-IN        - POSITION WITHIN "DATA-DTL" OF 
      *                             PREVIOUS LINE 
      *          DETAIL-LEN       - LENGTH OF PREVIOUS LINE'S DETAIL
      * 
      * OUTPUT:  DATA-RETURN-CODE - 0 IF ALL OK 
      *                           - 1 IF END OF ENTRY 
      *                           - 2 IF END OF CATEGORY
      *          DATA-NEXT-REC    - CONTINUATION COUNT OF RECORD IN 
      *                             "DATA-RECORD" -- MUST NOT BE ALTERED
      *                             BY CALLING PROGRAM
      *          DETAIL-LEN       - LENGTH OF DETAIL LINE IN
      *                             "CAT-DETAIL"
  
       MOVE-NEXT-LINE.
           MOVE ZERO TO DATA-RETURN-CODE. 
  
      * IF CURRENT RECORD OF GIVEN ENTRY-NAME NOT IN "DATA-RECORD", 
      * READ IT IN. 
           IF DATA-REC-ID NOT = DATA-ENTRY-NAME 
             OR DATA-REC-ID-TRLR NOT = DATA-NEXT-REC
           THEN 
             PERFORM READ-MAST1 THRU READ-MAST1-XIT 
             IF DATA-RETURN-CODE NOT = ZERO 
             THEN 
               MOVE SPACES TO CAT-WORK
               GO TO MOVE-NEXT-LINE-XIT 
             END-IF 
           END-IF 
  
       200-SKIP-LINE. 
  
      * INCREMENT INDEX INTO "DATA-DTL" TO NEXT LINE. 
           ADD DETAIL-LEN, DTL-HDR-LEN TO COLUMN-IN.
           IF COLUMN-IN > DATA-LIMIT
           THEN 
             GO TO UNRECOV-MAST1-ERR
           END-IF 
  
       210-CHECK-ENDS.
  
      * IF END OF ENTRY, SET RETURN CODE AND EXIT.
           IF DATA-DTL (COLUMN-IN : 3) = HIGH-VALUES
           THEN 
             MOVE END-OF-ENTRY TO DATA-RETURN-CODE
             MOVE SPACES TO CAT-WORK
             GO TO MOVE-NEXT-LINE-XIT 
           END-IF 
  
      * IF END OF RECORD BUT NOT END OF ENTRY, READ IN CONTINUATION 
      * RECORD. 
           IF DATA-DTL (COLUMN-IN : 3) = "***"
           THEN 
             ADD 1 TO DATA-NEXT-REC 
             PERFORM READ-MAST1 THRU READ-MAST1-XIT 
  
      * IF CONTINUATION RECORD MISSING, FATAL ERROR IN MAST1 FILE.
             IF DATA-RETURN-CODE NOT = ZERO 
             THEN 
               GO TO UNRECOV-MAST1-ERR
             END-IF 
  
             MOVE 1 TO COLUMN-IN
             GO TO 210-CHECK-ENDS 
           END-IF 
  
           MOVE DATA-DTL (COLUMN-IN + 3 : 3) TO DETAIL-LEN. 
  
      * IF START OF NEW CATEGORY, SET RETURN CODE AND EXIT. 
           IF DATA-DTL (COLUMN-IN : 3) NOT = CAT-CATEGORY 
           THEN 
             MOVE END-OF-CAT TO DATA-RETURN-CODE
             MOVE SPACES TO CAT-WORK
             GO TO MOVE-NEXT-LINE-XIT 
           END-IF 
  
      * IF SPECIFIC LINE-TYPE REQUESTED, SKIP OVER ALL OTHERS.
           IF DATA-ENTRY-LINETYPE NOT = SPACES
             AND NOT = DATA-DTL (COLUMN-IN + 15 : 1)
           THEN 
             GO TO 200-SKIP-LINE
           END-IF 
  
      * MOVE NEW LINE INTO "CAT-WORK" AND EXIT. 
           MOVE DATA-DTL (COLUMN-IN : DETAIL-LEN + DTL-HDR-LEN) 
             TO CAT-WORK. 
  
       MOVE-NEXT-LINE-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * READ-MAST1. 
      * 
      * READ-MAST1 EXITS UP TO "DMS300" TO HAVE IT READ THE REQUESTED 
      * MAST1 RECORD INTO "DATA-RECORD". CONTROL WILL RETURN TO 
      * "READ-RETURN" WHEN PROGRAM RE-ENTERED.
      * 
      * INPUT:   DATA-ENTRY-NAME  - CATNAME OF REQUESTED ENTRY
      *          DATA-NEXT-REC    - CONTINUATION COUNT OF REQUESTED 
      *                             RECORD
      *          DATANAME-OK      - "Y" IF DATA-ENTRY-NAME ALLOWED TO BE
      *                             DATANAME -- NO ERROR ON INVALID KEY 
      *                           - "N" FOR ERROR ON INVALID KEY
      * 
      * OUTPUT:  DATA-RECORD      - REQUESTED MAST1 RECORD
      *          DATANAME-OK      - RESET TO "N"
  
       READ-MAST1.
  
      * SET KEY OF REQUESTED MAST1 RECORD.
           MOVE DATA-ENTRY-NAME TO MAST1-REC-ID.
           MOVE DATA-NEXT-REC TO MAST1-REC-ID-TRLR. 
  
      * INITIATE THE READ.
           MOVE REQ-INPUT TO GTBL-REQ.
           EXIT PROGRAM.
  
      ******************************************************************
      * 
      * READ-RETURN.
      * 
      * THE MAST1 RECORD HAS BEEN READ INTO "DATA-RECORD". CHECK IF END 
      * OF ENTRY OR IF NAME FOUND TO BE A DATANAME, NOT A CATNAME.
  
       READ-RETURN. 
           MOVE REQ-CLEAR TO GTBL-REQ.
           IF DATA-HDR-ENT-ID = HIGH-VALUES 
             OR DATANAME-OK = "F" 
           THEN 
             MOVE END-OF-ENTRY TO DATA-RETURN-CODE
           END-IF 
           MOVE "N" TO DATANAME-OK. 
  
       READ-MAST1-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * CLEAR-DATA-ENTRY. 
      * 
      * CLEAR-DATA-ENTRY BLANKS OUT THE FIELD WHICH "MOVE-CAT-LINE" AND 
      * "MOVE-NEXT-LINE" USE TO DETERMINE WHICH RECORD/CATEGORY-LINE TO 
      * BRING INTO WORKING STORAGE. 
  
       CLEAR-DATA-ENTRY.
  
           MOVE SPACES TO DATA-ENTRY-NAME.
           MOVE SPACES TO DATA-ENTRY-CAT. 
           MOVE ZERO TO DATA-ENTRY-LINE.
           MOVE SPACES TO DATA-ENTRY-LINETYPE.
  
       CLEAR-DATA-ENTRY-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * CHECK-COMMENTS. 
      * 
      * IF THE LINE IN "CAT-WORK" IS A COMMENT, CHECK-COMMENTS WILL 
      * OUTPUT IT AND MOVE THE NEXT LINE INTO "CAT-WORK".  IT WILL
      * CONTINUE TO DO THIS UNTIL IT ENCOUNTERS A NON-COMMENT LINE OR 
      * END OF CATEGORY/ENTRY.
      * 
      * INPUT:   GTBL-OPT-COMMENT - CONTROLS WHETHER COMMENTS ARE 
      *                             GENERATED OR NOT
      *          SKIP-COMMENTS    - "Y" IF SHOULD SKIP THESE COMMENTS 
      *                           - "N" IF SHOULD OUTPUT THESE COMMENTS 
  
       CHECK-COMMENTS.
  
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             OR CAT-COMMENT NOT = "*" 
  
             IF GTBL-OPT-COMMENT = "Y"
               AND SKIP-COMMENTS = "N"
             THEN 
               PERFORM OUTPUT-COMMENT THRU OUTPUT-COMMENT-XIT 
             END-IF 
  
             PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
           END-PERFORM
  
       CHECK-COMMENTS-XIT.
           EXIT.
  
  
      /*****************************************************************
      ******************************************************************
      * 
      * OUTPUT ROUTINES.
  
  
      ******************************************************************
      * 
      * START-STMT. 
      * 
      * START-STMT FIRST OUTPUTS THE CONTENTS OF "DMS-LINE" AND THEN
      * STARTS A NEW STATEMENT WITH THE CONTENTS OF "OUT-FIELD".
      * 
      * INPUT:   OUT-CLAUSE       - "Y" IF "OUT-FIELD" PART OF DATA 
      *                             DESCRIPTION CLAUSE
      *          OUT-FIELD        - FIELD TO BE MOVED TO OUTPUT LINE
      *          OUT-LEN          - LENGTH IN CHARACTERS OF "OUT-FIELD" 
      *          OUT-QUOTE        - "Y" IF CONTENTS OF "OUT-FIELD" TO BE
      *                             SURROUNDED BY QUOTES IN "DMS-LINE"
      *                             -- RESET TO "N" UPON RETURN 
      *          INDENT           - COLUMN IN WHICH TO START NEW LINE 
      * 
      * OUTPUT:  COLUMN-OUT       - COLUMN IN WHICH NEXT FIELD CAN BEGIN
      *          DMS-LINE         - CURRENT OUTPUT LINE IMAGE 
  
       START-STMT.
  
      * OUTPUT THE PREVIOUS CONTENTS OF "DMS-LINE" AND SET IT UP
      * FOR A NEW LINE. 
           IF OUT-CLAUSE = "N"
           THEN 
             PERFORM OUTPUT-DMS THRU OUTPUT-DMS-XIT 
             MOVE INDENT TO COLUMN-OUT
             IF COLUMN-OUT > INDENT-MAX 
             THEN 
               MOVE INDENT-MAX TO COLUMN-OUT
             END-IF 
  
      * IF A DATA DESCRIPTION CLAUSE, START AT "INDENT-MAX" IF POSSIBLE.
      * START NEW LINE ONLY IF NECESSARY. 
           ELSE 
             IF COLUMN-OUT NOT > INDENT-MAX 
             THEN 
               MOVE INDENT-MAX TO COLUMN-OUT
             ELSE 
               PERFORM OUTPUT-DMS THRU OUTPUT-DMS-XIT 
               MOVE INDENT-MAX TO COLUMN-OUT
             END-IF 
           END-IF 
  
  
      ******************************************************************
      * 
      * ADD-TO-STMT.
      * 
      * ADD A FIELD TO THE LINE IMAGE STARTED BY "START-STMT", ALWAYS 
      * LEAVING ROOM FOR AN ENDING PERIOD ON THE LINE.  INPUT AND OUTPUT
      * SAME AS FOR "START-STMT". 
  
       ADD-TO-STMT. 
  
      * DON'T WASTE TIME ON A ZERO-LENGTH FIELD.
           IF OUT-LEN = ZERO
           THEN 
             GO TO STMT-XIT 
           END-IF 
  
      * SAVE ROOM FOR QUOTES AROUND "OUT-FIELD".
           IF OUT-QUOTE = "Y" 
           THEN 
             ADD 2 TO OUT-LEN 
  
      * IGNORE LEADING ZEROS IN UN-QUOTED "OUT-FIELD" UNLESS IT'S THE 
      * LEVEL NUMBER. 
           ELSE 
             MOVE 1 TO OUT-START
             IF OUT-FIELD NOT = LEVEL-NO
             THEN 
               PERFORM UNTIL OUT-FIELD (OUT-START : 1) NOT = ZERO 
                 OR OUT-LEN = 1 
  
                 ADD 1 TO OUT-START 
                 SUBTRACT 1 FROM OUT-LEN
               END-PERFORM
             END-IF 
           END-IF 
  
      * IF "OUT-FIELD" IS TOO LONG TO FIT ON CURRENT LINE, OUTPUT 
      * CURRENT LINE AND START A CONTINUATION LINE. 
           ADD COLUMN-OUT, 1, OUT-LEN GIVING TEMP-LEN.
           IF TEMP-LEN > 73 
           THEN 
             PERFORM OUTPUT-DMS THRU OUTPUT-DMS-XIT 
  
             IF OUT-CLAUSE = "N"
             THEN 
               ADD INDENT, INDENT-INC GIVING COLUMN-OUT 
               IF COLUMN-OUT > INDENT-MAX 
               THEN 
                 MOVE INDENT-MAX TO COLUMN-OUT
               END-IF 
             ELSE 
               MOVE INDENT-MAX TO COLUMN-OUT
             END-IF 
  
      * CHECK LINE FIT AGAIN.  IF STILL DOES'T FIT, KEEP FUDGING
      * INDENTATION UNTIL IT DOES.
             ADD COLUMN-OUT, 1, OUT-LEN GIVING TEMP-LEN 
             PERFORM UNTIL TEMP-LEN NOT > 73
               SUBTRACT INDENT-INC FROM COLUMN-OUT
               SUBTRACT INDENT-INC FROM TEMP-LEN
             END-PERFORM
           END-IF 
  
      * MOVE "OUT-FIELD" TO OUTPUT LINE (IN QUOTES IF REQUESTED) AND
      * RESET "COLUMN-OUT". 
           IF OUT-QUOTE = "Y" 
           THEN 
             MOVE QUOTE TO DMS-LINE (COLUMN-OUT : 1)
             MOVE OUT-FIELD (1 : OUT-LEN - 2) 
               TO DMS-LINE (COLUMN-OUT + 1 : OUT-LEN - 2) 
             MOVE QUOTE TO DMS-LINE (COLUMN-OUT + OUT-LEN - 1 : 1)
             MOVE "N" TO OUT-QUOTE
  
           ELSE 
             MOVE OUT-FIELD (OUT-START : OUT-LEN) 
               TO DMS-LINE (COLUMN-OUT : OUT-LEN) 
           END-IF 
  
           MOVE TEMP-LEN TO COLUMN-OUT. 
  
       STMT-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * FIND-LENGTH.
      * 
      * FIND-LENGTH COUNTS THE NUMBER OF CHARACTERS IN "OUT-FIELD" UP TO
      * THE FIRST SPACE (MAXIMUM 72 CHARACTERS).  IT RETURNS THIS LENGTH
      * IN "OUT-LEN". 
      * 
      * INPUT:   OUT-FIELD        - FIELD TO BE COUNTED 
      * 
      * OUTPUT:  OUT-LEN          - LENGTH IN CHARACTERS OF OUT-FIELD 
  
       FIND-LENGTH. 
           PERFORM VARYING FIND-IDX FROM 1 BY 1 
             UNTIL OUT-FIELD (FIND-IDX : 1) = SPACE 
               OR FIND-IDX > 72 
             CONTINUE 
           END-PERFORM
  
           SUBTRACT 1 FROM FIND-IDX GIVING OUT-LEN. 
  
       FIND-LENGTH-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * OUTPUT-DIAG.
      * 
      * OUTPUT-DIAG MOVES THE MESSAGE CONTAINED IN "DIAG-LINE" TO THE 
      * OUTPUT BUFFER "GTBL-OUTPUT-TABLE", WHICH WILL BE PRINTED WHEN 
      * IT BECOMES 40 LINES LONG. 
  
       OUTPUT-DIAG. 
  
      * INCREMENT THE INDEX INTO "GTBL-OUTPUT-TABLE". 
           ADD 1 TO GTBL-COUNT. 
  
      * MOVE THE ERROR MESSAGE AND ITS INDICATOR TO OUTPUT BUFFER AND 
      * CHECK IF IT'S FULL. 
           MOVE DIAG-LINE TO GTBL-OUTPUT-ENTRY (GTBL-COUNT).
           MOVE "E" TO GTBL-OUTPUT-IND (GTBL-COUNT).
           PERFORM OUTPUT-CHECK THRU OUTPUT-CHECK-XIT.
  
       OUTPUT-DIAG-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * OUTPUT-CHECK. 
      * 
      * IF 40 LINES HAVE BEEN STORED IN THE OUTPUT BUFFER, EXIT BACK UP 
      * TO "DMS300" TO HAVE IT PRINTED.  CONTROL WILL RETURN TO "OUTPUT-
      * RETURN" WHEN PROGRAM RE-ENTERED.
  
       OUTPUT-CHECK.
           IF GTBL-COUNT = 40 
           THEN 
             MOVE REQ-OUTPUT TO GTBL-REQ
             EXIT PROGRAM 
  
           ELSE 
             GO TO OUTPUT-CHECK-XIT 
           END-IF 
  
  
      ******************************************************************
      * 
      * OUTPUT-RETURN.
      * 
      * THE OUTPUT BUFFER HAS BEEN PRINTED.  PREPARE IT TO RECEIVE A NEW
      * SET OF LINES. 
  
       OUTPUT-RETURN. 
           MOVE REQ-CLEAR TO GTBL-REQ.
           MOVE ZERO TO GTBL-COUNT. 
           MOVE SPACES TO GTBL-OUTPUT-TABLE.
  
       OUTPUT-CHECK-XIT.
           EXIT.
  
  
      /*****************************************************************
      ******************************************************************
      * 
      * DIAGNOSTIC ROUTINES.
  
      * DIAGNOSTIC CONSISTS ONLY OF MESSAGE TEXT. 
      * 
       ERROR-TYPE0. 
           MOVE MSG-NUM (MSG-IDX) TO DIAG-NUM.
           MOVE MSG-TEXT (MSG-IDX) TO DIAG-TEXT.
           PERFORM OUTPUT-DIAG THRU OUTPUT-DIAG-XIT.
           IF RETURN-CODE NOT = "12"
           THEN 
             MOVE "08" TO RETURN-CODE 
           END-IF 
  
       ERROR-TYPE0-XIT. 
           EXIT.
  
  
      * DIAGNOSTIC STARTS WITH CATNAME FROM "DATA-ENTRY-NAME" AND ENDS
      * WITH MESSAGE TEXT.
      * 
       ERROR-TYPE1. 
           MOVE MSG-NUM (MSG-IDX) TO DIAG-NUM.
           MOVE DATA-ENTRY-NAME TO DIAG-NAME1.
           MOVE MSG-TEXT (MSG-IDX) TO DIAG-TEXT1. 
           PERFORM OUTPUT-DIAG THRU OUTPUT-DIAG-XIT.
           MOVE "08" TO RETURN-CODE.
  
       ERROR-TYPE1-XIT. 
           EXIT.
  
  
      * DIAGNOSTIC CONSISTS OF 35-CHARACTER MESSAGE TEXT FOLLOWED BY
      * CALLER-SUPPLIED LITERAL.
      * 
       ERROR-TYPE2. 
           MOVE MSG-NUM (MSG-IDX) TO DIAG-NUM.
           MOVE MSG-TEXT (MSG-IDX) TO DIAG-TEXT2. 
           MOVE MSG-NAME TO DIAG-NAME2. 
           PERFORM OUTPUT-DIAG THRU OUTPUT-DIAG-XIT.
           MOVE "08" TO RETURN-CODE.
  
       ERROR-TYPE2-XIT. 
           EXIT.
  
  
      * DIAGNOSTIC CONSISTS OF 32-CHARACTER MESSAGE TEXT FOLLOWED BY
      * LINE-NUMBER, "OF", AND THEN ENTITY NAME.
      * 
       ERROR-TYPE3. 
           MOVE MSG-NUM (MSG-IDX) TO DIAG-NUM.
           MOVE MSG-TEXT (MSG-IDX) TO DIAG-TEXT3. 
           MOVE MSG-LINE TO DIAG-LINE3. 
           MOVE " OF " TO DIAG-OF3. 
           MOVE MSG-NAME TO DIAG-NAME3. 
           PERFORM OUTPUT-DIAG THRU OUTPUT-DIAG-XIT.
           MOVE "08" TO RETURN-CODE.
  
       ERROR-TYPE3-XIT. 
           EXIT.
