909 lines
72 KiB
COBOL
909 lines
72 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/31/05
|
|
00002 PROGRAM-ID. DTSBX332. DTSBX332
|
|
00003 AUTHOR. TRW. LV001
|
|
00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX332
|
|
00005 DATE-COMPILED. DTSBX332
|
|
00006 SKIP3 DTSBX332
|
|
00007 ***** DTSBX332
|
|
00008 * DTSBX332
|
|
00009 * DTSBX332
|
|
00010 * FUNCTION: BUILD REPORT RECORDS FOR COLLECTIONS REPORT: DTSBX332
|
|
00011 * RECEIVABLES OVER 120 DAYS OLD. DTSBX332
|
|
00012 * DTSBX332
|
|
00013 * DTSBX332
|
|
00014 * MODIFICATION LOG: DTSBX332
|
|
00015 * DTSBX332
|
|
00016 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX332
|
|
00017 * REFERENCE: PROGRAMMER: GD DTSBX332
|
|
00018 * DTSBX332
|
|
00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX332
|
|
00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX332
|
|
00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX332
|
|
00022 * DTSBX332
|
|
00023 * DTSBX332
|
|
00024 * DESCRIPTION: DTSBX332
|
|
00025 * DTSBX332
|
|
00026 * DTSBX332
|
|
00027 * INITIATION: DTSBX332
|
|
00028 * DTSBX332
|
|
00029 * OPEN DTSX774 DTSBX332
|
|
00030 * DTSBX332
|
|
00031 * DTSBX332
|
|
00032 * DTSBX332
|
|
00033 * PROCESSING: DTSBX332
|
|
00034 * DTSBX332
|
|
00035 * BUILD R332 REPORT RECORDS FROM DTSIX332 INPUT. DTSBX332
|
|
00036 * DTSBX332
|
|
00037 * DTSBX332
|
|
00038 * TERMINATION: DTSBX332
|
|
00039 * DTSBX332
|
|
00040 * DTSBX332
|
|
00041 * DTSBX332
|
|
00042 * RECORDS READ: DTSBX332
|
|
00043 * DTSBX332
|
|
00044 * MASTER: DTSBX332
|
|
00045 * DTSBX332
|
|
00046 * NONE DTSBX332
|
|
00047 * DTSBX332
|
|
00048 * ALTERNATE INDEX: DTSBX332
|
|
00049 * DTSBX332
|
|
00050 * NONE. DTSBX332
|
|
00051 * DTSBX332
|
|
00052 * DTSBX332
|
|
00053 * REFERENCE: DTSBX332
|
|
00054 * DTSBX332
|
|
00055 * DTSBX332
|
|
00056 * DTSBX332
|
|
00057 * RECORDS UPDATED: DTSBX332
|
|
00058 * DTSBX332
|
|
00059 * NONE DTSBX332
|
|
00060 * DTSBX332
|
|
00061 * DTSBX332
|
|
00062 * OUTPUT RECORDS WRITTEN: DTSBX332
|
|
00063 * DTSBX332
|
|
00064 * DTSBX332
|
|
00065 * DTSBX332
|
|
00066 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX332
|
|
00067 * DTSBX332
|
|
00068 * NONE. DTSBX332
|
|
00069 * DTSBX332
|
|
00070 * DTSBX332
|
|
00071 * MODULES CALLED: DTSBX332
|
|
00072 * DTSBX332
|
|
00073 * DTSBU001 DATE EDIT/CONVERSION. DTSBX332
|
|
00074 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX332
|
|
00075 * DTSBX332
|
|
00076 * DTSBX332
|
|
00077 * DTSBX332
|
|
00078 ***** DTSBX332
|
|
00079 SKIP3 DTSBX332
|
|
00080 ENVIRONMENT DIVISION. DTSBX332
|
|
00081 INPUT-OUTPUT SECTION. DTSBX332
|
|
00082 FILE-CONTROL. DTSBX332
|
|
00083 SELECT X332-FILE ASSIGN TO DTSX332 DTSBX332
|
|
00084 FILE STATUS IS X332-STATUS. DTSBX332
|
|
00085 DTSBX332
|
|
00086 SELECT BE332-PARM-FILE ASSIGN TO BE332PRM DTSBX332
|
|
00087 FILE STATUS IS PARM-STATUS. DTSBX332
|
|
00088 DTSBX332
|
|
00089 *** SELECT X332-OUT-FILE ASSIGN TO X332OUT DTSBX332
|
|
00090 *** FILE STATUS IS X332-OUT-STATUS. DTSBX332
|
|
00091 EJECT DTSBX332
|
|
00092 DATA DIVISION. DTSBX332
|
|
00093 FILE SECTION. DTSBX332
|
|
00094 FD X332-FILE DTSBX332
|
|
00095 RECORDING MODE IS F DTSBX332
|
|
00096 LABEL RECORDS ARE STANDARD DTSBX332
|
|
00097 BLOCK CONTAINS 0 RECORDS. DTSBX332
|
|
00098 01 X332-REC. DTSBX332
|
|
00099 ++INCLUDE DTSIX332 DTSBX332
|
|
00100 DTSBX332
|
|
00101 FD BE332-PARM-FILE DTSBX332
|
|
00102 RECORDING MODE IS F DTSBX332
|
|
00103 LABEL RECORDS ARE STANDARD DTSBX332
|
|
00104 BLOCK CONTAINS 0 CHARACTERS. DTSBX332
|
|
00105 DTSBX332
|
|
00106 01 BE332-PARM-REC. DTSBX332
|
|
00107 05 BE332-PARM-START-DATE PIC S9(09) COMP-3. DTSBX332
|
|
00108 05 BE332-PARM-END-DATE PIC S9(09) COMP-3. DTSBX332
|
|
00109 05 BE332-PARM-UPDATE-IND PIC X(01). DTSBX332
|
|
00110 88 BE332-PARM-UPDATE-YES-88 VALUE 'Y'. DTSBX332
|
|
00111 88 BE332-PARM-UPDATE-NO-88 VALUE 'N'. DTSBX332
|
|
00112 DTSBX332
|
|
00113 *FD X332-OUT-FILE DTSBX332
|
|
00114 * RECORDING MODE IS F DTSBX332
|
|
00115 * LABEL RECORDS ARE STANDARD DTSBX332
|
|
00116 * BLOCK CONTAINS 0 CHARACTERS. DTSBX332
|
|
00117 * DTSBX332
|
|
00118 *01 X332-OUT-REC PIC X(26). DTSBX332
|
|
00119 DTSBX332
|
|
00120 WORKING-STORAGE SECTION. DTSBX332
|
|
001205 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX332 08/31/05'. DTSBX332
|
|
00121 SKIP3 DTSBX332
|
|
00122 01 WRK-AREA. DTSBX332
|
|
00123 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +332.DTSBX332
|
|
00124 DTSBX332
|
|
00125 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX332'.DTSBX332
|
|
00126 DTSBX332
|
|
00127 05 WRK-TRACE-IND PIC X(01) VALUE SPACE. DTSBX332
|
|
00128 DTSBX332
|
|
00129 05 ABEND-MSG PIC X(60). DTSBX332
|
|
00130 DTSBX332
|
|
00131 05 X332-STATUS PIC X(02) VALUE SPACES. DTSBX332
|
|
00132 88 X332-STATUS-OK-88 VALUE ZEROS. DTSBX332
|
|
00133 88 X332-STATUS-EOF-88 VALUE '10'. DTSBX332
|
|
00134 DTSBX332
|
|
00135 05 PARM-STATUS PIC X(02) VALUE SPACES. DTSBX332
|
|
00136 88 PARM-STATUS-OK-88 VALUE ZEROS. DTSBX332
|
|
00137 88 PARM-STATUS-EOF-88 VALUE '10'. DTSBX332
|
|
00138 DTSBX332
|
|
00139 05 WRK-PARM-UPDATE-IND PIC X(01). DTSBX332
|
|
00140 88 WRK-PARM-UPDATE-YES-88 VALUE 'Y'. DTSBX332
|
|
00141 88 WRK-PARM-UPDATE-NO-88 VALUE 'N'. DTSBX332
|
|
00142 DTSBX332
|
|
00143 05 WRK-MFAS-FOUND-IND PIC X(01) VALUE SPACES. DTSBX332
|
|
00144 88 WRK-MFAS-FOUND-YES-88 VALUE 'Y'. DTSBX332
|
|
00145 88 WRK-MFAS-FOUND-NO-88 VALUE 'N'. DTSBX332
|
|
00146 DTSBX332
|
|
00147 05 WRK-MFAS-EMP-NO PIC S9(07) COMP-3 DTSBX332
|
|
00148 VALUE +0. DTSBX332
|
|
00149 DTSBX332
|
|
00150 05 WRK-MFAS-ESTB-DATE PIC S9(09) COMP-3 DTSBX332
|
|
00151 VALUE +0. DTSBX332
|
|
00152 DTSBX332
|
|
00153 ** 05 X332-OUT-STATUS PIC X(02) VALUE SPACES. DTSBX332
|
|
00154 ** 88 X332-OUT-STATUS-OK-88 VALUE ZEROS. DTSBX332
|
|
00155 DTSBX332
|
|
00156 05 WRK-X332-REC. DTSBX332
|
|
00157 10 WRK-X332-EMP-NO PIC 9(06). DTSBX332
|
|
00158 10 FILLER PIC X(01) VALUE ','. DTSBX332
|
|
00159 10 WRK-X332-YRQ PIC X(06). DTSBX332
|
|
00160 10 FILLER PIC X(01) VALUE ','. DTSBX332
|
|
00161 * 10 WRK-X332-BATCH PIC 9(05). DTSBX332
|
|
00162 * 10 FILLER PIC X(01) VALUE ','. DTSBX332
|
|
00163 * 10 WRK-X332-ITEM PIC 9(03). DTSBX332
|
|
00164 * 10 FILLER PIC X(01) VALUE ','. DTSBX332
|
|
00165 * 10 WRK-X332-ESTB PIC X(10). DTSBX332
|
|
00166 * 10 FILLER PIC X(01) VALUE ','. DTSBX332
|
|
00167 * 10 WRK-X332-TRAN PIC X(02). DTSBX332
|
|
00168 * 10 FILLER PIC X(01) VALUE ','. DTSBX332
|
|
00169 10 WRK-X332-AMT PIC --------9.99. DTSBX332
|
|
00170 DTSBX332
|
|
00171 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBX332
|
|
00172 VALUE +99999999. DTSBX332
|
|
00173 05 WRK-ALL-NINES-BAL PIC S9(09)V99 COMP-3 DTSBX332
|
|
00174 VALUE +99999999.99. DTSBX332
|
|
00175 05 WRK-END-DATE PIC S9(09) COMP-3 DTSBX332
|
|
00176 VALUE +0. DTSBX332
|
|
00177 05 WRK-START-DATE PIC S9(09) COMP-3 DTSBX332
|
|
00178 VALUE +0. DTSBX332
|
|
00179 05 WRK-ABSTIME PIC S9(15) COMP-3. DTSBX332
|
|
00180 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSBX332
|
|
00181 VALUE +0. DTSBX332
|
|
00182 05 WRK-ASSIGN-NO PIC S9(09) COMP-3 DTSBX332
|
|
00183 VALUE +0. DTSBX332
|
|
00184 05 WRK-PRIMARY-NAME PIC X(40). DTSBX332
|
|
00185 05 WRK-FLD-REP-ID PIC X(02). DTSBX332
|
|
00186 DTSBX332
|
|
00187 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX332
|
|
00188 VALUE +0. DTSBX332
|
|
00189 05 WRK-TRAN-TYPE PIC X(02). DTSBX332
|
|
00190 DTSBX332
|
|
00191 05 WRK-QTR-BAL PIC S9(11)V99 COMP-3 DTSBX332
|
|
00192 VALUE +0. DTSBX332
|
|
00193 05 PREV-QTR-BAL PIC S9(11)V99 COMP-3 DTSBX332
|
|
00194 VALUE +0. DTSBX332
|
|
00195 DTSBX332
|
|
00196 05 WRK-REC-AREA PIC X(155). DTSBX332
|
|
00197 DTSBX332
|
|
00198 ******************************************************************DTSBX332
|
|
00199 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE DTSBX332
|
|
00200 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED DTSBX332
|
|
00201 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER DTSBX332
|
|
00202 * FIELDS ARE CALCULATED. THE START BALANCE IS THE RECEIVABLE DTSBX332
|
|
00203 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS. DTSBX332
|
|
00204 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING DTSBX332
|
|
00205 * ANY REPORT QUARTER LIQUIDATIONS. DTSBX332
|
|
00206 ******************************************************************DTSBX332
|
|
00207 05 QTR-SUB PIC S9(04) COMP VALUE +0. DTSBX332
|
|
00208 05 QTR-LAST PIC S9(04) COMP VALUE +0. DTSBX332
|
|
00209 05 QTR-MAX PIC S9(04) COMP VALUE +200. DTSBX332
|
|
00210 05 QTR-TABLE OCCURS 200 TIMES. DTSBX332
|
|
00211 10 QTR-ESTB-DATE PIC S9(09) COMP-3. DTSBX332
|
|
00212 10 QTR-BATCH-NO PIC S9(05) COMP-3. DTSBX332
|
|
00213 10 QTR-ITEM-NO PIC S9(03) COMP-3. DTSBX332
|
|
00214 10 QTR-TRAN-TYPE PIC X(02). DTSBX332
|
|
00215 10 QTR-AMT PIC S9(09)V99 COMP-3. DTSBX332
|
|
00216 10 QTR-FIRST-RCVBL PIC X(01). DTSBX332
|
|
00217 88 QTR-FIRST-RCVBL-YES-88 VALUE 'Y'. DTSBX332
|
|
00218 88 QTR-FIRST-RCVBL-NO-88 VALUE 'N'. DTSBX332
|
|
00219 DTSBX332
|
|
00220 05 WRK-RCVBL-FOUND-IND PIC X(01) VALUE SPACES. DTSBX332
|
|
00221 88 WRK-RCVBL-FOUND-YES-88 VALUE 'Y'. DTSBX332
|
|
00222 88 WRK-RCVBL-FOUND-NO-88 VALUE 'N'. DTSBX332
|
|
00223 DTSBX332
|
|
00224 05 WRK-ESTB-DATE PIC S9(09) COMP-3. DTSBX332
|
|
00225 05 WRK-BATCH-NO PIC S9(05) COMP-3. DTSBX332
|
|
00226 05 WRK-ITEM-NO PIC S9(03) COMP-3. DTSBX332
|
|
00227 DTSBX332
|
|
00228 05 WRK-EVENT-TXT PIC X(50) VALUE DTSBX332
|
|
00229 'FLD ASSIGN CREATED: RCVBL OVER 120 DAYS OLD'. DTSBX332
|
|
00230 DTSBX332
|
|
00231 05 WRK-R332-CNT PIC S9(07) COMP-3 DTSBX332
|
|
00232 VALUE +0. DTSBX332
|
|
00233 05 WRK-X332-CNT PIC S9(07) COMP-3 DTSBX332
|
|
00234 VALUE +0. DTSBX332
|
|
00235 DTSBX332
|
|
00236 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBX332
|
|
00237 VALUE +010169. DTSBX332
|
|
00238 DTSBX332
|
|
00239 05 DISPLAY-CNT PIC Z(06)9. DTSBX332
|
|
00240 05 DISPLAY-AMT-X PIC X(15). DTSBX332
|
|
00241 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX332
|
|
00242 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX332
|
|
00243 05 DISPLAY-AMT1-X PIC X(15). DTSBX332
|
|
00244 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX332
|
|
00245 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX332
|
|
00246 EJECT DTSBX332
|
|
00247 01 L001-LINK-AREA. DTSBX332
|
|
00248 ++INCLUDE DTSIL001 DTSBX332
|
|
00249 DTSBX332
|
|
00250 01 L004-LINK-AREA. DTSBX332
|
|
00251 ++INCLUDE DTSIL004 DTSBX332
|
|
00252 DTSBX332
|
|
00253 01 L005-LINK-AREA. DTSBX332
|
|
00254 ++INCLUDE DTSIL005 DTSBX332
|
|
00255 DTSBX332
|
|
00256 01 L910-LINK-AREA. DTSBX332
|
|
00257 ++INCLUDE DTSIL910 DTSBX332
|
|
00258 SKIP3 DTSBX332
|
|
00259 01 MSKL-REC. DTSBX332
|
|
00260 ++INCLUDE DTSIMSKL DTSBX332
|
|
00261 DTSBX332
|
|
00262 01 MHDR-REC. DTSBX332
|
|
00263 ++INCLUDE DTSIMHDR DTSBX332
|
|
00264 DTSBX332
|
|
00265 01 MPRF-REC. DTSBX332
|
|
00266 ++INCLUDE DTSIMPRF DTSBX332
|
|
00267 DTSBX332
|
|
00268 01 MFAS-REC. DTSBX332
|
|
00269 ++INCLUDE DTSIMFAS DTSBX332
|
|
00270 DTSBX332
|
|
00271 01 MEVL-REC. DTSBX332
|
|
00272 ++INCLUDE DTSIMEVL DTSBX332
|
|
00273 DTSBX332
|
|
00274 01 L921-LINK-AREA. DTSBX332
|
|
00275 ++INCLUDE DTSIL921 DTSBX332
|
|
00276 DTSBX332
|
|
00277 01 ISKL-REC. DTSBX332
|
|
00278 ++INCLUDE DTSIISKL DTSBX332
|
|
00279 DTSBX332
|
|
00280 01 R332-REC. DTSBX332
|
|
00281 ++INCLUDE DTSIR332 DTSBX332
|
|
00282 DTSBX332
|
|
00283 SKIP3 DTSBX332
|
|
00284 PROCEDURE DIVISION. DTSBX332
|
|
00285 DTSBX332
|
|
00286 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBX332
|
|
00287 DTSBX332
|
|
00288 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX332
|
|
00289 UNTIL X332-STATUS-EOF-88. DTSBX332
|
|
00290 DTSBX332
|
|
00291 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX332
|
|
00292 SKIP2 DTSBX332
|
|
00293 GOBACK. DTSBX332
|
|
00294 EJECT DTSBX332
|
|
00295 I0000-INITIALIZE. DTSBX332
|
|
00296 MOVE +0 TO QTR-SUB DTSBX332
|
|
00297 WRK-MFAS-EMP-NO. DTSBX332
|
|
00298 DTSBX332
|
|
00299 MOVE LENGTH OF R332-REC TO R332-LENGTH. DTSBX332
|
|
00300 MOVE '332' TO R332-REC-TYPE. DTSBX332
|
|
00301 DTSBX332
|
|
00302 SET L005-FROM-SYS TO TRUE. DTSBX332
|
|
00303 PERFORM S005-CONVERT-TIME THRU S005-EXIT. DTSBX332
|
|
00304 MOVE L005-ABSTIME TO WRK-ABSTIME. DTSBX332
|
|
00305 DTSBX332
|
|
00306 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX332
|
|
00307 DTSBX332
|
|
00308 PERFORM I3000-ASSIGN-NBR THRU I3000-EXIT. DTSBX332
|
|
00309 DTSBX332
|
|
00310 I0000-EXIT. DTSBX332
|
|
00311 EXIT. DTSBX332
|
|
00312 DTSBX332
|
|
00313 I2000-OPEN-FILES. DTSBX332
|
|
00314 MOVE WRK-TRACE-IND TO L910-TRACE-IND DTSBX332
|
|
00315 L921-TRACE-IND. DTSBX332
|
|
00316 DTSBX332
|
|
00317 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBX332
|
|
00318 L921-MOD-NAME. DTSBX332
|
|
00319 DTSBX332
|
|
00320 OPEN INPUT X332-FILE DTSBX332
|
|
00321 IF NOT X332-STATUS-OK-88 DTSBX332
|
|
00322 DISPLAY 'X332 FILE STATUS IS : ' X332-STATUS DTSBX332
|
|
00323 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX332
|
|
00324 PERFORM S999-ABEND THRU S999-EXIT DTSBX332
|
|
00325 END-IF. DTSBX332
|
|
00326 DTSBX332
|
|
00327 OPEN INPUT BE332-PARM-FILE DTSBX332
|
|
00328 IF NOT PARM-STATUS-OK-88 DTSBX332
|
|
00329 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX332
|
|
00330 MOVE 'CANNOT OPEN PARM FILE ' TO ABEND-MSG DTSBX332
|
|
00331 PERFORM S999-ABEND THRU S999-EXIT DTSBX332
|
|
00332 END-IF. DTSBX332
|
|
00333 DTSBX332
|
|
00334 READ BE332-PARM-FILE DTSBX332
|
|
00335 IF PARM-STATUS-OK-88 DTSBX332
|
|
00336 MOVE BE332-PARM-START-DATE TO WRK-START-DATE DTSBX332
|
|
00337 MOVE BE332-PARM-END-DATE TO WRK-END-DATE DTSBX332
|
|
00338 MOVE BE332-PARM-UPDATE-IND TO WRK-PARM-UPDATE-IND DTSBX332
|
|
00339 DISPLAY 'START DATE ' WRK-START-DATE DTSBX332
|
|
00340 DISPLAY 'END DATE ' WRK-END-DATE DTSBX332
|
|
00341 DISPLAY 'UPDATE ' WRK-PARM-UPDATE-IND DTSBX332
|
|
00342 ELSE DTSBX332
|
|
00343 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX332
|
|
00344 MOVE 'CANNOT READ PARM FILE ' TO ABEND-MSG DTSBX332
|
|
00345 PERFORM S999-ABEND THRU S999-EXIT DTSBX332
|
|
00346 END-IF. DTSBX332
|
|
00347 DTSBX332
|
|
00348 CLOSE BE332-PARM-FILE. DTSBX332
|
|
00349 DTSBX332
|
|
00350 IF WRK-PARM-UPDATE-YES-88 DTSBX332
|
|
00351 PERFORM S910-OPEN-UPDATE THRU S910-EXIT DTSBX332
|
|
00352 PERFORM S921-OPEN-UPDATE THRU S921-EXIT DTSBX332
|
|
00353 ELSE DTSBX332
|
|
00354 PERFORM S910-OPEN-READ THRU S910-EXIT DTSBX332
|
|
00355 PERFORM S921-OPEN-READ THRU S921-EXIT DTSBX332
|
|
00356 END-IF. DTSBX332
|
|
00357 DTSBX332
|
|
00358 * OPEN OUTPUT X332-OUT-FILE. DTSBX332
|
|
00359 * IF NOT X332-OUT-STATUS-OK-88 DTSBX332
|
|
00360 * DISPLAY 'X332 OUT FILE STATUS IS : ' X332-OUT-STATUS DTSBX332
|
|
00361 * MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX332
|
|
00362 * PERFORM S999-ABEND THRU S999-EXIT DTSBX332
|
|
00363 * END-IF. DTSBX332
|
|
00364 DTSBX332
|
|
00365 DTSBX332
|
|
00366 I2000-EXIT. DTSBX332
|
|
00367 EXIT. DTSBX332
|
|
00368 DTSBX332
|
|
00369 I3000-ASSIGN-NBR. DTSBX332
|
|
00370 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBX332
|
|
00371 MOVE +0 TO MHDR-EMP-NO. DTSBX332
|
|
00372 SET MHDR-HDR-88 TO TRUE. DTSBX332
|
|
00373 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX332
|
|
00374 DTSBX332
|
|
00375 PERFORM S910-READ THRU S910-EXIT. DTSBX332
|
|
00376 DTSBX332
|
|
00377 IF L910-NO-REC-88 DTSBX332
|
|
00378 MOVE 'MHDR RECORD NOT FOUND (I0000)' DTSBX332
|
|
00379 TO ABEND-MSG DTSBX332
|
|
00380 PERFORM S999-ABEND THRU S999-EXIT. DTSBX332
|
|
00381 DTSBX332
|
|
00382 MOVE MSKL-REC TO MHDR-REC. DTSBX332
|
|
00383 DTSBX332
|
|
00384 MOVE MHDR-LAST-USED-ASSIGN-NO TO WRK-ASSIGN-NO. DTSBX332
|
|
00385 DTSBX332
|
|
00386 I3000-EXIT. DTSBX332
|
|
00387 EXIT. DTSBX332
|
|
00388 DTSBX332
|
|
00389 P0000-PROCESS. DTSBX332
|
|
00390 READ X332-FILE. DTSBX332
|
|
00391 IF X332-STATUS-EOF-88 DTSBX332
|
|
00392 GO TO P0000-EXIT DTSBX332
|
|
00393 ELSE DTSBX332
|
|
00394 IF NOT X332-STATUS-OK-88 DTSBX332
|
|
00395 DISPLAY 'BAD READ: ' X332-STATUS DTSBX332
|
|
00396 SET X332-STATUS-EOF-88 TO TRUE DTSBX332
|
|
00397 GO TO P0000-EXIT DTSBX332
|
|
00398 END-IF DTSBX332
|
|
00399 END-IF. DTSBX332
|
|
00400 DTSBX332
|
|
00401 IF WRK-EMP-NO = ZERO DTSBX332
|
|
00402 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX332
|
|
00403 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX332
|
|
00404 ELSE DTSBX332
|
|
00405 IF X332-EMP-NO = WRK-EMP-NO DTSBX332
|
|
00406 AND X332-YRQ = WRK-YRQ DTSBX332
|
|
00407 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX332
|
|
00408 ELSE DTSBX332
|
|
00409 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT DTSBX332
|
|
00410 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX332
|
|
00411 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX332
|
|
00412 END-IF DTSBX332
|
|
00413 END-IF. DTSBX332
|
|
00414 DTSBX332
|
|
00415 P0000-EXIT. DTSBX332
|
|
00416 EXIT. DTSBX332
|
|
00417 DTSBX332
|
|
00418 DTSBX332
|
|
00419 P1000-BUILD-QTR-TABLE. DTSBX332
|
|
00420 IF QTR-SUB < QTR-MAX DTSBX332
|
|
00421 ADD +1 TO QTR-SUB DTSBX332
|
|
00422 QTR-LAST DTSBX332
|
|
00423 ELSE DTSBX332
|
|
00424 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX332
|
|
00425 TO ABEND-MSG DTSBX332
|
|
00426 PERFORM S999-ABEND THRU S999-EXIT. DTSBX332
|
|
00427 DTSBX332
|
|
00428 MOVE X332-ESTB-DATE TO QTR-ESTB-DATE (QTR-SUB). DTSBX332
|
|
00429 MOVE X332-BATCH-NO TO QTR-BATCH-NO (QTR-SUB). DTSBX332
|
|
00430 MOVE X332-ITEM-NO TO QTR-ITEM-NO (QTR-SUB). DTSBX332
|
|
00431 MOVE X332-TRAN-TYPE TO QTR-TRAN-TYPE (QTR-SUB). DTSBX332
|
|
00432 MOVE X332-AMT TO QTR-AMT (QTR-SUB). DTSBX332
|
|
00433 DTSBX332
|
|
00434 P1000-EXIT. DTSBX332
|
|
00435 EXIT. DTSBX332
|
|
00436 DTSBX332
|
|
00437 P1300-INIT-TABLES. DTSBX332
|
|
00438 MOVE X332-EMP-NO TO WRK-EMP-NO. DTSBX332
|
|
00439 MOVE X332-PRIMARY-NAME TO WRK-PRIMARY-NAME. DTSBX332
|
|
00440 MOVE X332-FLD-REP-ID TO WRK-FLD-REP-ID. DTSBX332
|
|
00441 MOVE X332-YRQ TO WRK-YRQ. DTSBX332
|
|
00442 DTSBX332
|
|
00443 PERFORM DTSBX332
|
|
00444 VARYING QTR-SUB FROM +1 BY +1 DTSBX332
|
|
00445 UNTIL QTR-SUB > QTR-MAX DTSBX332
|
|
00446 MOVE +0 TO QTR-BATCH-NO (QTR-SUB) DTSBX332
|
|
00447 QTR-ITEM-NO (QTR-SUB) DTSBX332
|
|
00448 QTR-ESTB-DATE (QTR-SUB) DTSBX332
|
|
00449 QTR-AMT (QTR-SUB) DTSBX332
|
|
00450 MOVE SPACES TO QTR-TRAN-TYPE (QTR-SUB) DTSBX332
|
|
00451 SET QTR-FIRST-RCVBL-NO-88 (QTR-SUB) TO TRUE DTSBX332
|
|
00452 END-PERFORM. DTSBX332
|
|
00453 DTSBX332
|
|
00454 MOVE +0 TO QTR-SUB DTSBX332
|
|
00455 QTR-LAST. DTSBX332
|
|
00456 DTSBX332
|
|
00457 P1300-EXIT. DTSBX332
|
|
00458 EXIT. DTSBX332
|
|
00459 DTSBX332
|
|
00460 DTSBX332
|
|
00461 P5000-WRITE-OUTPUT. DTSBX332
|
|
00462 *************************** DTSBX332
|
|
00463 * FOR EACH QUARTER, FIND THE EARLIEST TRANSACTION BETWEEN DTSBX332
|
|
00464 * THE START AND END DATES THAT ESTABLISHED A RECEIVABLE. DTSBX332
|
|
00465 * RECORD THE QUARTER FOR THE REPORT DTSBX332
|
|
00466 *************************** DTSBX332
|
|
00467 SET WRK-RCVBL-FOUND-NO-88 TO TRUE. DTSBX332
|
|
00468 DTSBX332
|
|
00469 MOVE ZERO TO WRK-QTR-BAL DTSBX332
|
|
00470 PREV-QTR-BAL DTSBX332
|
|
00471 WRK-BATCH-NO DTSBX332
|
|
00472 WRK-ITEM-NO. DTSBX332
|
|
00473 MOVE ALL-NINES-DATE TO WRK-ESTB-DATE. DTSBX332
|
|
00474 DTSBX332
|
|
00475 PERFORM DTSBX332
|
|
00476 VARYING QTR-SUB FROM +1 BY +1 DTSBX332
|
|
00477 UNTIL QTR-SUB > QTR-LAST DTSBX332
|
|
00478 MOVE WRK-QTR-BAL TO PREV-QTR-BAL DTSBX332
|
|
00479 ADD QTR-AMT (QTR-SUB) TO WRK-QTR-BAL DTSBX332
|
|
00480 IF WRK-QTR-BAL <= ZERO DTSBX332
|
|
00481 SET WRK-RCVBL-FOUND-NO-88 TO TRUE DTSBX332
|
|
00482 ELSE DTSBX332
|
|
00483 IF QTR-ESTB-DATE (QTR-SUB) >= WRK-START-DATE DTSBX332
|
|
00484 AND QTR-ESTB-DATE (QTR-SUB) <= WRK-END-DATE DTSBX332
|
|
00485 PERFORM P5010-FIND-FIRST-RCVBL THRU P5010-EXIT DTSBX332
|
|
00486 END-IF DTSBX332
|
|
00487 END-IF DTSBX332
|
|
00488 END-PERFORM. DTSBX332
|
|
00489 DTSBX332
|
|
00490 IF WRK-RCVBL-FOUND-NO-88 DTSBX332
|
|
00491 OR WRK-QTR-BAL < +100 DTSBX332
|
|
00492 GO TO P5000-EXIT DTSBX332
|
|
00493 END-IF. DTSBX332
|
|
00494 DTSBX332
|
|
00495 PERFORM P5100-CHK-ASSIGN THRU P5100-EXIT. DTSBX332
|
|
00496 IF WRK-MFAS-FOUND-NO-88 DTSBX332
|
|
00497 PERFORM P5200-WRITE-R332 THRU P5200-EXIT DTSBX332
|
|
00498 PERFORM P5300-ADD-MFAS THRU P5300-EXIT DTSBX332
|
|
00499 END-IF. DTSBX332
|
|
00500 DTSBX332
|
|
00501 P5000-EXIT. DTSBX332
|
|
00502 EXIT. DTSBX332
|
|
00503 DTSBX332
|
|
00504 P5010-FIND-FIRST-RCVBL. DTSBX332
|
|
00505 IF PREV-QTR-BAL <= ZERO DTSBX332
|
|
00506 IF WRK-QTR-BAL > ZERO DTSBX332
|
|
00507 SET WRK-RCVBL-FOUND-YES-88 TO TRUE DTSBX332
|
|
00508 END-IF DTSBX332
|
|
00509 ELSE DTSBX332
|
|
00510 IF WRK-QTR-BAL > PREV-QTR-BAL DTSBX332
|
|
00511 SET WRK-RCVBL-FOUND-YES-88 TO TRUE DTSBX332
|
|
00512 END-IF DTSBX332
|
|
00513 END-IF. DTSBX332
|
|
00514 DTSBX332
|
|
00515 P5010-EXIT. DTSBX332
|
|
00516 EXIT. DTSBX332
|
|
00517 DTSBX332
|
|
00518 P5100-CHK-ASSIGN. DTSBX332
|
|
00519 SET WRK-MFAS-FOUND-NO-88 TO TRUE. DTSBX332
|
|
00520 MOVE LOW-VALUE TO MFAS-REC. DTSBX332
|
|
00521 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSBX332
|
|
00522 SET MFAS-FAS-88 TO TRUE. DTSBX332
|
|
00523 DTSBX332
|
|
00524 MOVE MFAS-REC TO MSKL-REC. DTSBX332
|
|
00525 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX332
|
|
00526 PERFORM DTSBX332
|
|
00527 UNTIL L910-NO-REC-88 DTSBX332
|
|
00528 MOVE MSKL-REC TO MFAS-REC DTSBX332
|
|
00529 IF MFAS-ASSIGN-TYPE = '13' DTSBX332
|
|
00530 IF MFAS-STATUS-ACTIVE-88 DTSBX332
|
|
00531 SET WRK-MFAS-FOUND-YES-88 TO TRUE DTSBX332
|
|
00532 MOVE MFAS-ESTB-DATE TO WRK-MFAS-ESTB-DATE DTSBX332
|
|
00533 END-IF DTSBX332
|
|
00534 END-IF DTSBX332
|
|
00535 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX332
|
|
00536 END-PERFORM. DTSBX332
|
|
00537 DTSBX332
|
|
00538 P5100-EXIT. DTSBX332
|
|
00539 EXIT. DTSBX332
|
|
00540 DTSBX332
|
|
00541 P5200-WRITE-R332. DTSBX332
|
|
00542 MOVE LOW-VALUE TO MSKL-REC. DTSBX332
|
|
00543 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSBX332
|
|
00544 SET MSKL-PRF-88 TO TRUE. DTSBX332
|
|
00545 PERFORM S910-READ THRU S910-EXIT. DTSBX332
|
|
00546 IF L910-NO-REC-88 DTSBX332
|
|
00547 DISPLAY 'CANNOT FIND PROFILE RECORD ' WRK-EMP-NO DTSBX332
|
|
00548 GO TO P5200-EXIT DTSBX332
|
|
00549 ELSE DTSBX332
|
|
00550 MOVE MSKL-REC TO MPRF-REC DTSBX332
|
|
00551 END-IF. DTSBX332
|
|
00552 DTSBX332
|
|
00553 MOVE WRK-EMP-NO TO R332-EMP-NO. DTSBX332
|
|
00554 MOVE WRK-FLD-REP-ID TO R332-FLD-REP-ID. DTSBX332
|
|
00555 MOVE WRK-PRIMARY-NAME TO R332-PRIMARY-NAME. DTSBX332
|
|
00556 MOVE WRK-YRQ TO R332-YRQ. DTSBX332
|
|
00557 MOVE WRK-START-DATE TO R332-START-DATE. DTSBX332
|
|
00558 MOVE WRK-END-DATE TO R332-END-DATE. DTSBX332
|
|
00559 *** MOVE WRK-ESTB-DATE TO R332-ESTB-DATE. DTSBX332
|
|
00560 * MOVE QTR-ESTB-DATE (QTR-SUB) TO R332-ESTB-DATE. DTSBX332
|
|
00561 * MOVE QTR-BATCH-NO (QTR-SUB) TO R332-BATCH-NO. DTSBX332
|
|
00562 * MOVE QTR-ITEM-NO (QTR-SUB) TO R332-ITEM-NO. DTSBX332
|
|
00563 * MOVE QTR-TRAN-TYPE (QTR-SUB) TO R332-TRAN-TYPE. DTSBX332
|
|
00564 MOVE WRK-QTR-BAL TO R332-UI-TAX-BAL. DTSBX332
|
|
00565 COMPUTE R332-UI-TAX-BAL-XOR = DTSBX332
|
|
00566 (WRK-ALL-NINES-BAL - WRK-QTR-BAL). DTSBX332
|
|
00567 DTSBX332
|
|
00568 PERFORM S946-WRITE-R332 THRU S946-EXIT. DTSBX332
|
|
00569 DTSBX332
|
|
00570 ADD +1 TO WRK-R332-CNT. DTSBX332
|
|
00571 DTSBX332
|
|
00572 * MOVE WRK-EMP-NO TO WRK-X332-EMP-NO. DTSBX332
|
|
00573 * MOVE WRK-YRQ TO L004-QTR-5-9. DTSBX332
|
|
00574 * PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX332
|
|
00575 * MOVE L004-SLASH-QTR TO WRK-X332-YRQ. DTSBX332
|
|
00576 * MOVE WRK-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX332
|
|
00577 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX332
|
|
00578 * MOVE L001-SLASH-8-DATE TO WRK-X332-ESTB. DTSBX332
|
|
00579 * MOVE QTR-BATCH-NO (QTR-SUB) TO WRK-X332-BATCH. DTSBX332
|
|
00580 * MOVE QTR-ITEM-NO (QTR-SUB) TO WRK-X332-ITEM. DTSBX332
|
|
00581 * MOVE QTR-TRAN-TYPE (QTR-SUB) TO WRK-X332-TRAN. DTSBX332
|
|
00582 * MOVE WRK-QTR-BAL TO WRK-X332-AMT. DTSBX332
|
|
00583 * DTSBX332
|
|
00584 * WRITE X332-OUT-REC FROM WRK-X332-REC. DTSBX332
|
|
00585 * IF NOT X332-STATUS-OK-88 DTSBX332
|
|
00586 * DISPLAY 'X332 WRITE ERROR : ' X332-STATUS DTSBX332
|
|
00587 * ELSE DTSBX332
|
|
00588 * ADD +1 TO WRK-X332-CNT DTSBX332
|
|
00589 * END-IF. DTSBX332
|
|
00590 * DTSBX332
|
|
00591 * MOVE WRK-QTR-BAL TO DISPLAY-AMT. DTSBX332
|
|
00592 * DISPLAY 'P5200 ' DTSBX332
|
|
00593 * WRK-EMP-NO ' ' WRK-YRQ DTSBX332
|
|
00594 * ' ' WRK-ESTB-DATE DTSBX332
|
|
00595 * ' ' QTR-BATCH-NO (QTR-SUB) DTSBX332
|
|
00596 * ' ' QTR-ITEM-NO (QTR-SUB) DTSBX332
|
|
00597 * ' ' QTR-TRAN-TYPE (QTR-SUB) DTSBX332
|
|
00598 * ' ' DISPLAY-AMT. DTSBX332
|
|
00599 DTSBX332
|
|
00600 P5200-EXIT. DTSBX332
|
|
00601 EXIT. DTSBX332
|
|
00602 DTSBX332
|
|
00603 P5300-ADD-MFAS. DTSBX332
|
|
00604 ***************** DTSBX332
|
|
00605 ** ADD ONLY ONE FIELD ASSIGNMENT, EVEN IF THERE ARE DTSBX332
|
|
00606 ** MULTIPLE RECEIVABLES DTSBX332
|
|
00607 ***************** DTSBX332
|
|
00608 DTSBX332
|
|
00609 IF WRK-PARM-UPDATE-NO-88 DTSBX332
|
|
00610 OR MPRF-EMP-NO = WRK-MFAS-EMP-NO DTSBX332
|
|
00611 GO TO P5300-EXIT DTSBX332
|
|
00612 ELSE DTSBX332
|
|
00613 MOVE MPRF-EMP-NO TO WRK-MFAS-EMP-NO DTSBX332
|
|
00614 END-IF. DTSBX332
|
|
00615 DTSBX332
|
|
00616 MOVE LOW-VALUES TO MFAS-REC. DTSBX332
|
|
00617 DTSBX332
|
|
00618 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBX332
|
|
00619 DTSBX332
|
|
00620 SET MFAS-FAS-88 TO TRUE. DTSBX332
|
|
00621 DTSBX332
|
|
00622 ADD +1 TO WRK-ASSIGN-NO. DTSBX332
|
|
00623 DTSBX332
|
|
00624 MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBX332
|
|
00625 DTSBX332
|
|
00626 MOVE +0 TO MFAS-PURGE-DATE. DTSBX332
|
|
00627 DTSBX332
|
|
00628 SET MFAS-STATUS-ACTIVE-88 TO TRUE. DTSBX332
|
|
00629 DTSBX332
|
|
00630 MOVE WRK-FLD-REP-ID TO MFAS-FLD-REP-ID. DTSBX332
|
|
00631 DTSBX332
|
|
00632 MOVE '13' TO MFAS-ASSIGN-TYPE. DTSBX332
|
|
00633 DTSBX332
|
|
00634 SET MFAS-ATTACHMENTS-NO-88 TO TRUE. DTSBX332
|
|
00635 DTSBX332
|
|
00636 SET MFAS-NON-AUDIT-88 TO TRUE. DTSBX332
|
|
00637 DTSBX332
|
|
00638 SET MFAS-ACCOUNTING-DESK-NO-88 TO TRUE. DTSBX332
|
|
00639 DTSBX332
|
|
00640 MOVE MHDR-CURR-MAIL-DATE TO MFAS-START-DATE. DTSBX332
|
|
00641 DTSBX332
|
|
00642 MOVE +0 TO MFAS-DUE-DATE DTSBX332
|
|
00643 MFAS-COMPLETED-DATE DTSBX332
|
|
00644 MFAS-PROCESSED-DATE DTSBX332
|
|
00645 MFAS-TAX-DOWNLOAD-DATE DTSBX332
|
|
00646 MFAS-WAGE-DOWNLOAD-DATE. DTSBX332
|
|
00647 DTSBX332
|
|
00648 MOVE 'SYSTEM' TO MFAS-SOURCE-OP-ID. DTSBX332
|
|
00649 DTSBX332
|
|
00650 MOVE ZERO TO MFAS-CLAIMANT-SSN. DTSBX332
|
|
00651 DTSBX332
|
|
00652 MOVE SPACES TO MFAS-CLAIMANT-NAME. DTSBX332
|
|
00653 DTSBX332
|
|
00654 MOVE ZERO TO MFAS-RELATED-EMP-NO. DTSBX332
|
|
00655 DTSBX332
|
|
00656 MOVE +0 TO MFAS-START-YRQ DTSBX332
|
|
00657 MFAS-END-YRQ. DTSBX332
|
|
00658 DTSBX332
|
|
00659 MOVE MPRF-SIC-CD TO MFAS-SIC-CD. DTSBX332
|
|
00660 DTSBX332
|
|
00661 MOVE MPRF-NAICS-CD TO MFAS-NAICS-CD. DTSBX332
|
|
00662 DTSBX332
|
|
00663 MOVE MPRF-OWN-CD TO MFAS-OWN-CD. DTSBX332
|
|
00664 DTSBX332
|
|
00665 SET MFAS-EMP-NON-AUDIT-88 TO TRUE. DTSBX332
|
|
00666 DTSBX332
|
|
00667 MOVE +0 TO MFAS-SEL-CNT. DTSBX332
|
|
00668 DTSBX332
|
|
00669 SET MFAS-NOT-CONVERTED-88 TO TRUE. DTSBX332
|
|
00670 DTSBX332
|
|
00671 MOVE MHDR-PRIOR-RUN-DATE TO MFAS-ESTB-DATE DTSBX332
|
|
00672 MFAS-CHNG-DATE. DTSBX332
|
|
00673 DTSBX332
|
|
00674 MOVE +1 TO MFAS-TEXT-CNT. DTSBX332
|
|
00675 DTSBX332
|
|
00676 MOVE DTSBX332
|
|
00677 'FIELD ASSIGN CREATED: RECEIVABLE OVER 120 DAYS OLD' DTSBX332
|
|
00678 TO MFAS-TEXT (1). DTSBX332
|
|
00679 DTSBX332
|
|
00680 MOVE MFAS-REC TO MSKL-REC. DTSBX332
|
|
00681 DTSBX332
|
|
00682 PERFORM S910-WRITE THRU S910-EXIT. DTSBX332
|
|
00683 DTSBX332
|
|
00684 SET MPRF-MFAS-EXISTS-88 TO TRUE. DTSBX332
|
|
00685 DTSBX332
|
|
00686 PERFORM P5310-WRITE-MEVL THRU P5310-EXIT. DTSBX332
|
|
00687 DTSBX332
|
|
00688 PERFORM P5320-UPDATE-MPRF THRU P5320-EXIT. DTSBX332
|
|
00689 DTSBX332
|
|
00690 P5300-EXIT. DTSBX332
|
|
00691 EXIT. DTSBX332
|
|
00692 DTSBX332
|
|
00693 P5310-WRITE-MEVL. DTSBX332
|
|
00694 MOVE LOW-VALUE TO MEVL-REC. DTSBX332
|
|
00695 DTSBX332
|
|
00696 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBX332
|
|
00697 DTSBX332
|
|
00698 SET MEVL-EVL-88 TO TRUE. DTSBX332
|
|
00699 DTSBX332
|
|
00700 ADD +1000 TO WRK-ABSTIME. DTSBX332
|
|
00701 DTSBX332
|
|
00702 MOVE WRK-ABSTIME TO L005-ABSTIME. DTSBX332
|
|
00703 DTSBX332
|
|
00704 SET L005-FROM-ABSTIME TO TRUE. DTSBX332
|
|
00705 DTSBX332
|
|
00706 PERFORM S005-CONVERT-TIME THRU S005-EXIT. DTSBX332
|
|
00707 DTSBX332
|
|
00708 MOVE L005-DATE TO MEVL-DATE. DTSBX332
|
|
00709 DTSBX332
|
|
00710 MOVE L005-TIME TO MEVL-TIME. DTSBX332
|
|
00711 DTSBX332
|
|
00712 MOVE +0 TO MEVL-PURGE-DATE. DTSBX332
|
|
00713 DTSBX332
|
|
00714 MOVE WRK-EVENT-TXT TO MEVL-TEXT. DTSBX332
|
|
00715 DTSBX332
|
|
00716 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBX332
|
|
00717 DTSBX332
|
|
00718 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBX332
|
|
00719 DTSBX332
|
|
00720 MOVE MHDR-PRIOR-RUN-DATE TO MEVL-ESTB-DATE DTSBX332
|
|
00721 MEVL-CHNG-DATE. DTSBX332
|
|
00722 DTSBX332
|
|
00723 MOVE MEVL-REC TO MSKL-REC. DTSBX332
|
|
00724 DTSBX332
|
|
00725 PERFORM S910-WRITE THRU S910-EXIT. DTSBX332
|
|
00726 DTSBX332
|
|
00727 P5310-EXIT. DTSBX332
|
|
00728 EXIT. DTSBX332
|
|
00729 DTSBX332
|
|
00730 P5320-UPDATE-MPRF. DTSBX332
|
|
00731 MOVE MPRF-REC TO MSKL-REC. DTSBX332
|
|
00732 DTSBX332
|
|
00733 PERFORM S910-REWRITE THRU S910-EXIT. DTSBX332
|
|
00734 DTSBX332
|
|
00735 P5320-EXIT. DTSBX332
|
|
00736 EXIT. DTSBX332
|
|
00737 DTSBX332
|
|
00738 T0000-TERMINATE. DTSBX332
|
|
00739 IF WRK-PARM-UPDATE-YES-88 DTSBX332
|
|
00740 PERFORM T1000-UPDATE-HDR THRU T1000-EXIT DTSBX332
|
|
00741 END-IF. DTSBX332
|
|
00742 DTSBX332
|
|
00743 CLOSE X332-FILE. DTSBX332
|
|
00744 *** CLOSE X332-OUT-FILE. DTSBX332
|
|
00745 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX332
|
|
00746 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX332
|
|
00747 DTSBX332
|
|
00748 DISPLAY ' '. DTSBX332
|
|
00749 DTSBX332
|
|
00750 DISPLAY '*** DTSBX332 TERMINATION STATISTICS ***'. DTSBX332
|
|
00751 DTSBX332
|
|
00752 DISPLAY ' '. DTSBX332
|
|
00753 MOVE WRK-R332-CNT TO DISPLAY-CNT. DTSBX332
|
|
00754 DISPLAY 'R332 RECORDS WRITTEN : ' DTSBX332
|
|
00755 DISPLAY-CNT. DTSBX332
|
|
00756 * MOVE WRK-X332-CNT TO DISPLAY-CNT. DTSBX332
|
|
00757 * DISPLAY 'X332 RECORDS WRITTEN : ' DTSBX332
|
|
00758 * DISPLAY-CNT. DTSBX332
|
|
00759 DTSBX332
|
|
00760 MOVE LOW-VALUES TO R332-REC. DTSBX332
|
|
00761 MOVE -1 TO R332-LENGTH. DTSBX332
|
|
00762 DTSBX332
|
|
00763 PERFORM S946-WRITE-R332 THRU S946-EXIT. DTSBX332
|
|
00764 DTSBX332
|
|
00765 T0000-EXIT. DTSBX332
|
|
00766 EXIT. DTSBX332
|
|
00767 DTSBX332
|
|
00768 T1000-UPDATE-HDR. DTSBX332
|
|
00769 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBX332
|
|
00770 MOVE +0 TO MHDR-EMP-NO. DTSBX332
|
|
00771 SET MHDR-HDR-88 TO TRUE. DTSBX332
|
|
00772 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX332
|
|
00773 DTSBX332
|
|
00774 PERFORM S910-READ THRU S910-EXIT. DTSBX332
|
|
00775 DTSBX332
|
|
00776 IF L910-NO-REC-88 DTSBX332
|
|
00777 MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSBX332
|
|
00778 TO ABEND-MSG DTSBX332
|
|
00779 PERFORM S999-ABEND THRU S999-EXIT. DTSBX332
|
|
00780 DTSBX332
|
|
00781 MOVE MSKL-REC TO MHDR-REC. DTSBX332
|
|
00782 DTSBX332
|
|
00783 MOVE WRK-ASSIGN-NO TO MHDR-LAST-USED-ASSIGN-NO. DTSBX332
|
|
00784 DTSBX332
|
|
00785 MOVE MHDR-PRIOR-RUN-DATE TO MHDR-CHNG-DATE. DTSBX332
|
|
00786 DTSBX332
|
|
00787 MOVE MHDR-REC TO MSKL-REC. DTSBX332
|
|
00788 DTSBX332
|
|
00789 PERFORM S910-REWRITE THRU S910-EXIT. DTSBX332
|
|
00790 DTSBX332
|
|
00791 T1000-EXIT. DTSBX332
|
|
00792 EXIT. DTSBX332
|
|
00793 DTSBX332
|
|
00794 S001-FROM-FED-8. DTSBX332
|
|
00795 SET L001-FROM-FED-8 TO TRUE. DTSBX332
|
|
00796 GO TO S001-DATE. DTSBX332
|
|
00797 DTSBX332
|
|
00798 S001-FROM-ABS-DAY. DTSBX332
|
|
00799 SET L001-FROM-ABS-DAY TO TRUE. DTSBX332
|
|
00800 GO TO S001-DATE. DTSBX332
|
|
00801 DTSBX332
|
|
00802 S001-FROM-CAL-6. DTSBX332
|
|
00803 SET L001-FROM-CAL-6 TO TRUE. DTSBX332
|
|
00804 GO TO S001-DATE. DTSBX332
|
|
00805 DTSBX332
|
|
00806 S001-DATE. DTSBX332
|
|
00807 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX332
|
|
00808 S001-EXIT. DTSBX332
|
|
00809 EXIT. DTSBX332
|
|
00810 SKIP3 DTSBX332
|
|
00811 S004-FROM-5. DTSBX332
|
|
00812 SET L004-FROM-5 TO TRUE. DTSBX332
|
|
00813 GO TO S004-QTR. DTSBX332
|
|
00814 DTSBX332
|
|
00815 S004-FROM-ABS. DTSBX332
|
|
00816 SET L004-FROM-ABS TO TRUE. DTSBX332
|
|
00817 GO TO S004-QTR. DTSBX332
|
|
00818 DTSBX332
|
|
00819 S004-FROM-3. DTSBX332
|
|
00820 SET L004-FROM-3 TO TRUE. DTSBX332
|
|
00821 GO TO S004-QTR. DTSBX332
|
|
00822 DTSBX332
|
|
00823 S004-FROM-DATE. DTSBX332
|
|
00824 SET L004-FROM-DATE TO TRUE. DTSBX332
|
|
00825 GO TO S004-QTR. DTSBX332
|
|
00826 DTSBX332
|
|
00827 S004-QTR. DTSBX332
|
|
00828 DTSBX332
|
|
00829 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX332
|
|
00830 DTSBX332
|
|
00831 S004-EXIT. DTSBX332
|
|
00832 EXIT. DTSBX332
|
|
00833 SKIP3 DTSBX332
|
|
00834 DTSBX332
|
|
00835 S005-CONVERT-TIME. DTSBX332
|
|
00836 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX332
|
|
00837 S005-EXIT. EXIT. DTSBX332
|
|
00838 DTSBX332
|
|
00839 S910-OPEN-UPDATE. DTSBX332
|
|
00840 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX332
|
|
00841 GO TO S910-MSTR-IO. DTSBX332
|
|
00842 DTSBX332
|
|
00843 S910-OPEN-READ. DTSBX332
|
|
00844 SET L910-OPEN-READ-88 TO TRUE. DTSBX332
|
|
00845 GO TO S910-MSTR-IO. DTSBX332
|
|
00846 DTSBX332
|
|
00847 S910-READ. DTSBX332
|
|
00848 SET L910-READ-88 TO TRUE. DTSBX332
|
|
00849 GO TO S910-MSTR-IO. DTSBX332
|
|
00850 DTSBX332
|
|
00851 S910-START-BROWSE. DTSBX332
|
|
00852 SET L910-START-BROWSE-88 TO TRUE. DTSBX332
|
|
00853 GO TO S910-MSTR-IO. DTSBX332
|
|
00854 DTSBX332
|
|
00855 S910-READ-NEXT. DTSBX332
|
|
00856 SET L910-READ-NEXT-88 TO TRUE. DTSBX332
|
|
00857 GO TO S910-MSTR-IO. DTSBX332
|
|
00858 DTSBX332
|
|
00859 S910-WRITE. DTSBX332
|
|
00860 SET L910-WRITE-88 TO TRUE. DTSBX332
|
|
00861 GO TO S910-MSTR-IO. DTSBX332
|
|
00862 DTSBX332
|
|
00863 S910-REWRITE. DTSBX332
|
|
00864 SET L910-REWRITE-88 TO TRUE. DTSBX332
|
|
00865 GO TO S910-MSTR-IO. DTSBX332
|
|
00866 DTSBX332
|
|
00867 S910-CLOSE. DTSBX332
|
|
00868 SET L910-CLOSE-88 TO TRUE. DTSBX332
|
|
00869 GO TO S910-MSTR-IO. DTSBX332
|
|
00870 DTSBX332
|
|
00871 S910-MSTR-IO. DTSBX332
|
|
00872 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX332
|
|
00873 MSKL-REC. DTSBX332
|
|
00874 S910-EXIT. DTSBX332
|
|
00875 EXIT. DTSBX332
|
|
00876 DTSBX332
|
|
00877 S921-OPEN-READ. DTSBX332
|
|
00878 SET L921-OPEN-READ-88 TO TRUE. DTSBX332
|
|
00879 GO TO S921-AIX-IO. DTSBX332
|
|
00880 DTSBX332
|
|
00881 S921-OPEN-UPDATE. DTSBX332
|
|
00882 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX332
|
|
00883 GO TO S921-AIX-IO. DTSBX332
|
|
00884 DTSBX332
|
|
00885 S921-CLOSE. DTSBX332
|
|
00886 SET L921-CLOSE-88 TO TRUE. DTSBX332
|
|
00887 GO TO S921-AIX-IO. DTSBX332
|
|
00888 DTSBX332
|
|
00889 S921-AIX-IO. DTSBX332
|
|
00890 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX332
|
|
00891 ISKL-REC. DTSBX332
|
|
00892 S921-EXIT. DTSBX332
|
|
00893 EXIT. DTSBX332
|
|
00894 DTSBX332
|
|
00895 S946-WRITE-R332. DTSBX332
|
|
00896 CALL 'DTSBU946' USING R332-REC. DTSBX332
|
|
00897 DTSBX332
|
|
00898 S946-EXIT. DTSBX332
|
|
00899 EXIT. DTSBX332
|
|
00900 SKIP3 DTSBX332
|
|
00901 S999-ABEND. DTSBX332
|
|
00902 DISPLAY '*** DTSBE774 ABENDING. ' DTSBX332
|
|
00903 ABEND-MSG. DTSBX332
|
|
00904 DTSBX332
|
|
00905 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX332
|
|
00906 S999-EXIT. DTSBX332
|
|
00907 EXIT. DTSBX332
|