843 lines
67 KiB
COBOL
843 lines
67 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/31/05
|
|
00002 PROGRAM-ID. DTSBX331. DTSBX331
|
|
00003 AUTHOR. TRW. LV001
|
|
00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX331
|
|
00005 DATE-COMPILED. DTSBX331
|
|
00006 SKIP3 DTSBX331
|
|
00007 ***** DTSBX331
|
|
00008 * DTSBX331
|
|
00009 * FUNCTION: BUILD COMMA-DELIMITED FILE FOR DOWNLOAD TO DTSBX331
|
|
00010 * SQL SERVER DATABASE FOR CREDIT/DEBIT WEB DTSBX331
|
|
00011 * APPLICATION. DTSBX331
|
|
00012 * READS DATA FILE OUTPUT BY DTSBE331. DTSBX331
|
|
00013 * DTSBX331
|
|
00014 * MODIFICATION LOG: DTSBX331
|
|
00015 * DTSBX331
|
|
00016 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX331
|
|
00017 * REFERENCE: PROGRAMMER: GD DTSBX331
|
|
00018 * DTSBX331
|
|
00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX331
|
|
00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX331
|
|
00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX331
|
|
00022 * DTSBX331
|
|
00023 * DTSBX331
|
|
00024 * DESCRIPTION: DTSBX331
|
|
00025 * DTSBX331
|
|
00026 * DTSBX331
|
|
00027 * INITIATION: DTSBX331
|
|
00028 * DTSBX331
|
|
00029 * OPEN DTSX774 DTSBX331
|
|
00030 * DTSBX331
|
|
00031 * DTSBX331
|
|
00032 * DTSBX331
|
|
00033 * PROCESSING: DTSBX331
|
|
00034 * DTSBX331
|
|
00035 * BUILD X774 OUTPUT RECORDS FROM DTSIY774 INPUT. DTSBX331
|
|
00036 * DTSBX331
|
|
00037 * DTSBX331
|
|
00038 * TERMINATION: DTSBX331
|
|
00039 * DTSBX331
|
|
00040 * CLOSE DTSX774 DTSBX331
|
|
00041 * DTSBX331
|
|
00042 * RECORDS READ: DTSBX331
|
|
00043 * DTSBX331
|
|
00044 * MASTER: DTSBX331
|
|
00045 * DTSBX331
|
|
00046 * NONE DTSBX331
|
|
00047 * DTSBX331
|
|
00048 * ALTERNATE INDEX: DTSBX331
|
|
00049 * DTSBX331
|
|
00050 * NONE. DTSBX331
|
|
00051 * DTSBX331
|
|
00052 * DTSBX331
|
|
00053 * REFERENCE: DTSBX331
|
|
00054 * DTSBX331
|
|
00055 * DTSBX331
|
|
00056 * DTSBX331
|
|
00057 * RECORDS UPDATED: DTSBX331
|
|
00058 * DTSBX331
|
|
00059 * NONE DTSBX331
|
|
00060 * DTSBX331
|
|
00061 * DTSBX331
|
|
00062 * OUTPUT RECORDS WRITTEN: DTSBX331
|
|
00063 * DTSBX331
|
|
00064 * DTSBX331
|
|
00065 * DTSBX331
|
|
00066 * DTSBX331
|
|
00067 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX331
|
|
00068 * DTSBX331
|
|
00069 * NONE. DTSBX331
|
|
00070 * DTSBX331
|
|
00071 * DTSBX331
|
|
00072 * MODULES CALLED: DTSBX331
|
|
00073 * DTSBX331
|
|
00074 * DTSBU001 DATE EDIT/CONVERSION. DTSBX331
|
|
00075 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX331
|
|
00076 * DTSBX331
|
|
00077 * DTSBX331
|
|
00078 * DTSBX331
|
|
00079 ***** DTSBX331
|
|
00080 SKIP3 DTSBX331
|
|
00081 ENVIRONMENT DIVISION. DTSBX331
|
|
00082 INPUT-OUTPUT SECTION. DTSBX331
|
|
00083 FILE-CONTROL. DTSBX331
|
|
00084 SELECT X331-FILE ASSIGN TO DTSX331 DTSBX331
|
|
00085 FILE STATUS IS X331-STATUS. DTSBX331
|
|
00086 DTSBX331
|
|
00087 SELECT X331A-SUMMARY ASSIGN TO DTSX331A DTSBX331
|
|
00088 FILE STATUS IS X331A-STATUS. DTSBX331
|
|
00089 DTSBX331
|
|
00090 SELECT X331B-DETAIL ASSIGN TO DTSX331B DTSBX331
|
|
00091 FILE STATUS IS X331B-STATUS. DTSBX331
|
|
00092 DTSBX331
|
|
00093 SELECT X331C-TRAN ASSIGN TO DTSX331C DTSBX331
|
|
00094 FILE STATUS IS X331C-STATUS. DTSBX331
|
|
00095 DTSBX331
|
|
00096 SELECT BE330-PARM-FILE ASSIGN TO BE330PRM DTSBX331
|
|
00097 FILE STATUS IS PARM-STATUS. DTSBX331
|
|
00098 EJECT DTSBX331
|
|
00099 DATA DIVISION. DTSBX331
|
|
00100 FILE SECTION. DTSBX331
|
|
00101 FD X331-FILE DTSBX331
|
|
00102 RECORDING MODE IS F DTSBX331
|
|
00103 LABEL RECORDS ARE STANDARD DTSBX331
|
|
00104 BLOCK CONTAINS 0 RECORDS. DTSBX331
|
|
00105 01 X331-REC. DTSBX331
|
|
00106 ++INCLUDE DTSIX331 DTSBX331
|
|
00107 DTSBX331
|
|
00108 FD X331A-SUMMARY DTSBX331
|
|
00109 RECORDING MODE IS F DTSBX331
|
|
00110 LABEL RECORDS ARE STANDARD DTSBX331
|
|
00111 BLOCK CONTAINS 0 RECORDS. DTSBX331
|
|
00112 01 X331A-REC PIC X(68). DTSBX331
|
|
00113 DTSBX331
|
|
00114 FD X331B-DETAIL DTSBX331
|
|
00115 RECORDING MODE IS F DTSBX331
|
|
00116 LABEL RECORDS ARE STANDARD DTSBX331
|
|
00117 BLOCK CONTAINS 0 RECORDS. DTSBX331
|
|
00118 01 X331B-REC PIC X(56). DTSBX331
|
|
00119 DTSBX331
|
|
00120 FD X331C-TRAN DTSBX331
|
|
00121 RECORDING MODE IS F DTSBX331
|
|
00122 LABEL RECORDS ARE STANDARD DTSBX331
|
|
00123 BLOCK CONTAINS 0 RECORDS. DTSBX331
|
|
00124 01 X331C-REC PIC X(71). DTSBX331
|
|
00125 DTSBX331
|
|
00126 FD BE330-PARM-FILE DTSBX331
|
|
00127 RECORDING MODE IS F DTSBX331
|
|
00128 LABEL RECORDS ARE STANDARD DTSBX331
|
|
00129 BLOCK CONTAINS 0 CHARACTERS. DTSBX331
|
|
00130 DTSBX331
|
|
00131 01 BE330-PARM-REC PIC S9(09) COMP-3. DTSBX331
|
|
00132 DTSBX331
|
|
00133 WORKING-STORAGE SECTION. DTSBX331
|
|
001335 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX331 08/31/05'. DTSBX331
|
|
00134 SKIP3 DTSBX331
|
|
00135 01 WRK-AREA. DTSBX331
|
|
00136 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +330.DTSBX331
|
|
00137 DTSBX331
|
|
00138 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX331'.DTSBX331
|
|
00139 DTSBX331
|
|
00140 05 ABEND-MSG PIC X(60). DTSBX331
|
|
00141 DTSBX331
|
|
00142 05 X331-STATUS PIC X(02) VALUE SPACES. DTSBX331
|
|
00143 88 X331-STATUS-OK-88 VALUE ZEROS. DTSBX331
|
|
00144 88 X331-STATUS-EOF-88 VALUE '10'. DTSBX331
|
|
00145 DTSBX331
|
|
00146 05 X331A-STATUS PIC X(02) VALUE SPACES. DTSBX331
|
|
00147 88 X331A-STATUS-OK-88 VALUE ZEROS. DTSBX331
|
|
00148 88 X331A-STATUS-EOF-88 VALUE '10'. DTSBX331
|
|
00149 DTSBX331
|
|
00150 05 X331B-STATUS PIC X(02) VALUE SPACES. DTSBX331
|
|
00151 88 X331B-STATUS-OK-88 VALUE ZEROS. DTSBX331
|
|
00152 88 X331B-STATUS-EOF-88 VALUE '10'. DTSBX331
|
|
00153 DTSBX331
|
|
00154 05 X331C-STATUS PIC X(02) VALUE SPACES. DTSBX331
|
|
00155 88 X331C-STATUS-OK-88 VALUE ZEROS. DTSBX331
|
|
00156 88 X331C-STATUS-EOF-88 VALUE '10'. DTSBX331
|
|
00157 DTSBX331
|
|
00158 05 PARM-STATUS PIC X(02) VALUE SPACES. DTSBX331
|
|
00159 88 PARM-STATUS-OK-88 VALUE ZEROS. DTSBX331
|
|
00160 88 PARM-STATUS-EOF-88 VALUE '10'. DTSBX331
|
|
00161 DTSBX331
|
|
00162 05 WRK-RPT-FOUND-IND PIC X(01). DTSBX331
|
|
00163 88 WRK-RPT-FOUND-YES-88 VALUE 'Y'. DTSBX331
|
|
00164 88 WRK-RPT-FOUND-NO-88 VALUE 'N'. DTSBX331
|
|
00165 DTSBX331
|
|
00166 05 WRK-SUBJECT-DATE PIC S9(09) COMP-3 DTSBX331
|
|
00167 VALUE +0. DTSBX331
|
|
00168 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSBX331
|
|
00169 VALUE +0. DTSBX331
|
|
00170 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX331
|
|
00171 VALUE +0. DTSBX331
|
|
00172 05 WRK-EMP-CLASS PIC X(01). DTSBX331
|
|
00173 05 WRK-TRAN-CAT PIC X(01). DTSBX331
|
|
00174 05 WRK-RATE PIC S99V9 COMP-3. DTSBX331
|
|
00175 05 WRK-TRAN-TYPE PIC X(02). DTSBX331
|
|
00176 DTSBX331
|
|
00177 05 WRK-QTR-BAL PIC S9(11)V99 COMP-3 DTSBX331
|
|
00178 VALUE +0. DTSBX331
|
|
00179 DTSBX331
|
|
00180 ******************************************************************DTSBX331
|
|
00181 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE DTSBX331
|
|
00182 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED DTSBX331
|
|
00183 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER DTSBX331
|
|
00184 * FIELDS ARE CALCULATED. THE START BALANCE IS THE RECEIVABLE DTSBX331
|
|
00185 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS. DTSBX331
|
|
00186 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING DTSBX331
|
|
00187 * ANY REPORT QUARTER LIQUIDATIONS. DTSBX331
|
|
00188 ******************************************************************DTSBX331
|
|
00189 05 QTR-SUB PIC S9(04) COMP VALUE +0. DTSBX331
|
|
00190 05 QTR-LAST PIC S9(04) COMP VALUE +0. DTSBX331
|
|
00191 05 QTR-MAX PIC S9(04) COMP VALUE +200. DTSBX331
|
|
00192 05 QTR-TABLE OCCURS 200 TIMES. DTSBX331
|
|
00193 10 QTR-BATCH-NO PIC S9(05) COMP-3. DTSBX331
|
|
00194 10 QTR-ITEM-NO PIC S9(03) COMP-3. DTSBX331
|
|
00195 10 QTR-TRAN-TYPE PIC X(02). DTSBX331
|
|
00196 10 QTR-AMT PIC S9(09)V99 COMP-3. DTSBX331
|
|
00197 10 QTR-ESTB-DATE PIC S9(09) COMP-3. DTSBX331
|
|
00198 DTSBX331
|
|
00199 05 WRK-SEQ-A PIC S9(05) COMP-3 VALUE +0. DTSBX331
|
|
00200 05 WRK-SEQ-B PIC S9(05) COMP-3 VALUE +0. DTSBX331
|
|
00201 05 WRK-SEQ-C PIC S9(05) COMP-3 VALUE +0. DTSBX331
|
|
00202 05 WRK-BATCH-NO PIC S9(05) COMP-3. DTSBX331
|
|
00203 05 WRK-ITEM-NO PIC S9(03) COMP-3. DTSBX331
|
|
00204 DTSBX331
|
|
00205 05 WRK-X331A-CNT PIC S9(07) COMP-3 DTSBX331
|
|
00206 VALUE +0. DTSBX331
|
|
00207 05 WRK-X331B-CNT PIC S9(07) COMP-3 DTSBX331
|
|
00208 VALUE +0. DTSBX331
|
|
00209 05 WRK-X331C-CNT PIC S9(07) COMP-3 DTSBX331
|
|
00210 VALUE +0. DTSBX331
|
|
00211 DTSBX331
|
|
00212 05 WRK-X331A-REC. DTSBX331
|
|
00213 10 X331A-SEQ PIC 9(06). DTSBX331
|
|
00214 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00215 10 X331A-ESTB-DATE PIC X(10). DTSBX331
|
|
00216 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00217 10 X331A-CREDIT-DEBIT PIC X(06). DTSBX331
|
|
00218 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00219 10 X331A-EMP-NO PIC 9(06). DTSBX331
|
|
00220 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00221 10 X331A-BATCH PIC 9(05). DTSBX331
|
|
00222 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00223 10 X331A-ITEM PIC 9(03). DTSBX331
|
|
00224 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00225 10 X331A-TRAN PIC X(02). DTSBX331
|
|
00226 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00227 10 X331A-AMT PIC --------9.99. DTSBX331
|
|
00228 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00229 10 X331A-YRQ PIC X(06). DTSBX331
|
|
00230 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00231 10 X331A-CAT PIC X(01). DTSBX331
|
|
00232 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00233 10 X331A-EMP-CLASS PIC X(01). DTSBX331
|
|
00234 DTSBX331
|
|
00235 05 WRK-X331B-REC. DTSBX331
|
|
00236 10 X331B-SEQ PIC 9(06). DTSBX331
|
|
00237 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00238 10 X331B-YRQ PIC X(06). DTSBX331
|
|
00239 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00240 10 X331B-BATCH PIC 9(05). DTSBX331
|
|
00241 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00242 10 X331B-ITEM PIC 9(03). DTSBX331
|
|
00243 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00244 10 X331B-EMP-NO PIC 9(06). DTSBX331
|
|
00245 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00246 10 X331B-EMP-CLASS PIC X(01). DTSBX331
|
|
00247 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00248 10 X331B-TRAN PIC X(02). DTSBX331
|
|
00249 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00250 10 X331B-ROW PIC X(02). DTSBX331
|
|
00251 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00252 10 X331B-COL PIC X(02). DTSBX331
|
|
00253 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00254 10 X331B-AMT PIC --------9.99. DTSBX331
|
|
00255 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00256 10 X331B-CAT PIC X(01). DTSBX331
|
|
00257 DTSBX331
|
|
00258 05 WRK-X331C-REC. DTSBX331
|
|
00259 10 X331C-SEQ PIC 9(06). DTSBX331
|
|
00260 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00261 10 X331C-BATCH PIC 9(05). DTSBX331
|
|
00262 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00263 10 X331C-ITEM PIC 9(03). DTSBX331
|
|
00264 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00265 10 X331C-TRANS PIC X(02). DTSBX331
|
|
00266 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00267 10 X331C-EMP-NO PIC 9(06). DTSBX331
|
|
00268 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00269 10 X331C-YRQ PIC X(06). DTSBX331
|
|
00270 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00271 10 X331C-AMT PIC --------9.99. DTSBX331
|
|
00272 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00273 10 X331C-TAX-WAGE PIC --------9.99. DTSBX331
|
|
00274 10 X331C-TAX-WAGE-X REDEFINES X331C-TAX-WAGE DTSBX331
|
|
00275 PIC X(12). DTSBX331
|
|
00276 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00277 10 X331C-RATE PIC Z9.9. DTSBX331
|
|
00278 10 X331C-RATE-X REDEFINES X331C-RATE DTSBX331
|
|
00279 PIC X(04). DTSBX331
|
|
00280 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00281 10 X331C-ACCT PIC X(02). DTSBX331
|
|
00282 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00283 10 X331C-EMP-CLASS PIC X(01). DTSBX331
|
|
00284 10 FILLER PIC X(01) VALUE ','. DTSBX331
|
|
00285 10 X331C-CAT PIC X(01). DTSBX331
|
|
00286 DTSBX331
|
|
00287 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBX331
|
|
00288 VALUE +010169. DTSBX331
|
|
00289 DTSBX331
|
|
00290 05 DISPLAY-CNT PIC Z(06)9. DTSBX331
|
|
00291 05 DISPLAY-AMT-X PIC X(15). DTSBX331
|
|
00292 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX331
|
|
00293 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX331
|
|
00294 05 DISPLAY-AMT1-X PIC X(15). DTSBX331
|
|
00295 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX331
|
|
00296 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX331
|
|
00297 EJECT DTSBX331
|
|
00298 01 L001-LINK-AREA. DTSBX331
|
|
00299 ++INCLUDE DTSIL001 DTSBX331
|
|
00300 DTSBX331
|
|
00301 01 L004-LINK-AREA. DTSBX331
|
|
00302 ++INCLUDE DTSIL004 DTSBX331
|
|
00303 DTSBX331
|
|
00304 01 L910-LINK-AREA. DTSBX331
|
|
00305 ++INCLUDE DTSIL910 DTSBX331
|
|
00306 SKIP3 DTSBX331
|
|
00307 01 MSKL-REC. DTSBX331
|
|
00308 ++INCLUDE DTSIMSKL DTSBX331
|
|
00309 SKIP3 DTSBX331
|
|
00310 01 MJRN-REC. DTSBX331
|
|
00311 ++INCLUDE DTSIMJRN DTSBX331
|
|
00312 DTSBX331
|
|
00313 01 MRPT-REC. DTSBX331
|
|
00314 ++INCLUDE DTSIMRPT DTSBX331
|
|
00315 DTSBX331
|
|
00316 01 MPAY-REC. DTSBX331
|
|
00317 ++INCLUDE DTSIMPAY DTSBX331
|
|
00318 DTSBX331
|
|
00319 01 MADJ-REC. DTSBX331
|
|
00320 ++INCLUDE DTSIMADJ DTSBX331
|
|
00321 DTSBX331
|
|
00322 PROCEDURE DIVISION. DTSBX331
|
|
00323 DTSBX331
|
|
00324 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBX331
|
|
00325 DTSBX331
|
|
00326 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX331
|
|
00327 UNTIL X331-STATUS-EOF-88. DTSBX331
|
|
00328 DTSBX331
|
|
00329 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX331
|
|
00330 SKIP2 DTSBX331
|
|
00331 GOBACK. DTSBX331
|
|
00332 EJECT DTSBX331
|
|
00333 I0000-INITIALIZE. DTSBX331
|
|
00334 MOVE +0 TO QTR-SUB. DTSBX331
|
|
00335 DTSBX331
|
|
00336 OPEN INPUT X331-FILE DTSBX331
|
|
00337 IF NOT X331-STATUS-OK-88 DTSBX331
|
|
00338 DISPLAY 'X331 FILE STATUS IS : ' X331-STATUS DTSBX331
|
|
00339 MOVE 'CANNOT OPEN INPUT FILE ' TO ABEND-MSG DTSBX331
|
|
00340 PERFORM S999-ABEND THRU S999-EXIT DTSBX331
|
|
00341 END-IF. DTSBX331
|
|
00342 DTSBX331
|
|
00343 OPEN OUTPUT X331A-SUMMARY DTSBX331
|
|
00344 IF NOT X331A-STATUS-OK-88 DTSBX331
|
|
00345 DISPLAY 'X331A FILE STATUS IS : ' X331A-STATUS DTSBX331
|
|
00346 MOVE 'CANNOT OPEN X331A SUMMARY FILE ' TO ABEND-MSG DTSBX331
|
|
00347 PERFORM S999-ABEND THRU S999-EXIT DTSBX331
|
|
00348 END-IF. DTSBX331
|
|
00349 DTSBX331
|
|
00350 OPEN OUTPUT X331B-DETAIL DTSBX331
|
|
00351 IF NOT X331B-STATUS-OK-88 DTSBX331
|
|
00352 DISPLAY 'X331B FILE STATUS IS : ' X331B-STATUS DTSBX331
|
|
00353 MOVE 'CANNOT OPEN X331B DETAIL FILE ' TO ABEND-MSG DTSBX331
|
|
00354 PERFORM S999-ABEND THRU S999-EXIT DTSBX331
|
|
00355 END-IF. DTSBX331
|
|
00356 DTSBX331
|
|
00357 OPEN OUTPUT X331C-TRAN DTSBX331
|
|
00358 IF NOT X331C-STATUS-OK-88 DTSBX331
|
|
00359 DISPLAY 'X331C FILE STATUS IS : ' X331C-STATUS DTSBX331
|
|
00360 MOVE 'CANNOT OPEN X331C TRAN FILE ' TO ABEND-MSG DTSBX331
|
|
00361 PERFORM S999-ABEND THRU S999-EXIT DTSBX331
|
|
00362 END-IF. DTSBX331
|
|
00363 DTSBX331
|
|
00364 OPEN INPUT BE330-PARM-FILE DTSBX331
|
|
00365 IF NOT PARM-STATUS-OK-88 DTSBX331
|
|
00366 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX331
|
|
00367 MOVE 'CANNOT OPEN PARM FILE ' TO ABEND-MSG DTSBX331
|
|
00368 PERFORM S999-ABEND THRU S999-EXIT DTSBX331
|
|
00369 END-IF. DTSBX331
|
|
00370 DTSBX331
|
|
00371 READ BE330-PARM-FILE DTSBX331
|
|
00372 IF PARM-STATUS-OK-88 DTSBX331
|
|
00373 MOVE BE330-PARM-REC TO WRK-SUBJECT-DATE DTSBX331
|
|
00374 DISPLAY 'SUBJECT DATE ' WRK-SUBJECT-DATE DTSBX331
|
|
00375 ELSE DTSBX331
|
|
00376 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX331
|
|
00377 MOVE 'CANNOT READ PARM FILE ' TO ABEND-MSG DTSBX331
|
|
00378 PERFORM S999-ABEND THRU S999-EXIT DTSBX331
|
|
00379 END-IF. DTSBX331
|
|
00380 DTSBX331
|
|
00381 CLOSE BE330-PARM-FILE. DTSBX331
|
|
00382 DTSBX331
|
|
00383 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX331
|
|
00384 DTSBX331
|
|
00385 I0000-EXIT. DTSBX331
|
|
00386 EXIT. DTSBX331
|
|
00387 DTSBX331
|
|
00388 P0000-PROCESS. DTSBX331
|
|
00389 READ X331-FILE. DTSBX331
|
|
00390 IF X331-STATUS-EOF-88 DTSBX331
|
|
00391 GO TO P0000-EXIT DTSBX331
|
|
00392 ELSE DTSBX331
|
|
00393 IF NOT X331-STATUS-OK-88 DTSBX331
|
|
00394 DISPLAY 'BAD READ: ' X331-STATUS DTSBX331
|
|
00395 SET X331-STATUS-EOF-88 TO TRUE DTSBX331
|
|
00396 GO TO P0000-EXIT DTSBX331
|
|
00397 END-IF DTSBX331
|
|
00398 END-IF. DTSBX331
|
|
00399 DTSBX331
|
|
00400 IF WRK-EMP-NO = ZERO DTSBX331
|
|
00401 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX331
|
|
00402 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX331
|
|
00403 ELSE DTSBX331
|
|
00404 IF X331-EMP-NO = WRK-EMP-NO DTSBX331
|
|
00405 AND X331-YRQ = WRK-YRQ DTSBX331
|
|
00406 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX331
|
|
00407 ELSE DTSBX331
|
|
00408 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT DTSBX331
|
|
00409 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX331
|
|
00410 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX331
|
|
00411 END-IF DTSBX331
|
|
00412 END-IF. DTSBX331
|
|
00413 DTSBX331
|
|
00414 P0000-EXIT. DTSBX331
|
|
00415 EXIT. DTSBX331
|
|
00416 DTSBX331
|
|
00417 DTSBX331
|
|
00418 P1000-BUILD-QTR-TABLE. DTSBX331
|
|
00419 IF QTR-SUB < QTR-MAX DTSBX331
|
|
00420 ADD +1 TO QTR-SUB DTSBX331
|
|
00421 QTR-LAST DTSBX331
|
|
00422 ELSE DTSBX331
|
|
00423 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX331
|
|
00424 TO ABEND-MSG DTSBX331
|
|
00425 PERFORM S999-ABEND THRU S999-EXIT. DTSBX331
|
|
00426 DTSBX331
|
|
00427 MOVE X331-BATCH-NO TO QTR-BATCH-NO (QTR-SUB). DTSBX331
|
|
00428 MOVE X331-ITEM-NO TO QTR-ITEM-NO (QTR-SUB). DTSBX331
|
|
00429 MOVE X331-TRAN-TYPE TO QTR-TRAN-TYPE (QTR-SUB). DTSBX331
|
|
00430 ADD X331-AMT TO QTR-AMT (QTR-SUB). DTSBX331
|
|
00431 ADD X331-ESTB-DATE TO QTR-ESTB-DATE (QTR-SUB). DTSBX331
|
|
00432 DTSBX331
|
|
00433 P1000-EXIT. DTSBX331
|
|
00434 EXIT. DTSBX331
|
|
00435 DTSBX331
|
|
00436 P1300-INIT-TABLES. DTSBX331
|
|
00437 MOVE X331-EMP-NO TO WRK-EMP-NO. DTSBX331
|
|
00438 MOVE X331-YRQ TO WRK-YRQ. DTSBX331
|
|
00439 MOVE X331-EMP-CLASS TO WRK-EMP-CLASS. DTSBX331
|
|
00440 MOVE X331-TRAN-CATEGORY TO WRK-TRAN-CAT. DTSBX331
|
|
00441 DTSBX331
|
|
00442 PERFORM DTSBX331
|
|
00443 VARYING QTR-SUB FROM +1 BY +1 DTSBX331
|
|
00444 UNTIL QTR-SUB > QTR-MAX DTSBX331
|
|
00445 MOVE +0 TO QTR-BATCH-NO (QTR-SUB) DTSBX331
|
|
00446 QTR-ITEM-NO (QTR-SUB) DTSBX331
|
|
00447 QTR-AMT (QTR-SUB) DTSBX331
|
|
00448 QTR-ESTB-DATE (QTR-SUB) DTSBX331
|
|
00449 MOVE SPACES TO QTR-TRAN-TYPE (QTR-SUB) DTSBX331
|
|
00450 END-PERFORM. DTSBX331
|
|
00451 DTSBX331
|
|
00452 MOVE +0 TO QTR-SUB DTSBX331
|
|
00453 QTR-LAST. DTSBX331
|
|
00454 DTSBX331
|
|
00455 P1300-EXIT. DTSBX331
|
|
00456 EXIT. DTSBX331
|
|
00457 DTSBX331
|
|
00458 DTSBX331
|
|
00459 P5000-WRITE-OUTPUT. DTSBX331
|
|
00460 MOVE ZERO TO WRK-QTR-BAL DTSBX331
|
|
00461 WRK-BATCH-NO DTSBX331
|
|
00462 WRK-ITEM-NO. DTSBX331
|
|
00463 MOVE SPACES TO WRK-TRAN-TYPE. DTSBX331
|
|
00464 DTSBX331
|
|
00465 PERFORM DTSBX331
|
|
00466 VARYING QTR-SUB FROM +1 BY +1 DTSBX331
|
|
00467 UNTIL QTR-SUB > QTR-LAST DTSBX331
|
|
00468 ADD QTR-AMT (QTR-SUB) TO WRK-QTR-BAL DTSBX331
|
|
00469 END-PERFORM. DTSBX331
|
|
00470 DTSBX331
|
|
00471 IF WRK-QTR-BAL > ZERO DTSBX331
|
|
00472 PERFORM DTSBX331
|
|
00473 VARYING QTR-SUB FROM +1 BY +1 DTSBX331
|
|
00474 UNTIL QTR-SUB > QTR-LAST DTSBX331
|
|
00475 PERFORM P5100-WRITE-X331 THRU P5100-EXIT DTSBX331
|
|
00476 END-PERFORM DTSBX331
|
|
00477 END-IF. DTSBX331
|
|
00478 DTSBX331
|
|
00479 P5000-EXIT. DTSBX331
|
|
00480 EXIT. DTSBX331
|
|
00481 DTSBX331
|
|
00482 P5100-WRITE-X331. DTSBX331
|
|
00483 PERFORM P5110-WRITE-SUMMARY THRU P5110-EXIT. DTSBX331
|
|
00484 PERFORM P5120-WRITE-DETAIL THRU P5120-EXIT. DTSBX331
|
|
00485 PERFORM P5130-WRITE-TRAN THRU P5130-EXIT. DTSBX331
|
|
00486 DTSBX331
|
|
00487 P5100-EXIT. DTSBX331
|
|
00488 EXIT. DTSBX331
|
|
00489 DTSBX331
|
|
00490 P5110-WRITE-SUMMARY. DTSBX331
|
|
00491 ADD +1 TO WRK-SEQ-A. DTSBX331
|
|
00492 MOVE WRK-SEQ-A TO X331A-SEQ. DTSBX331
|
|
00493 MOVE QTR-ESTB-DATE (QTR-SUB) TO L001-FED-8-DATE-9. DTSBX331
|
|
00494 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX331
|
|
00495 MOVE L001-SLASH-8-DATE TO X331A-ESTB-DATE. DTSBX331
|
|
00496 MOVE WRK-EMP-NO TO X331A-EMP-NO. DTSBX331
|
|
00497 IF WRK-YRQ < +99999 DTSBX331
|
|
00498 MOVE 'DEBIT ' TO X331A-CREDIT-DEBIT DTSBX331
|
|
00499 ELSE DTSBX331
|
|
00500 MOVE 'CREDIT' TO X331A-CREDIT-DEBIT DTSBX331
|
|
00501 END-IF. DTSBX331
|
|
00502 MOVE QTR-BATCH-NO (QTR-SUB) TO X331A-BATCH. DTSBX331
|
|
00503 MOVE QTR-ITEM-NO (QTR-SUB) TO X331A-ITEM. DTSBX331
|
|
00504 MOVE QTR-TRAN-TYPE (QTR-SUB) TO X331A-TRAN. DTSBX331
|
|
00505 MOVE QTR-AMT(QTR-SUB) TO X331A-AMT. DTSBX331
|
|
00506 IF WRK-YRQ < +99999 DTSBX331
|
|
00507 MOVE WRK-YRQ TO L004-QTR-5-9 DTSBX331
|
|
00508 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX331
|
|
00509 MOVE L004-SLASH-5-QTR TO X331A-YRQ DTSBX331
|
|
00510 ELSE DTSBX331
|
|
00511 MOVE SPACES TO X331A-YRQ. DTSBX331
|
|
00512 MOVE WRK-EMP-CLASS TO X331A-EMP-CLASS. DTSBX331
|
|
00513 MOVE WRK-TRAN-CAT TO X331A-CAT. DTSBX331
|
|
00514 DTSBX331
|
|
00515 WRITE X331A-REC FROM WRK-X331A-REC. DTSBX331
|
|
00516 IF NOT X331A-STATUS-OK-88 DTSBX331
|
|
00517 DISPLAY 'CANNOT WRITE TO OUTPUT FILE ' X331A-STATUS DTSBX331
|
|
00518 ' ' X331A-EMP-NO DTSBX331
|
|
00519 ELSE DTSBX331
|
|
00520 ADD +1 TO WRK-X331A-CNT DTSBX331
|
|
00521 END-IF. DTSBX331
|
|
00522 DTSBX331
|
|
00523 IF WRK-EMP-NO = 010021 DTSBX331
|
|
00524 DISPLAY X331A-EMP-NO DTSBX331
|
|
00525 * ' ' X331A-AMT DTSBX331
|
|
00526 ' ' X331A-BATCH DTSBX331
|
|
00527 ' ' X331A-ITEM DTSBX331
|
|
00528 ' ' X331A-TRAN. DTSBX331
|
|
00529 DTSBX331
|
|
00530 P5110-EXIT. DTSBX331
|
|
00531 EXIT. DTSBX331
|
|
00532 DTSBX331
|
|
00533 P5120-WRITE-DETAIL. DTSBX331
|
|
00534 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX331
|
|
00535 MOVE WRK-EMP-NO TO MJRN-EMP-NO. DTSBX331
|
|
00536 SET MJRN-JRN-88 TO TRUE. DTSBX331
|
|
00537 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX331
|
|
00538 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX331
|
|
00539 PERFORM UNTIL L910-NO-REC-88 DTSBX331
|
|
00540 MOVE MSKL-REC TO MJRN-REC DTSBX331
|
|
00541 IF (MJRN-BATCH-NO = QTR-BATCH-NO (QTR-SUB) DTSBX331
|
|
00542 AND MJRN-ITEM-NO = QTR-ITEM-NO (QTR-SUB)) DTSBX331
|
|
00543 PERFORM P5121-WRITE THRU P5121-EXIT DTSBX331
|
|
00544 SET L910-NO-REC-88 TO TRUE DTSBX331
|
|
00545 END-IF DTSBX331
|
|
00546 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX331
|
|
00547 END-PERFORM. DTSBX331
|
|
00548 DTSBX331
|
|
00549 P5120-EXIT. DTSBX331
|
|
00550 EXIT. DTSBX331
|
|
00551 DTSBX331
|
|
00552 P5121-WRITE. DTSBX331
|
|
00553 PERFORM DTSBX331
|
|
00554 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBX331
|
|
00555 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBX331
|
|
00556 ADD +1 TO WRK-SEQ-B DTSBX331
|
|
00557 MOVE WRK-SEQ-B TO X331B-SEQ DTSBX331
|
|
00558 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBX331
|
|
00559 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX331
|
|
00560 MOVE L004-SLASH-5-QTR TO X331B-YRQ DTSBX331
|
|
00561 MOVE MJRN-EMP-NO TO X331B-EMP-NO DTSBX331
|
|
00562 MOVE MJRN-EMP-CLASS TO X331B-EMP-CLASS DTSBX331
|
|
00563 MOVE MJRN-BATCH-NO TO X331B-BATCH DTSBX331
|
|
00564 MOVE MJRN-ITEM-NO TO X331B-ITEM DTSBX331
|
|
00565 MOVE MJRN-TRAN-TYPE TO X331B-TRAN DTSBX331
|
|
00566 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) DTSBX331
|
|
00567 TO X331B-ROW DTSBX331
|
|
00568 MOVE MJRN-ACCT-COL (MJRN-OCC-IDX) DTSBX331
|
|
00569 TO X331B-COL DTSBX331
|
|
00570 MOVE MJRN-AMT (MJRN-OCC-IDX) TO X331B-AMT DTSBX331
|
|
00571 MOVE WRK-TRAN-CAT TO X331B-CAT DTSBX331
|
|
00572 DTSBX331
|
|
00573 WRITE X331B-REC FROM WRK-X331B-REC DTSBX331
|
|
00574 IF NOT X331B-STATUS-OK-88 DTSBX331
|
|
00575 DISPLAY 'CANNOT WRITE TO OUTPUT FILE ' DTSBX331
|
|
00576 ' ' X331B-STATUS ' ' X331B-EMP-NO DTSBX331
|
|
00577 ELSE DTSBX331
|
|
00578 ADD +1 TO WRK-X331B-CNT DTSBX331
|
|
00579 END-IF DTSBX331
|
|
00580 END-PERFORM. DTSBX331
|
|
00581 DTSBX331
|
|
00582 P5121-EXIT. DTSBX331
|
|
00583 EXIT. DTSBX331
|
|
00584 DTSBX331
|
|
00585 P5130-WRITE-TRAN. DTSBX331
|
|
00586 IF WRK-TRAN-CAT = 'R' DTSBX331
|
|
00587 ** IF X331A-TRAN = 'OR' OR 'AU' OR 'EA' OR 'AC' OR 'FS' DTSBX331
|
|
00588 ** OR 'ES' OR 'WD' DTSBX331
|
|
00589 PERFORM P5131-REPORT THRU P5131-EXIT DTSBX331
|
|
00590 ELSE DTSBX331
|
|
00591 IF WRK-TRAN-CAT = 'P' DTSBX331
|
|
00592 ** IF X331A-TRAN = 'PA' OR 'PR' OR 'RF' OR 'RR' OR 'NG' DTSBX331
|
|
00593 PERFORM P5132-PAYMENT THRU P5132-EXIT DTSBX331
|
|
00594 ELSE DTSBX331
|
|
00595 IF WRK-TRAN-CAT = 'A' DTSBX331
|
|
00596 ** IF X331A-TRAN = 'CH' OR 'WV' OR 'TL' OR 'WO' OR 'WR' DTSBX331
|
|
00597 PERFORM P5133-ADJUSTMENT THRU P5133-EXIT DTSBX331
|
|
00598 END-IF DTSBX331
|
|
00599 END-IF DTSBX331
|
|
00600 END-IF. DTSBX331
|
|
00601 DTSBX331
|
|
00602 P5130-EXIT. DTSBX331
|
|
00603 EXIT. DTSBX331
|
|
00604 DTSBX331
|
|
00605 P5131-REPORT. DTSBX331
|
|
00606 SET WRK-RPT-FOUND-NO-88 TO TRUE. DTSBX331
|
|
00607 DTSBX331
|
|
00608 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBX331
|
|
00609 MOVE WRK-EMP-NO TO MRPT-EMP-NO. DTSBX331
|
|
00610 IF WRK-YRQ < +99999 DTSBX331
|
|
00611 MOVE WRK-YRQ TO MRPT-YRQ DTSBX331
|
|
00612 MOVE X331A-BATCH TO MRPT-BATCH-NO DTSBX331
|
|
00613 MOVE X331A-ITEM TO MRPT-ITEM-NO DTSBX331
|
|
00614 END-IF. DTSBX331
|
|
00615 SET MRPT-RPT-88 TO TRUE. DTSBX331
|
|
00616 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBX331
|
|
00617 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX331
|
|
00618 IF L910-NO-REC-88 DTSBX331
|
|
00619 GO TO P5131-EXIT DTSBX331
|
|
00620 ELSE DTSBX331
|
|
00621 PERFORM DTSBX331
|
|
00622 UNTIL L910-NO-REC-88 OR WRK-RPT-FOUND-YES-88 DTSBX331
|
|
00623 MOVE MSKL-REC TO MRPT-REC DTSBX331
|
|
00624 IF (MRPT-BATCH-NO = X331A-BATCH DTSBX331
|
|
00625 AND MRPT-ITEM-NO = X331A-ITEM) DTSBX331
|
|
00626 SET WRK-RPT-FOUND-YES-88 TO TRUE DTSBX331
|
|
00627 ELSE DTSBX331
|
|
00628 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX331
|
|
00629 END-IF DTSBX331
|
|
00630 END-PERFORM DTSBX331
|
|
00631 END-IF. DTSBX331
|
|
00632 DTSBX331
|
|
00633 IF WRK-RPT-FOUND-NO-88 DTSBX331
|
|
00634 GO TO P5131-EXIT DTSBX331
|
|
00635 END-IF. DTSBX331
|
|
00636 DTSBX331
|
|
00637 ADD +1 TO WRK-SEQ-C. DTSBX331
|
|
00638 MOVE WRK-SEQ-C TO X331C-SEQ. DTSBX331
|
|
00639 MOVE MRPT-RPT-TYPE TO X331C-TRANS. DTSBX331
|
|
00640 MOVE X331A-BATCH TO X331C-BATCH. DTSBX331
|
|
00641 MOVE X331A-ITEM TO X331C-ITEM. DTSBX331
|
|
00642 MOVE WRK-EMP-NO TO X331C-EMP-NO. DTSBX331
|
|
00643 MOVE MRPT-YRQ TO L004-QTR-5-9 DTSBX331
|
|
00644 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX331
|
|
00645 MOVE L004-SLASH-5-QTR TO X331C-YRQ DTSBX331
|
|
00646 MOVE MRPT-REMIT-AMT TO X331C-AMT. DTSBX331
|
|
00647 MOVE MRPT-TAX-WAGE TO X331C-TAX-WAGE. DTSBX331
|
|
00648 COMPUTE WRK-RATE = (MRPT-UI-RATE * 100). DTSBX331
|
|
00649 MOVE WRK-RATE TO X331C-RATE. DTSBX331
|
|
00650 MOVE SPACES TO X331C-ACCT. DTSBX331
|
|
00651 MOVE WRK-EMP-CLASS TO X331C-EMP-CLASS. DTSBX331
|
|
00652 MOVE WRK-TRAN-CAT TO X331C-CAT. DTSBX331
|
|
00653 DTSBX331
|
|
00654 WRITE X331C-REC FROM WRK-X331C-REC DTSBX331
|
|
00655 IF NOT X331C-STATUS-OK-88 DTSBX331
|
|
00656 DISPLAY 'CANNOT WRITE TO X331C FILE ' DTSBX331
|
|
00657 ' ' X331C-STATUS ' ' X331C-EMP-NO DTSBX331
|
|
00658 ELSE DTSBX331
|
|
00659 ADD +1 TO WRK-X331C-CNT DTSBX331
|
|
00660 END-IF. DTSBX331
|
|
00661 DTSBX331
|
|
00662 P5131-EXIT. DTSBX331
|
|
00663 EXIT. DTSBX331
|
|
00664 DTSBX331
|
|
00665 P5132-PAYMENT. DTSBX331
|
|
00666 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX331
|
|
00667 MOVE WRK-EMP-NO TO MPAY-EMP-NO. DTSBX331
|
|
00668 MOVE QTR-BATCH-NO (QTR-SUB) TO MPAY-BATCH-NO. DTSBX331
|
|
00669 MOVE QTR-ITEM-NO (QTR-SUB) TO MPAY-ITEM-NO. DTSBX331
|
|
00670 SET MPAY-PAY-88 TO TRUE. DTSBX331
|
|
00671 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX331
|
|
00672 PERFORM S910-READ THRU S910-EXIT. DTSBX331
|
|
00673 IF L910-NO-REC-88 DTSBX331
|
|
00674 GO TO P5132-EXIT DTSBX331
|
|
00675 ELSE DTSBX331
|
|
00676 MOVE MSKL-REC TO MPAY-REC DTSBX331
|
|
00677 END-IF. DTSBX331
|
|
00678 DTSBX331
|
|
00679 ADD +1 TO WRK-SEQ-C. DTSBX331
|
|
00680 MOVE WRK-SEQ-C TO X331C-SEQ. DTSBX331
|
|
00681 MOVE MPAY-PAY-TYPE TO X331C-TRANS. DTSBX331
|
|
00682 MOVE SPACES TO X331C-YRQ. DTSBX331
|
|
00683 MOVE WRK-EMP-NO TO X331C-EMP-NO. DTSBX331
|
|
00684 MOVE X331A-BATCH TO X331C-BATCH. DTSBX331
|
|
00685 MOVE X331A-ITEM TO X331C-ITEM. DTSBX331
|
|
00686 MOVE MPAY-REMIT-AMT TO X331C-AMT. DTSBX331
|
|
00687 MOVE SPACES TO X331C-TAX-WAGE-X. DTSBX331
|
|
00688 MOVE SPACES TO X331C-RATE-X. DTSBX331
|
|
00689 MOVE SPACES TO X331C-ACCT. DTSBX331
|
|
00690 MOVE WRK-EMP-CLASS TO X331C-EMP-CLASS. DTSBX331
|
|
00691 MOVE WRK-TRAN-CAT TO X331C-CAT. DTSBX331
|
|
00692 DTSBX331
|
|
00693 WRITE X331C-REC FROM WRK-X331C-REC DTSBX331
|
|
00694 IF NOT X331C-STATUS-OK-88 DTSBX331
|
|
00695 DISPLAY 'CANNOT WRITE TO X331C FILE ' DTSBX331
|
|
00696 ' ' X331C-STATUS ' ' X331C-EMP-NO DTSBX331
|
|
00697 ELSE DTSBX331
|
|
00698 ADD +1 TO WRK-X331C-CNT DTSBX331
|
|
00699 END-IF. DTSBX331
|
|
00700 DTSBX331
|
|
00701 P5132-EXIT. DTSBX331
|
|
00702 EXIT. DTSBX331
|
|
00703 DTSBX331
|
|
00704 P5133-ADJUSTMENT. DTSBX331
|
|
00705 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBX331
|
|
00706 MOVE WRK-EMP-NO TO MADJ-EMP-NO. DTSBX331
|
|
00707 MOVE QTR-BATCH-NO (QTR-SUB) TO MADJ-BATCH-NO. DTSBX331
|
|
00708 MOVE QTR-ITEM-NO (QTR-SUB) TO MADJ-ITEM-NO. DTSBX331
|
|
00709 SET MADJ-ADJ-88 TO TRUE. DTSBX331
|
|
00710 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBX331
|
|
00711 PERFORM S910-READ THRU S910-EXIT. DTSBX331
|
|
00712 IF L910-NO-REC-88 DTSBX331
|
|
00713 GO TO P5133-EXIT DTSBX331
|
|
00714 ELSE DTSBX331
|
|
00715 MOVE MSKL-REC TO MADJ-REC DTSBX331
|
|
00716 END-IF. DTSBX331
|
|
00717 DTSBX331
|
|
00718 ADD +1 TO WRK-SEQ-C. DTSBX331
|
|
00719 MOVE WRK-SEQ-C TO X331C-SEQ. DTSBX331
|
|
00720 MOVE MADJ-ADJ-TYPE TO X331C-TRANS. DTSBX331
|
|
00721 MOVE X331A-BATCH TO X331C-BATCH. DTSBX331
|
|
00722 MOVE X331A-ITEM TO X331C-ITEM. DTSBX331
|
|
00723 MOVE SPACES TO X331C-YRQ. DTSBX331
|
|
00724 MOVE WRK-EMP-NO TO X331C-EMP-NO. DTSBX331
|
|
00725 MOVE MADJ-AMT TO X331C-AMT. DTSBX331
|
|
00726 MOVE SPACES TO X331C-TAX-WAGE-X. DTSBX331
|
|
00727 MOVE SPACES TO X331C-RATE-X. DTSBX331
|
|
00728 MOVE MADJ-APPLIC-IND TO X331C-ACCT. DTSBX331
|
|
00729 MOVE WRK-EMP-CLASS TO X331C-EMP-CLASS. DTSBX331
|
|
00730 MOVE WRK-TRAN-CAT TO X331C-CAT. DTSBX331
|
|
00731 DTSBX331
|
|
00732 WRITE X331C-REC FROM WRK-X331C-REC DTSBX331
|
|
00733 IF NOT X331C-STATUS-OK-88 DTSBX331
|
|
00734 DISPLAY 'CANNOT WRITE TO X331C FILE ' DTSBX331
|
|
00735 ' ' X331C-STATUS ' ' X331C-EMP-NO DTSBX331
|
|
00736 ELSE DTSBX331
|
|
00737 ADD +1 TO WRK-X331C-CNT DTSBX331
|
|
00738 END-IF. DTSBX331
|
|
00739 DTSBX331
|
|
00740 P5133-EXIT. DTSBX331
|
|
00741 EXIT. DTSBX331
|
|
00742 DTSBX331
|
|
00743 T0000-TERMINATE. DTSBX331
|
|
00744 DTSBX331
|
|
00745 CLOSE X331-FILE DTSBX331
|
|
00746 X331A-SUMMARY DTSBX331
|
|
00747 X331B-DETAIL DTSBX331
|
|
00748 X331C-TRAN. DTSBX331
|
|
00749 DTSBX331
|
|
00750 DISPLAY ' '. DTSBX331
|
|
00751 DTSBX331
|
|
00752 DISPLAY '*** DTSBX331 TERMINATION STATISTICS ***'. DTSBX331
|
|
00753 DTSBX331
|
|
00754 DISPLAY ' '. DTSBX331
|
|
00755 MOVE WRK-X331A-CNT TO DISPLAY-CNT. DTSBX331
|
|
00756 DISPLAY 'X331A RECORDS WRITTEN : ' DTSBX331
|
|
00757 DISPLAY-CNT. DTSBX331
|
|
00758 MOVE WRK-X331B-CNT TO DISPLAY-CNT. DTSBX331
|
|
00759 DISPLAY 'X331B RECORDS WRITTEN : ' DTSBX331
|
|
00760 DISPLAY-CNT. DTSBX331
|
|
00761 MOVE WRK-X331C-CNT TO DISPLAY-CNT. DTSBX331
|
|
00762 DISPLAY 'X331C RECORDS WRITTEN : ' DTSBX331
|
|
00763 DISPLAY-CNT. DTSBX331
|
|
00764 DTSBX331
|
|
00765 T0000-EXIT. DTSBX331
|
|
00766 EXIT. DTSBX331
|
|
00767 DTSBX331
|
|
00768 S001-FROM-FED-8. DTSBX331
|
|
00769 SET L001-FROM-FED-8 TO TRUE. DTSBX331
|
|
00770 GO TO S001-DATE. DTSBX331
|
|
00771 DTSBX331
|
|
00772 S001-FROM-ABS-DAY. DTSBX331
|
|
00773 SET L001-FROM-ABS-DAY TO TRUE. DTSBX331
|
|
00774 GO TO S001-DATE. DTSBX331
|
|
00775 DTSBX331
|
|
00776 S001-FROM-CAL-6. DTSBX331
|
|
00777 SET L001-FROM-CAL-6 TO TRUE. DTSBX331
|
|
00778 GO TO S001-DATE. DTSBX331
|
|
00779 DTSBX331
|
|
00780 S001-DATE. DTSBX331
|
|
00781 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX331
|
|
00782 S001-EXIT. DTSBX331
|
|
00783 EXIT. DTSBX331
|
|
00784 SKIP3 DTSBX331
|
|
00785 S004-FROM-5. DTSBX331
|
|
00786 SET L004-FROM-5 TO TRUE. DTSBX331
|
|
00787 GO TO S004-QTR. DTSBX331
|
|
00788 DTSBX331
|
|
00789 S004-FROM-ABS. DTSBX331
|
|
00790 SET L004-FROM-ABS TO TRUE. DTSBX331
|
|
00791 GO TO S004-QTR. DTSBX331
|
|
00792 DTSBX331
|
|
00793 S004-FROM-3. DTSBX331
|
|
00794 SET L004-FROM-3 TO TRUE. DTSBX331
|
|
00795 GO TO S004-QTR. DTSBX331
|
|
00796 DTSBX331
|
|
00797 S004-FROM-DATE. DTSBX331
|
|
00798 SET L004-FROM-DATE TO TRUE. DTSBX331
|
|
00799 GO TO S004-QTR. DTSBX331
|
|
00800 DTSBX331
|
|
00801 S004-QTR. DTSBX331
|
|
00802 DTSBX331
|
|
00803 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX331
|
|
00804 DTSBX331
|
|
00805 S004-EXIT. DTSBX331
|
|
00806 EXIT. DTSBX331
|
|
00807 SKIP3 DTSBX331
|
|
00808 DTSBX331
|
|
00809 S910-OPEN-READ. DTSBX331
|
|
00810 SET L910-OPEN-READ-88 TO TRUE. DTSBX331
|
|
00811 GO TO S910-MSTR-IO. DTSBX331
|
|
00812 DTSBX331
|
|
00813 S910-READ. DTSBX331
|
|
00814 SET L910-READ-88 TO TRUE. DTSBX331
|
|
00815 GO TO S910-MSTR-IO. DTSBX331
|
|
00816 DTSBX331
|
|
00817 S910-START-BROWSE. DTSBX331
|
|
00818 SET L910-START-BROWSE-88 TO TRUE. DTSBX331
|
|
00819 GO TO S910-MSTR-IO. DTSBX331
|
|
00820 DTSBX331
|
|
00821 S910-READ-NEXT. DTSBX331
|
|
00822 SET L910-READ-NEXT-88 TO TRUE. DTSBX331
|
|
00823 GO TO S910-MSTR-IO. DTSBX331
|
|
00824 DTSBX331
|
|
00825 S910-CLOSE. DTSBX331
|
|
00826 SET L910-CLOSE-88 TO TRUE. DTSBX331
|
|
00827 GO TO S910-MSTR-IO. DTSBX331
|
|
00828 DTSBX331
|
|
00829 S910-MSTR-IO. DTSBX331
|
|
00830 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX331
|
|
00831 MSKL-REC. DTSBX331
|
|
00832 S910-EXIT. DTSBX331
|
|
00833 EXIT. DTSBX331
|
|
00834 DTSBX331
|
|
00835 S999-ABEND. DTSBX331
|
|
00836 DISPLAY '*** DTSBX331 ABENDING. ' DTSBX331
|
|
00837 ABEND-MSG. DTSBX331
|
|
00838 DTSBX331
|
|
00839 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX331
|
|
00840 S999-EXIT. DTSBX331
|
|
00841 EXIT. DTSBX331
|