DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
283
Batch/DTSBU310.cob
Normal file
283
Batch/DTSBU310.cob
Normal file
@ -0,0 +1,283 @@
|
||||
00001 IDENTIFICATION DIVISION. 11/01/13
|
||||
00002 PROGRAM-ID. DTSBU310. DTSBU310
|
||||
00003 AUTHOR. NGC. LV001
|
||||
00004 DATE-WRITTEN. OCTOBER 2013. DTSBU310
|
||||
00005 DATE-COMPILED. DTSBU310
|
||||
00006 DTSBU310
|
||||
00007 ***** DTSBU310
|
||||
00008 * DTSBU310
|
||||
00009 * FUNCTION: BUILD ITM FILE THAT PROVIDES AN INDEX TO DTSBU310
|
||||
00010 * REPORTS USING THE BATCH AND ITEM NUMBER. DTSBU310
|
||||
00011 * DTSBU310
|
||||
00012 * DTSBU310
|
||||
00013 ***** DTSBU310
|
||||
00014 DTSBU310
|
||||
00015 ENVIRONMENT DIVISION. DTSBU310
|
||||
00016 INPUT-OUTPUT SECTION. DTSBU310
|
||||
00017 FILE-CONTROL. DTSBU310
|
||||
00018 SELECT BATCH-ITEM-FILE ASSIGN TO DTSFBIO DTSBU310
|
||||
00019 FILE STATUS IS BATCH-ITEM-STATUS. DTSBU310
|
||||
00020 DTSBU310
|
||||
00021 DATA DIVISION. DTSBU310
|
||||
00022 FILE SECTION. DTSBU310
|
||||
00023 FD BATCH-ITEM-FILE DTSBU310
|
||||
00024 RECORDING MODE IS F. DTSBU310
|
||||
00025 DTSBU310
|
||||
00026 01 BATCH-ITEM-REC PIC X(17). DTSBU310
|
||||
00027 DTSBU310
|
||||
00028 DTSBU310
|
||||
00029 WORKING-STORAGE SECTION. DTSBU310
|
||||
000295 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU310 11/01/13'. DTSBU310
|
||||
00030 77 PAN-VALET PICTURE X(24) VALUE '007DTSBU310 10/17/13'. DTSBU310
|
||||
00031 77 PAN-VALET PICTURE X(24) VALUE '037DTSBZ203 01/02/13'. DTSBU310
|
||||
00032 SKIP3 DTSBU310
|
||||
00033 01 W-AREA. DTSBU310
|
||||
00034 05 W-ABEND-CD PIC S9(04) COMP VALUE +310.DTSBU310
|
||||
00035 05 ABEND-MSG PIC X(60). DTSBU310
|
||||
00036 DTSBU310
|
||||
00037 05 W-MOD-NAME PIC X(08) VALUE 'DTSBU310'.DTSBU310
|
||||
00038 DTSBU310
|
||||
00039 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBU310
|
||||
00040 88 W-ERROR-YES-88 VALUE 'Y'. DTSBU310
|
||||
00041 88 W-ERROR-NO-88 VALUE 'N'. DTSBU310
|
||||
00042 DTSBU310
|
||||
00043 05 BATCH-ITEM-STATUS PIC X(02). DTSBU310
|
||||
00044 88 BATCH-ITEM-OK-88 VALUE '00'. DTSBU310
|
||||
00045 DTSBU310
|
||||
00046 05 W-START-YRQ PIC S9(05) COMP-3. DTSBU310
|
||||
00047 DTSBU310
|
||||
00048 05 W-RPT-CNT PIC 9(06). DTSBU310
|
||||
00049 DTSBU310
|
||||
00050 05 W-TRACE-IND PIC X(01). DTSBU310
|
||||
00051 DTSBU310
|
||||
00052 DTSBU310
|
||||
00053 01 WITM-REC. DTSBU310
|
||||
00054 ++INCLUDE DTSIWITM DTSBU310
|
||||
00055 DTSBU310
|
||||
00056 01 L910-LINK-AREA. DTSBU310
|
||||
00057 ++INCLUDE DTSIL910 DTSBU310
|
||||
00058 EJECT DTSBU310
|
||||
00059 01 MSKL-REC. DTSBU310
|
||||
00060 ++INCLUDE DTSIMSKL DTSBU310
|
||||
00061 EJECT DTSBU310
|
||||
00062 01 MHDR-REC. DTSBU310
|
||||
00063 ++INCLUDE DTSIMHDR DTSBU310
|
||||
00064 EJECT DTSBU310
|
||||
00065 01 MPRF-REC. DTSBU310
|
||||
00066 ++INCLUDE DTSIMPRF DTSBU310
|
||||
00067 EJECT DTSBU310
|
||||
00068 01 MQTR-REC. DTSBU310
|
||||
00069 ++INCLUDE DTSIMQTR DTSBU310
|
||||
00070 EJECT DTSBU310
|
||||
00071 01 MRPT-REC. DTSBU310
|
||||
00072 ++INCLUDE DTSIMRPT DTSBU310
|
||||
00073 EJECT DTSBU310
|
||||
00074 01 L001-LINK-AREA. DTSBU310
|
||||
00075 ++INCLUDE DTSIL001 DTSBU310
|
||||
00076 DTSBU310
|
||||
00077 01 L004-LINK-AREA. DTSBU310
|
||||
00078 ++INCLUDE DTSIL004 DTSBU310
|
||||
00079 DTSBU310
|
||||
00080 01 L005-LINK-AREA. DTSBU310
|
||||
00081 ++INCLUDE DTSIL005 DTSBU310
|
||||
00082 DTSBU310
|
||||
00083 PROCEDURE DIVISION. DTSBU310
|
||||
00084 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBU310
|
||||
00085 IF W-ERROR-NO-88 DTSBU310
|
||||
00086 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBU310
|
||||
00087 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBU310
|
||||
00088 END-IF. DTSBU310
|
||||
00089 GOBACK. DTSBU310
|
||||
00090 DTSBU310
|
||||
00091 I0000-INITIATE. DTSBU310
|
||||
00092 MOVE 'N' TO W-TRACE-IND. DTSBU310
|
||||
00093 DTSBU310
|
||||
00094 DTSBU310
|
||||
00095 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBU310
|
||||
00096 DTSBU310
|
||||
00097 PERFORM I3000-START-YRQ THRU I3000-EXIT. DTSBU310
|
||||
00098 DTSBU310
|
||||
00099 I0000-EXIT. DTSBU310
|
||||
00100 EXIT. DTSBU310
|
||||
00101 DTSBU310
|
||||
00102 DTSBU310
|
||||
00103 I2000-OPEN-FILES-1. DTSBU310
|
||||
00104 MOVE W-TRACE-IND TO L910-TRACE-IND. DTSBU310
|
||||
00105 DTSBU310
|
||||
00106 MOVE W-MOD-NAME TO L910-MOD-NAME. DTSBU310
|
||||
00107 DTSBU310
|
||||
00108 OPEN OUTPUT BATCH-ITEM-FILE. DTSBU310
|
||||
00109 IF NOT BATCH-ITEM-OK-88 DTSBU310
|
||||
00110 DISPLAY 'CANNOT OPEN BATCH ITEM FILE ' DTSBU310
|
||||
00111 BATCH-ITEM-STATUS DTSBU310
|
||||
00112 SET W-ERROR-YES-88 TO TRUE DTSBU310
|
||||
00113 GO TO I2000-EXIT DTSBU310
|
||||
00114 END-IF. DTSBU310
|
||||
00115 DTSBU310
|
||||
00116 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBU310
|
||||
00117 DTSBU310
|
||||
00118 I2000-EXIT. DTSBU310
|
||||
00119 EXIT. DTSBU310
|
||||
00120 DTSBU310
|
||||
00121 I3000-START-YRQ. DTSBU310
|
||||
00122 SET L005-FROM-SYS TO TRUE. DTSBU310
|
||||
00123 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBU310
|
||||
00124 MOVE L005-DATE TO L004-DATE. DTSBU310
|
||||
00125 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBU310
|
||||
00126 SUBTRACT +20 FROM L004-ABS-QTR. DTSBU310
|
||||
00127 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBU310
|
||||
00128 MOVE L004-QTR-5-9 TO W-START-YRQ. DTSBU310
|
||||
00129 DTSBU310
|
||||
00130 DISPLAY 'START QUARTER: ' L004-SLASH-QTR. DTSBU310
|
||||
00131 DTSBU310
|
||||
00132 I3000-EXIT. DTSBU310
|
||||
00133 EXIT. DTSBU310
|
||||
00134 DTSBU310
|
||||
00135 DTSBU310
|
||||
00136 P0000-PROCESS. DTSBU310
|
||||
00137 MOVE +0 TO W-RPT-CNT. DTSBU310
|
||||
00138 DTSBU310
|
||||
00139 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBU310
|
||||
00140 MOVE +0 TO MSKL-EMP-NO. DTSBU310
|
||||
00141 SET MSKL-PRF-88 TO TRUE. DTSBU310
|
||||
00142 DTSBU310
|
||||
00143 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU310
|
||||
00144 PERFORM UNTIL L910-NO-REC-88 DTSBU310
|
||||
00145 MOVE MSKL-REC TO MPRF-REC DTSBU310
|
||||
00146 PERFORM P1000-FIND-REPORT THRU P1000-EXIT DTSBU310
|
||||
00147 MOVE MPRF-REC TO MSKL-REC DTSBU310
|
||||
00148 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU310
|
||||
00149 END-PERFORM. DTSBU310
|
||||
00150 DTSBU310
|
||||
00151 P0000-EXIT. DTSBU310
|
||||
00152 EXIT. DTSBU310
|
||||
00153 DTSBU310
|
||||
00154 P1000-FIND-REPORT. DTSBU310
|
||||
00155 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBU310
|
||||
00156 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBU310
|
||||
00157 SET MRPT-RPT-88 TO TRUE. DTSBU310
|
||||
00158 MOVE W-START-YRQ TO MRPT-YRQ. DTSBU310
|
||||
00159 MOVE ZEROS TO MRPT-DOC-NO. DTSBU310
|
||||
00160 DTSBU310
|
||||
00161 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBU310
|
||||
00162 DTSBU310
|
||||
00163 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU310
|
||||
00164 PERFORM UNTIL L910-NO-REC-88 DTSBU310
|
||||
00165 MOVE MSKL-REC TO MRPT-REC DTSBU310
|
||||
00166 IF MRPT-ORIG-88 DTSBU310
|
||||
00167 OR MRPT-SUPPLEM-88 DTSBU310
|
||||
00168 PERFORM P1100-WRITE-WITM THRU P1100-EXIT DTSBU310
|
||||
00169 END-IF DTSBU310
|
||||
00170 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU310
|
||||
00171 END-PERFORM. DTSBU310
|
||||
00172 DTSBU310
|
||||
00173 P1000-EXIT. DTSBU310
|
||||
00174 EXIT. DTSBU310
|
||||
00175 DTSBU310
|
||||
00176 P1100-WRITE-WITM. DTSBU310
|
||||
00177 MOVE MRPT-BATCH-NO TO WITM-BATCH-NO DTSBU310
|
||||
00178 MOVE MRPT-ITEM-NO TO WITM-ITEM-NO DTSBU310
|
||||
00179 MOVE MRPT-YRQ TO WITM-YRQ DTSBU310
|
||||
00180 MOVE MRPT-EMP-NO TO WITM-EMP-NO DTSBU310
|
||||
00181 ADD 1 TO W-RPT-CNT DTSBU310
|
||||
00182 WRITE BATCH-ITEM-REC FROM WITM-REC. DTSBU310
|
||||
00183 DTSBU310
|
||||
00184 P1100-EXIT. DTSBU310
|
||||
00185 EXIT. DTSBU310
|
||||
00186 DTSBU310
|
||||
00187 T0000-TERMINATE. DTSBU310
|
||||
00188 DISPLAY ' '. DTSBU310
|
||||
00189 DTSBU310
|
||||
00190 DISPLAY '*** DTSBU310 TERMINATION STATISTICS ***'. DTSBU310
|
||||
00191 DTSBU310
|
||||
00192 DISPLAY ' '. DTSBU310
|
||||
00193 DTSBU310
|
||||
00194 DISPLAY 'NUMBER OF REPORTS PROCESSED : 'DTSBU310
|
||||
00195 W-RPT-CNT. DTSBU310
|
||||
00196 DTSBU310
|
||||
00197 PERFORM S910-CLOSE THRU S910-EXIT. DTSBU310
|
||||
00198 CLOSE BATCH-ITEM-FILE. DTSBU310
|
||||
00199 T0000-EXIT. DTSBU310
|
||||
00200 EXIT. DTSBU310
|
||||
00201 DTSBU310
|
||||
00202 S001-FROM-FED-8. DTSBU310
|
||||
00203 SET L001-FROM-FED-8 TO TRUE. DTSBU310
|
||||
00204 GO TO S001-DATE. DTSBU310
|
||||
00205 DTSBU310
|
||||
00206 S001-FROM-FED. DTSBU310
|
||||
00207 SET L001-FROM-FED-6 TO TRUE. DTSBU310
|
||||
00208 GO TO S001-DATE. DTSBU310
|
||||
00209 DTSBU310
|
||||
00210 S001-FROM-ABS. DTSBU310
|
||||
00211 SET L001-FROM-ABS-DAY TO TRUE. DTSBU310
|
||||
00212 GO TO S001-DATE. DTSBU310
|
||||
00213 DTSBU310
|
||||
00214 S001-DATE. DTSBU310
|
||||
00215 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBU310
|
||||
00216 S001-EXIT. EXIT. DTSBU310
|
||||
00217 DTSBU310
|
||||
00218 S004-FROM-DATE. DTSBU310
|
||||
00219 SET L004-FROM-DATE TO TRUE. DTSBU310
|
||||
00220 GO TO S004-YRQ. DTSBU310
|
||||
00221 DTSBU310
|
||||
00222 S004-FROM-ABS. DTSBU310
|
||||
00223 SET L004-FROM-ABS TO TRUE. DTSBU310
|
||||
00224 GO TO S004-YRQ. DTSBU310
|
||||
00225 DTSBU310
|
||||
00226 S004-YRQ. DTSBU310
|
||||
00227 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU310
|
||||
00228 DTSBU310
|
||||
00229 S004-EXIT. DTSBU310
|
||||
00230 EXIT. DTSBU310
|
||||
00231 DTSBU310
|
||||
00232 DTSBU310
|
||||
00233 S910-OPEN-READ. DTSBU310
|
||||
00234 SET L910-OPEN-READ-88 TO TRUE. DTSBU310
|
||||
00235 GO TO S910-MSTR-IO. DTSBU310
|
||||
00236 DTSBU310
|
||||
00237 S910-OPEN-UPDATE-NO-AIX. DTSBU310
|
||||
00238 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBU310
|
||||
00239 GO TO S910-MSTR-IO. DTSBU310
|
||||
00240 DTSBU310
|
||||
00241 S910-OPEN-UPDATE-HDR. DTSBU310
|
||||
00242 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DTSBU310
|
||||
00243 GO TO S910-MSTR-IO. DTSBU310
|
||||
00244 DTSBU310
|
||||
00245 S910-READ. DTSBU310
|
||||
00246 SET L910-READ-88 TO TRUE. DTSBU310
|
||||
00247 GO TO S910-MSTR-IO. DTSBU310
|
||||
00248 DTSBU310
|
||||
00249 S910-START-BROWSE. DTSBU310
|
||||
00250 SET L910-START-BROWSE-88 TO TRUE. DTSBU310
|
||||
00251 GO TO S910-MSTR-IO. DTSBU310
|
||||
00252 DTSBU310
|
||||
00253 S910-READ-NEXT. DTSBU310
|
||||
00254 SET L910-READ-NEXT-88 TO TRUE. DTSBU310
|
||||
00255 GO TO S910-MSTR-IO. DTSBU310
|
||||
00256 DTSBU310
|
||||
00257 S910-COUNT. DTSBU310
|
||||
00258 SET L910-COUNT-88 TO TRUE. DTSBU310
|
||||
00259 GO TO S910-MSTR-IO. DTSBU310
|
||||
00260 DTSBU310
|
||||
00261 S910-REWRITE. DTSBU310
|
||||
00262 SET L910-REWRITE-88 TO TRUE. DTSBU310
|
||||
00263 GO TO S910-MSTR-IO. DTSBU310
|
||||
00264 DTSBU310
|
||||
00265 S910-DELETE. DTSBU310
|
||||
00266 SET L910-DELETE-88 TO TRUE. DTSBU310
|
||||
00267 GO TO S910-MSTR-IO. DTSBU310
|
||||
00268 DTSBU310
|
||||
00269 S910-CLOSE. DTSBU310
|
||||
00270 SET L910-CLOSE-88 TO TRUE. DTSBU310
|
||||
00271 GO TO S910-MSTR-IO. DTSBU310
|
||||
00272 DTSBU310
|
||||
00273 S910-MSTR-IO. DTSBU310
|
||||
00274 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU310
|
||||
00275 MSKL-REC. DTSBU310
|
||||
00276 S910-EXIT. DTSBU310
|
||||
00277 EXIT. DTSBU310
|
||||
00278 SKIP3 DTSBU310
|
||||
00279 S999-ABEND. DTSBU310
|
||||
00280 CALL 'DTSBU999' USING W-ABEND-CD. DTSBU310
|
||||
00281 S999-EXIT. DTSBU310
|
||||
00282 EXIT. DTSBU310
|
||||
Reference in New Issue
Block a user