00001 IDENTIFICATION DIVISION. 06/29/02 00002 PROGRAM-ID. DTSBU410. DTSBU410 00003 AUTHOR. TRW. LV003 00004 DATE-WRITTEN. OCTOBER 20001. DTSBU410 00005 DATE-COMPILED. DTSBU410 00006 ***** DTSBU410 00007 * DTSBU410 00008 * FUNCTION: FIND FILING SCHEDULE FOR A GIVEN QUARTER DTSBU410 00009 * DTSBU410 00010 * DTSBU410 00011 * MODIFICATION LOG: DTSBU410 00012 * DTSBU410 00013 * 10/30/2001 INITIAL DEVELOPMENT. DTSBU410 00014 * WORK ORDER: PROGRAMMER: GD DTSBU410 00015 * DTSBU410 00016 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU410 00017 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU410 00018 * WORK ORDER: PROGRAMMER: XXX DTSBU410 00019 ***** DTSBU410 00020 * DTSBU410 00021 * DESCRIPTION: DTSBU410 00022 * DTSBU410 00023 * DTSCU410 RETURNS THE FILING SCHEDULE FOR A GIVEN QUARTER. DTSBU410 00024 * DTSBU410 00025 * DTSBU410 00026 ***** DTSBU410 00027 SKIP3 DTSBU410 00028 ENVIRONMENT DIVISION. DTSBU410 00029 SKIP3 DTSBU410 00030 DATA DIVISION. DTSBU410 00031 SKIP3 DTSBU410 00032 WORKING-STORAGE SECTION. DTSBU410 000325 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU410 06/29/02'. DTSBU410 00033 SKIP3 DTSBU410 00034 01 WRK-AREA. DTSBU410 00035 05 WRK-ABEND-CODE PIC X(04) VALUE 'U410'. DTSBU410 00036 05 WRK-ABEND-MSG PIC X(60). DTSBU410 00037 DTSBU410 00038 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSBU410 00039 VALUE +0. DTSBU410 00040 05 WRK-YRQ PIC S9(05) COMP-3. DTSBU410 00041 DTSBU410 00042 05 WRK-MODE PIC X(01). DTSBU410 00043 88 WRK-MODE-INPUT-YRQ-88 VALUE '0'. DTSBU410 00044 88 WRK-MODE-MOST-RECENT-88 VALUE '1'. DTSBU410 00045 DTSBU410 00046 05 WRK-CURR-SCHED PIC X(01). DTSBU410 00047 05 WRK-CURR-STRT-YRQ PIC S9(05) COMP-3. DTSBU410 00048 DTSBU410 00049 05 WRK-YRQ-FOUND-IND PIC X(01). DTSBU410 00050 88 WRK-YRQ-FOUND-YES-88 VALUE 'Y'. DTSBU410 00051 88 WRK-YRQ-FOUND-NO-88 VALUE 'N'. DTSBU410 00052 DTSBU410 00053 01 L910-LINK-AREA. DTSBU410 00054 05 L910-CONTROL-BLOCK. DTSBU410 00055 ++INCLUDE DTSIL910 DTSBU410 00056 05 MSKL-REC. DTSBU410 00057 ++INCLUDE DTSIMSKL DTSBU410 00058 EJECT DTSBU410 00059 01 MFSC-REC. DTSBU410 00060 ++INCLUDE DTSIMFSC DTSBU410 00061 EJECT DTSBU410 00062 01 L004-LINK-AREA. DTSBU410 00063 ++INCLUDE DTSIL004 DTSBU410 00064 EJECT DTSBU410 00065 LINKAGE SECTION. DTSBU410 00066 SKIP3 DTSBU410 00067 01 L410-LINK-AREA. DTSBU410 00068 ++INCLUDE DTSIL410 DTSBU410 00069 EJECT DTSBU410 00070 PROCEDURE DIVISION USING L410-LINK-AREA. DTSBU410 00071 SKIP2 DTSBU410 00072 DTSBU410-MAINLINE. DTSBU410 00073 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBU410 00074 DTSBU410 00075 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU410 00076 DTSBU410 00077 DTSBU410-MAINLINE-EXIT. DTSBU410 00078 GOBACK. DTSBU410 00079 DTSBU410 00080 EJECT DTSBU410 00081 I0000-INITIALIZE. DTSBU410 00082 MOVE SPACES TO WRK-CURR-SCHED. DTSBU410 00083 MOVE ZERO TO WRK-CURR-STRT-YRQ. DTSBU410 00084 DTSBU410 00085 PERFORM I1000-EDIT-INPUT THRU I1000-EXIT. DTSBU410 00086 DTSBU410 00087 I0000-EXIT. DTSBU410 00088 EXIT. DTSBU410 00089 I1000-EDIT-INPUT. DTSBU410 00090 IF NOT L410-MODE-VALID-88 DTSBU410 00091 MOVE 'INVALID MODE ' TO WRK-ABEND-MSG DTSBU410 00092 PERFORM S999-ABEND THRU S999-EXIT DTSBU410 00093 ELSE DTSBU410 00094 MOVE L410-MODE TO WRK-MODE. DTSBU410 00095 DTSBU410 00096 IF L410-EMP-NO NOT NUMERIC DTSBU410 00097 MOVE 'NON-NUMERIC EMP NO ' TO WRK-ABEND-MSG DTSBU410 00098 PERFORM S999-ABEND THRU S999-EXIT DTSBU410 00099 ELSE DTSBU410 00100 MOVE L410-EMP-NO TO WRK-EMP-NO. DTSBU410 00101 DTSBU410 00102 MOVE ZERO TO WRK-YRQ. DTSBU410 00103 IF L410-MODE-INPUT-YRQ-88 DTSBU410 00104 IF L410-YRQ NOT NUMERIC DTSBU410 00105 MOVE 'NON-NUMERIC YRQ ' TO WRK-ABEND-MSG DTSBU410 00106 PERFORM S999-ABEND THRU S999-EXIT DTSBU410 00107 ELSE DTSBU410 00108 MOVE L410-YRQ TO L004-QTR-5-9 DTSBU410 00109 PERFORM S004-FROM-5 THRU S004-EXIT DTSBU410 00110 IF L004-VALID-QTR DTSBU410 00111 MOVE L004-QTR-5-9 TO WRK-YRQ DTSBU410 00112 ELSE DTSBU410 00113 MOVE 'INVALID YRQ ' TO WRK-ABEND-MSG DTSBU410 00114 PERFORM S999-ABEND THRU S999-EXIT. DTSBU410 00115 DTSBU410 00116 I1000-EXIT. DTSBU410 00117 EXIT. DTSBU410 00118 DTSBU410 00119 P0000-PROCESS. DTSBU410 00120 SET L410-NULL-SCHED-88 TO TRUE. DTSBU410 00121 MOVE ZEROS TO L410-SCHED-START-YRQ. DTSBU410 00122 DTSBU410 00123 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSBU410 00124 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSBU410 00125 SET MFSC-FSC-88 TO TRUE. DTSBU410 00126 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSBU410 00127 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU410 00128 IF L910-NO-REC-88 DTSBU410 00129 GO TO P0000-EXIT DTSBU410 00130 ELSE DTSBU410 00131 IF WRK-MODE-INPUT-YRQ-88 DTSBU410 00132 SET WRK-YRQ-FOUND-NO-88 TO TRUE DTSBU410 00133 PERFORM P1000-INPUT-YRQ THRU P1000-EXIT DTSBU410 00134 UNTIL WRK-YRQ-FOUND-YES-88 DTSBU410 00135 OR L910-NO-REC-88 DTSBU410 00136 ELSE DTSBU410 00137 PERFORM P2000-MOST-RECENT THRU P2000-EXIT DTSBU410 00138 UNTIL L910-NO-REC-88 DTSBU410 00139 MOVE WRK-CURR-SCHED TO L410-FILING-SCHED DTSBU410 00140 MOVE WRK-CURR-STRT-YRQ TO L410-SCHED-START-YRQ. DTSBU410 00141 DTSBU410 00142 P0000-EXIT. DTSBU410 00143 EXIT. DTSBU410 00144 DTSBU410 00145 P1000-INPUT-YRQ. DTSBU410 00146 MOVE MSKL-REC TO MFSC-REC. DTSBU410 00147 DTSBU410 00148 IF WRK-YRQ >= MFSC-START-YRQ DTSBU410 00149 AND WRK-YRQ <= MFSC-END-YRQ DTSBU410 00150 IF MFSC-STATUS-OPEN-88 DTSBU410 00151 SET WRK-YRQ-FOUND-YES-88 TO TRUE DTSBU410 00152 MOVE MFSC-FILING-SCHEDULE-CD TO L410-FILING-SCHED DTSBU410 00153 MOVE MFSC-START-YRQ TO L410-SCHED-START-YRQ DTSBU410 00154 GO TO P1000-EXIT. DTSBU410 00155 DTSBU410 00156 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU410 00157 DTSBU410 00158 P1000-EXIT. DTSBU410 00159 EXIT. DTSBU410 00160 DTSBU410 00161 P2000-MOST-RECENT. DTSBU410 00162 MOVE MSKL-REC TO MFSC-REC. DTSBU410 00163 DTSBU410 00164 IF MFSC-STATUS-OPEN-88 DTSBU410 00165 IF MFSC-START-YRQ > WRK-CURR-STRT-YRQ DTSBU410 00166 MOVE MFSC-START-YRQ TO WRK-CURR-STRT-YRQ DTSBU410 00167 MOVE MFSC-FILING-SCHEDULE-CD TO WRK-CURR-SCHED. DTSBU410 00168 DTSBU410 00169 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU410 00170 DTSBU410 00171 P2000-EXIT. DTSBU410 00172 EXIT. DTSBU410 00173 DTSBU410 00174 S004-FROM-5. DTSBU410 00175 SET L004-FROM-5 TO TRUE. DTSBU410 00176 GO TO S004-QTR. DTSBU410 00177 DTSBU410 00178 S004-FROM-ABS. DTSBU410 00179 SET L004-FROM-ABS TO TRUE. DTSBU410 00180 GO TO S004-QTR. DTSBU410 00181 DTSBU410 00182 S004-QTR. DTSBU410 00183 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU410 00184 DTSBU410 00185 S004-EXIT. DTSBU410 00186 EXIT. DTSBU410 00187 DTSBU410 00188 S910-READ. DTSBU410 00189 SET L910-READ-88 TO TRUE. DTSBU410 00190 GO TO S910-MSTR-IO. DTSBU410 00191 DTSBU410 00192 S910-START-BROWSE. DTSBU410 00193 SET L910-START-BROWSE-88 TO TRUE. DTSBU410 00194 GO TO S910-MSTR-IO. DTSBU410 00195 DTSBU410 00196 S910-READ-NEXT. DTSBU410 00197 SET L910-READ-NEXT-88 TO TRUE. DTSBU410 00198 GO TO S910-MSTR-IO. DTSBU410 00199 DTSBU410 00200 S910-MSTR-IO. DTSBU410 00201 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU410 00202 MSKL-REC. DTSBU410 00203 DTSBU410 00204 S910-EXIT. DTSBU410 00205 EXIT. DTSBU410 00206 DTSBU410 00207 S999-ABEND. DTSBU410 00208 SKIP1 DTSBU410 00209 DISPLAY '*** DTSBU410 ABENDING ***'. DTSBU410 00210 DISPLAY WRK-ABEND-MSG. DTSBU410 00211 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU410 00212 SKIP1 DTSBU410 00213 S999-EXIT. DTSBU410 00214 EXIT. DTSBU410