DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
215
Batch/DTSBU410.cob
Normal file
215
Batch/DTSBU410.cob
Normal file
@ -0,0 +1,215 @@
|
||||
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
|
||||
Reference in New Issue
Block a user