*COMDECK  CATRTS
00001 ****************************************************************  04/20/78
00002 ****************************************************************  CATRTS
00003 *                                                                    LV001
00004 *     CHECK CALLING MODULE RETURNS FROM I/O REQUESTS              CATRTS
00005 *                                                                 CATRTS
00006 ***************************************************************** CATRTS
00007 ***************************************************************** CATRTS
00008  0000-BEGIN.                                                      CATRTS
00009      IF RTBL-MOD-REQ EQUAL TO "1"                                 CATRTS
00010          GO TO DATA-READ-RETURN.                                  CATRTS
00011      IF RTBL-MOD-REQ EQUAL TO "4"                                 CATRTS
00012          GO TO RPT-OUTPUT-RETURN.                                 CATRTS
00013      IF RTBL-MOD-REQ EQUAL TO "5"                                 CATRTS
00014          GO TO 0980-FILE-OUTPUT-RETURN.                           CATRTS
00015 ****************************************************************  CATRTS
00016 ****************************************************************  CATRTS
00017 *                                                                 CATRTS
00018 *    INITIALIZATION                                               CATRTS
00019 *                                                                 CATRTS
00020 ****************************************************************  CATRTS
00021 ****************************************************************  CATRTS
00022      MOVE SPACES TO DATA-ARG-LIST.                                CATRTS
00023      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                            CL**2
00025      MOVE "N" TO SEC-PAGE-SW.                                     CATRTS
00026      MOVE "Y" TO FIRST-REC-SW.                                    CATRTS
00027 *                                                                 CATRTS
00028 *    OUTPUT REPORT HEADING IF FIRST TIME FOR REPORT               CATRTS
00029 *        OR IF NEWPAGE OPTION IS YES                              CATRTS
00030 *                                                                 CATRTS
00031      IF FIRST-ENTRY-SWITCH EQUAL "Y"                                 CL**2
00032          MOVE "N" TO FIRST-ENTRY-SWITCH                           CATRTS
00033          GO TO 0100-NEWPAGE.                                      CATRTS
00034      IF RTBL-OPT-NEWPAGE EQUAL TO "Y"                             CATRTS
00035          GO TO 0100-NEWPAGE.                                      CATRTS
00036      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00037      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00038      GO TO 0150-OUTPUT-ENTRY-NAME.                                CATRTS
00039  0100-NEWPAGE.                                                    CATRTS
           IF PAGE-NO > 0 
               PERFORM EOP-RT THRU EOP-RT-XIT.
00040      MOVE 99 TO LINE-CT.                                          CATRTS
00041      MOVE 1 TO PRT-CTL.                                           CATRTS
00042      MOVE SPACES TO STD-REPORT-REC.                               CATRTS
00043      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  CATRTS
00044  0150-OUTPUT-ENTRY-NAME.                                          CATRTS
00045      IF RTBL-OPT-REPORT EQUAL "N"                                    CL**2
00046          GO TO 0300-ENTTYPE-INDEX.                                   CL**2
00047      IF RTBL-OPT-FORMAT EQUAL "D"                                    CL**2
00048          MOVE "Y" TO CATEGORY-811-SW.                                CL**2
00049      MOVE EXT-HOLD-CATNAME TO LIST-LINE-NAME.                     CATRTS
00050      MOVE EXT-HOLD-TYPE TO LIST-LINE-ENTTYPE.                        CL**2
00051      MOVE LIST-LINE-MSG TO STD-RPT-MESSAGE.                       CATRTS
00052      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  CATRTS
00053 ****************************************************************  CATRTS
00054 ****************************************************************  CATRTS
00055 *                                                                 CATRTS
00056 *    FORMAT INDEX FILE DETAIL RECORDS                             CATRTS
00057 *            TYPE 3 = ENTITY TYPE INDEX                           CATRTS
00058 *            TYPE 4 = CATALOGUE NAME INDEX                        CATRTS
00059 *        TYPE 5 = INDENTED INDEX                                  CATRTS
00060 *                                                                 CATRTS
00061 ***************************************************************   CATRTS
00062 ***************************************************************   CATRTS
00063  0300-ENTTYPE-INDEX.                                              CATRTS
00064 *                                                                 CATRTS
00065 *    DETERMINE IF CATALOGUE NAME INDEX HAS BEEN REQUESTED         CATRTS
00066 *                                                                 CATRTS
00067      IF RTBL-OPT-INDEX EQUAL TO "N"                               CATRTS
00068          GO TO 0500-INDENTED-INDEX.                               CATRTS
00069 *                                                                 CATRTS
00070 *    OUTPUT ENTITY TYPE INDEX (1ST TIME THRU THIS ENTITY TYPE)    CATRTS
00071 *                                                                 CATRTS
00072      IF RTBL-OPT-SEQ EQUAL TO  "2" OR "3" OR "4"                  CATRTS
00073          GO TO 0400-CATNAME-INDEX.                                CATRTS
00074      IF ENTTYPE-1ST-SW (ENTTYPE-SUB) EQUAL TO "N"                 CATRTS
00075          GO TO 0400-CATNAME-INDEX.                                CATRTS
00076      MOVE "N" TO ENTTYPE-1ST-SW (ENTTYPE-SUB).                    CATRTS
00077      MOVE SPACES TO IDX-DET-REC.                                     CL**2
00078      MOVE RTBL-HDR-REQTYPE TO IDX-DET-REQTYPE.                    CATRTS
00079      MOVE RTBL-HDR-REQNO TO IDX-DET-REQNO.                        CATRTS
00080      MOVE "4" TO IDX-DET-RECTYPE.                                    CL**2
00081      MOVE "001" TO IDX-DET-RECSEQ.                                CATRTS
00082      MOVE EXT-HOLD-ENTTYPE TO IDX-ENT-ENTTYPE.                    CATRTS
00083      MOVE PAGE-NO TO IDX-ENT-PAGENO.                              CATRTS
00084      MOVE "I" TO CATTBL-FILE-TYPE.                                CATRTS
00085      MOVE "1" TO CATTBL-RECORD-TYPE.                              CATRTS
00086      PERFORM 0900-USERFILE-OUT THRU 0999-USERFILE-OUT-XIT.        CATRTS
00087 *                                                                 CATRTS
00088 *    FORMAT CATALOGUE NAME INDEX DETAIL RECORD                    CATRTS
00089 *                                                                 CATRTS
00090  0400-CATNAME-INDEX.                                              CATRTS
00091      MOVE SPACES TO IDX-DET-REC.                                     CL**2
00092      MOVE RTBL-HDR-REQTYPE TO IDX-DET-REQTYPE.                    CATRTS
00093      MOVE RTBL-HDR-REQNO TO IDX-DET-REQNO.                        CATRTS
00094      MOVE "5" TO IDX-DET-RECTYPE.                                    CL**2
00095      MOVE "001" TO IDX-DET-RECSEQ.                                CATRTS
00096      MOVE EXT-HOLD-CATNAME TO IDX-CAT-CATNAME.                       CL**2
00097      MOVE  EXT-HOLD-ENTTYPE TO IDX-CAT-ENTTYPE.                      CL**2
00098      MOVE PAGE-NO TO IDX-ENT-PAGENO.                              CATRTS
00099      MOVE "I" TO CATTBL-FILE-TYPE.                                CATRTS
00100      MOVE "1" TO CATTBL-RECORD-TYPE.                              CATRTS
00101      PERFORM 0900-USERFILE-OUT THRU 0999-USERFILE-OUT-XIT.        CATRTS
00102 *                                                                 CATRTS
00103 *    FORMAT INDENTED INDEX DETAIL RECORD                          CATRTS
00104 *                                                                 CATRTS
00105  0500-INDENTED-INDEX.                                             CATRTS
00106      IF RTBL-OPT-INDENT EQUAL "N"                                 CATRTS
00107      GO TO 0600-GET-DATA.                                            CL**2
00108      MOVE SPACES TO IDX-DET-REC.                                     CL**2
00109      MOVE RTBL-HDR-REQTYPE TO IDX-DET-REQTYPE.                    CATRTS
00110      MOVE RTBL-HDR-REQNO TO IDX-DET-REQNO.                        CATRTS
00111      MOVE "6" TO IDX-DET-RECTYPE.                                    CL**2
00112      MOVE "001" TO IDX-DET-RECSEQ.                                CATRTS
00113      MOVE EXT-HOLD-RETNO TO IDX-REL-RETNO.                           CL**2
00114      MOVE EXT-HOLD-CATNAME TO IDX-REL-CATNAME.                       CL**2
00115      MOVE EXT-HOLD-ENTTYPE TO IDX-REL-ENTTYPE.                    CATRTS
00116      MOVE EXT-HOLD-RETLEV TO IDX-REL-RETLEV.                         CL**2
00117      MOVE PAGE-NO TO IDX-REL-PAGENO.                              CATRTS
00118      MOVE "I" TO CATTBL-FILE-TYPE.                                CATRTS
00119      MOVE "1" TO CATTBL-RECORD-TYPE.                              CATRTS
00120      PERFORM 0900-USERFILE-OUT THRU 0999-USERFILE-OUT-XIT.        CATRTS
00121 **************************************************************       CL**2
00122 *                                                                    CL**2
00123 *    RETRIEVE PRIME DATA FILE RECORD FOR ENTRY                       CL**2
00124 *    FORMAT $FILE ENTRY (TYPE 3) RECORD                              CL**2
00125 *                                                                    CL**2
00126 ***********************************************************          CL**2
00127  0600-GET-DATA.                                                      CL**2
00128      MOVE EXT-HOLD-CATNAME TO DATA-ENTRY-NAME.                       CL**2
00129      MOVE EXT-HOLD-CATNAME TO HIT-WORK-NAME.                         CL**2
00130      MOVE EXT-HOLD-ENTTYPE TO HIT-WORK-ENTTYPE.                      CL**2
00131      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00132      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RS" OR "RT"               CL**2
00133          GO TO 1000-1ST-OUTPUT.                                      CL**2
00134 *                                                                    CL**2
00135 *    FORMAT USER FILE ENTRY RECORD                                   CL**2
00136 *                                                                    CL**2
00137      MOVE SPACES TO USER-ENTRY-REC.                                  CL**2
00138      MOVE RTBL-HDR-REQNO TO USER-ENTRY-REQNO.                        CL**2
00139      MOVE EXT-HOLD-CATNAME TO USER-ENTRY-CNAME.                      CL**2
00140      MOVE EXT-HOLD-TYPE TO USER-ENTRY-ENTTYPE.                       CL**2
00141      MOVE "3" TO USER-ENTRY-RECTYPE.                                 CL**2
00142      MOVE EXT-HOLD-RETNO TO USER-ENTRY-RETNO.                        CL**2
00143      MOVE EXT-HOLD-RETLEV TO USER-ENTRY-RETLEV.                      CL**2
00144 *                                                                    CL**2
00145 *     IF NO DATA PLACE ZEROES AND SPACES IN DATA FILE FLDS           CL**2
00146 *                                                                    CL**2
00147      IF DATA-RETURN-CODE EQUAL TO ZERO                               CL**2
00148          MOVE DATA-HDR-NAME-LST  TO  USER-ENTRY-NAME-LST             CL**2
00149          MOVE DATA-HDR-PWD-LST   TO  USER-ENTRY-PWD-LST              CL**2
00150          MOVE DATA-HDR-REV-ADD   TO  USER-ENTRY-REV-ADD              CL**2
00151          MOVE DATA-HDR-DATE-ADD  TO  USER-ENTRY-DATE-ADD             CL**2
00152          MOVE DATA-HDR-USAGE     TO  USER-ENTRY-USAGE                CL**2
00153      ELSE                                                            CL**2
00154          MOVE SPACES             TO  USER-ENTRY-NAME-LST             CL**2
00155          MOVE SPACES             TO  USER-ENTRY-PWD-LST              CL**2
00156          MOVE SPACES             TO  USER-ENTRY-DATE-LST             CL**2
00157          MOVE ZEROES             TO  USER-ENTRY-REV-ADD              CL**2
00158          MOVE SPACES             TO  USER-ENTRY-DATE-ADD             CL**2
00159          MOVE ZEROES             TO  USER-ENTRY-USAGE.               CL**2
00160      MOVE "U" TO CATTBL-FILE-TYPE.                                   CL**2
00161      MOVE "3" TO CATTBL-RECORD-TYPE.                                 CL**2
00162      PERFORM 0900-USERFILE-OUT THRU 0999-USERFILE-OUT-XIT.           CL**2
00163      GO TO 1000-1ST-OUTPUT.                                          CL**2
00164 ****************************************************************  CATRTS
00165 *                                                                 CATRTS
00166 *    TABLE INDEX FILE AND USER FILE RECORDS FOR OUTPUT            CATRTS
00167 *        BY THE CALLING MODULE                                    CATRTS
00168 *                                                                 CATRTS
00169 *************************************************************     CATRTS
00170  0900-USERFILE-OUT.                                               CATRTS
00171      ADD 1 TO USER-COUNT.                                         CATRTS
00172      MOVE CATTBL-FILE-TYPE TO CATTBL-FIL-CTL (USER-COUNT).           CL**2
00173      MOVE CATTBL-RECORD-TYPE TO CATTBL-REC-TYPE (USER-COUNT).        CL**2
00174 *                                                                 CATRTS
00175 *    TABLE INDEX RECORDS                                          CATRTS
00176 *                                                                 CATRTS
00177      IF CATTBL-FILE-TYPE EQUAL TO "I"                             CATRTS
00178          MOVE IDX-DET-REC TO CAT-RECORD (USER-COUNT)                 CL**2
00179          GO TO 0950-USER-OUT-CHECK.                               CATRTS
00180 *    USER FILE RECORD (EITHER ENTRY, DET120 OR DET200)               CL**2
00181      IF CATTBL-RECORD-TYPE EQUAL TO "3"                              CL**2
00182          MOVE USER-ENTRY-REC TO CAT-RECORD (USER-COUNT)              CL**2
00183          GO TO 0950-USER-OUT-CHECK.                                  CL**2
00184      MOVE USER-LINE200-REC TO CAT-RECORD (USER-COUNT).               CL**2
00185  0950-USER-OUT-CHECK.                                             CATRTS
00186      IF USER-COUNT EQUAL TO 10                                    CATRTS
00187          MOVE "5" TO RTBL-MOD-REQ                                 CATRTS
00188          EXIT PROGRAM.                                             CATRTS 
00189      GO TO 0999-USERFILE-OUT-XIT.                                 CATRTS
00190  0980-FILE-OUTPUT-RETURN.                                         CATRTS
00191      MOVE ZERO TO USER-COUNT.                                     CATRTS
00192      MOVE ZERO TO RTBL-MOD-REQ.                                   CATRTS
00193  0999-USERFILE-OUT-XIT.                                              CL**2
00194      EXIT.                                                        CATRTS
00195                                                                    CATRTS 
00196 ****************************************************************  CATRTS
00197 ****************************************************************  CATRTS
00198 *                                                                 CATRTS
00199 *     PROCESS RTBL OUTPUT STATEMENTS                              CATRTS
00200 *        IF NO OUTPUT STATEMENTS OUTPUT ALL CATEGORIES            CATRTS
00201 *                                                                 CATRTS
00202 ****************************************************************  CATRTS
00203 ****************************************************************  CATRTS
00204  1000-1ST-OUTPUT.                                                 CATRTS
00205      MOVE 1 TO SUB6.                                              CATRTS
00206      IF RTBL-OUT-CAT (1) EQUAL SPACES                             CATRTS
00207          MOVE 999 TO RTBL-OUT-CAT (1)                             CATRTS
00208          MOVE 0001 TO RTBL-OUT-FRLINE (1)                            CL**2
00209          MOVE 9999 TO RTBL-OUT-TOLINE (1)                         CATRTS
00210          MOVE 9999 TO RTBL-OUT-FORLINES (1)                       CATRTS
00211          MOVE ZEROS TO RTBL-OUTPUT-NUM (1).                       CATRTS
00212  1010-CHECK-OUTNUM.                                               CATRTS
00213 *                                                                 CATRTS
00214 *     PROCESS THOSE WITH NO OUTPUT STATEMENT NO FOR ALL ENTRIES   CATRTS
00215 *                                                                 CATRTS
00216      IF RTBL-OUTPUT-NUM (SUB6) EQUAL ZEROS                        CATRTS
00217          GO TO 1200-INIT-QTBL.                                    CATRTS
00218 *                                                                 CATRTS
00219 *    PROCESS THOSE WITH MATCHING SELECT AND OUTPUT STMT NUMS      CATRTS
00220 *                                                                 CATRTS
00221      IF RTBL-OUTPUT-NUM (SUB6) EQUAL TO EXT-HOLD-SELNO            CATRTS
00222          GO TO 1200-INIT-QTBL.                                    CATRTS
00223 *                                                                 CATRTS
00224 *    INCREMENT TO NEXT RTBL OUTPUT STATMENT                       CATRTS
00225 *                                                                 CATRTS
00226  1100-NEXT-OUTPUT.                                                CATRTS
00227      ADD 1 TO SUB6.                                               CATRTS
00228      IF SUB6 GREATER THAN 9                                       CATRTS
00229          GO TO 1500-REPORT-END.                                   CATRTS
00230      IF RTBL-OUT-CAT (SUB6) EQUAL SPACES                          CATRTS
00231          GO TO 1500-REPORT-END.                                   CATRTS
00232      GO TO 1010-CHECK-OUTNUM.                                     CATRTS
00233 *                                                                 CATRTS
00234 *    FORMAT QTBL FOR REPORT FORMAT INTERFACE                      CATRTS
00235 *                                                                 CATRTS
00236  1200-INIT-QTBL.                                                  CATRTS
00237      MOVE RTBL-OUT-CAT (SUB6) TO QTBL-OUT-CAT.                    CATRTS
00238      MOVE RTBL-OUT-FRLINE (SUB6) TO QTBL-OUT-FRLINE.              CATRTS
00239      MOVE RTBL-OUT-TOLINE (SUB6) TO QTBL-OUT-TOLINE.              CATRTS
00240      MOVE RTBL-OUT-FORLINES (SUB6) TO QTBL-OUT-FORLINES.          CATRTS
00241      GO TO 3400-INIT-LINELIMS.                                    CATRTS
00242  1500-REPORT-END.                                                    CL**2
00243      MOVE "9" TO RTBL-MOD-REQ.                                       CL**2
00244      EXIT PROGRAM.                                                 CATRTS 
00245  1900-ABORT-RUN.                                                     CL**2
00246      MOVE "8" TO RTBL-MOD-REQ.                                       CL**2
00247      EXIT PROGRAM.                                                 CATRTS 
00248                                                                    CATRTS 
00249 ***************************************************************** CATRTS
00250 ****************************************************************  CATRTS
00251 *                                                                 CATRTS
00252 *        FORMAT PRINT LINES FOR SELECTED CATEGORIES               CATRTS
00253 *                                                                 CATRTS
00254 *************************************************************     CATRTS
