216 lines
17 KiB
COBOL
216 lines
17 KiB
COBOL
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
|