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