1371 lines
108 KiB
COBOL
1371 lines
108 KiB
COBOL
00001 IDENTIFICATION DIVISION. 03/31/11
|
|
00002 PROGRAM-ID. DTSBX774. DTSBX774
|
|
00003 AUTHOR. TRW. LV003
|
|
00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX774
|
|
00005 DATE-COMPILED. DTSBX774
|
|
00006 SKIP3 DTSBX774
|
|
00007 ***** DTSBX774
|
|
00008 * DTSBX774
|
|
00009 * DTSBX774
|
|
00010 * FUNCTION: BUILD ETA581 RECONSTRUCTION FILE RECORDS FOR DTSBX774
|
|
00011 * ACCOUNTS RECEIVABLE POPULATION. DTSBX774
|
|
00012 * DTSBX774
|
|
00013 * DTSBX774
|
|
00014 * MODIFICATION LOG: DTSBX774
|
|
00015 * DTSBX774
|
|
00016 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX774
|
|
00017 * REFERENCE: DATA VALIDATION PROGRAMMER: GD DTSBX774
|
|
00018 * DTSBX774
|
|
00019 * 10/02/2003 P5100, P5200: MOVED CODE THAT INCREMENTS DTSBX774
|
|
00020 * OBS NUMBER TO EXECUTE IMMEDIATELY BEFORE WRITE. DTSBX774
|
|
00021 * SOME NUMBERS WERE BEING SKIPPED BECAUSE THE DTSBX774
|
|
00022 * NUMBER WAS INCREMENTED FOR RECORDS EVENTUALLY DTSBX774
|
|
00023 * BYPASSED. DTSBX774
|
|
00024 * REFERENCE: PROGRAMMER: GD DTSBX774
|
|
00025 * DTSBX774
|
|
00026 * 10/02/2003 MODIFIED OUTPUT RECORD: END OF QTR BALANCE FIELD DTSBX774
|
|
00027 * ONLY INCLUDED IN BALANCE RECORDS. DTSBX774
|
|
00028 * REFERENCE: PROGRAMMER: GD DTSBX774
|
|
00029 * DTSBX774
|
|
00030 * 10/27/2010 MODIFIED LIQUIDATION OUTPUT RECORD: ESTABLISHED DTSBX774
|
|
00031 * Q DATE IS NOW REQUIRED. DTSBX774
|
|
00032 * REFERENCE: PROGRAMMER: GD DTSBX774
|
|
00033 * DTSBX774
|
|
00034 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX774
|
|
00035 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX774
|
|
00036 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX774
|
|
00037 * DTSBX774
|
|
00038 * DTSBX774
|
|
00039 * DESCRIPTION: DTSBX774
|
|
00040 * DTSBX774
|
|
00041 * DTSBX774
|
|
00042 * INITIATION: DTSBX774
|
|
00043 * DTSBX774
|
|
00044 * OPEN DTSX774 DTSBX774
|
|
00045 * DTSBX774
|
|
00046 * DTSBX774
|
|
00047 * DTSBX774
|
|
00048 * PROCESSING: DTSBX774
|
|
00049 * DTSBX774
|
|
00050 * BUILD X774 OUTPUT RECORDS FROM DTSIY774 INPUT. DTSBX774
|
|
00051 * DTSBX774
|
|
00052 * DTSBX774
|
|
00053 * TERMINATION: DTSBX774
|
|
00054 * DTSBX774
|
|
00055 * CLOSE DTSX774 DTSBX774
|
|
00056 * DTSBX774
|
|
00057 * RECORDS READ: DTSBX774
|
|
00058 * DTSBX774
|
|
00059 * MASTER: DTSBX774
|
|
00060 * DTSBX774
|
|
00061 * NONE DTSBX774
|
|
00062 * DTSBX774
|
|
00063 * ALTERNATE INDEX: DTSBX774
|
|
00064 * DTSBX774
|
|
00065 * NONE. DTSBX774
|
|
00066 * DTSBX774
|
|
00067 * DTSBX774
|
|
00068 * REFERENCE: DTSBX774
|
|
00069 * DTSBX774
|
|
00070 * DTSBX774
|
|
00071 * DTSBX774
|
|
00072 * RECORDS UPDATED: DTSBX774
|
|
00073 * DTSBX774
|
|
00074 * NONE DTSBX774
|
|
00075 * DTSBX774
|
|
00076 * DTSBX774
|
|
00077 * OUTPUT RECORDS WRITTEN: DTSBX774
|
|
00078 * DTSBX774
|
|
00079 * DTSIX774 POPULATION 4 DOWNLOAD DTSBX774
|
|
00080 * DTSBX774
|
|
00081 * DTSBX774
|
|
00082 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX774
|
|
00083 * DTSBX774
|
|
00084 * NONE. DTSBX774
|
|
00085 * DTSBX774
|
|
00086 * DTSBX774
|
|
00087 * MODULES CALLED: DTSBX774
|
|
00088 * DTSBX774
|
|
00089 * DTSBU001 DATE EDIT/CONVERSION. DTSBX774
|
|
00090 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX774
|
|
00091 * DTSBX774
|
|
00092 * DTSBX774
|
|
00093 * DTSBX774
|
|
00094 ***** DTSBX774
|
|
00095 SKIP3 DTSBX774
|
|
00096 ENVIRONMENT DIVISION. DTSBX774
|
|
00097 INPUT-OUTPUT SECTION. DTSBX774
|
|
00098 FILE-CONTROL. DTSBX774
|
|
00099 SELECT ACCTS-RECEIVABLE ASSIGN TO DTSX774 DTSBX774
|
|
00100 FILE STATUS IS X774-STATUS. DTSBX774
|
|
00101 EJECT DTSBX774
|
|
00102 DATA DIVISION. DTSBX774
|
|
00103 FILE SECTION. DTSBX774
|
|
00104 FD ACCTS-RECEIVABLE DTSBX774
|
|
00105 RECORDING MODE IS F DTSBX774
|
|
00106 LABEL RECORDS ARE STANDARD DTSBX774
|
|
00107 BLOCK CONTAINS 0 RECORDS. DTSBX774
|
|
00108 01 ACCTS-RECEIVABLE-REC PIC X(155). DTSBX774
|
|
00109 SKIP3 DTSBX774
|
|
00110 WORKING-STORAGE SECTION. DTSBX774
|
|
001105 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX774 03/31/11'. DTSBX774
|
|
00111 SKIP3 DTSBX774
|
|
00112 01 WRK-AREA. DTSBX774
|
|
00113 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +774.DTSBX774
|
|
00114 DTSBX774
|
|
00115 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX774'.DTSBX774
|
|
00116 DTSBX774
|
|
00117 05 ABEND-MSG PIC X(60). DTSBX774
|
|
00118 DTSBX774
|
|
00119 05 X774-STATUS PIC X(02) VALUE SPACES. DTSBX774
|
|
00120 88 X774-STATUS-OK-88 VALUE ZEROS. DTSBX774
|
|
00121 DTSBX774
|
|
00122 05 WRK-LEN PIC S9(04) COMP DTSBX774
|
|
00123 VALUE +155. DTSBX774
|
|
00124 DTSBX774
|
|
00125 05 WRK-REC-AREA PIC X(155). DTSBX774
|
|
00126 DTSBX774
|
|
00127 05 WRK-ESTB-FILLER PIC X(11) VALUE SPACES. DTSBX774
|
|
00128 05 WRK-LIQD-FILLER PIC X(20) VALUE SPACES. DTSBX774
|
|
00129 05 WRK-REM-BAL-FILLER PIC X(20) VALUE SPACES. DTSBX774
|
|
00130 DTSBX774
|
|
00131 ******************************************************************DTSBX774
|
|
00132 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE DTSBX774
|
|
00133 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED DTSBX774
|
|
00134 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER DTSBX774
|
|
00135 * FIELDS ARE CALCULATED. THE START BALANCE IS THE RECEIVABLE DTSBX774
|
|
00136 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS. DTSBX774
|
|
00137 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING DTSBX774
|
|
00138 * ANY REPORT QUARTER LIQUIDATIONS. DTSBX774
|
|
00139 ******************************************************************DTSBX774
|
|
00140 05 RT-SUB PIC S9(04) COMP VALUE +0. DTSBX774
|
|
00141 05 RT-LAST PIC S9(04) COMP VALUE +0. DTSBX774
|
|
00142 05 RT-MAX PIC S9(04) COMP VALUE +200. DTSBX774
|
|
00143 05 RECEIVABLE-TABLE OCCURS 200 TIMES. DTSBX774
|
|
00144 10 RT-PROCESSED-DATE PIC S9(09) COMP-3. DTSBX774
|
|
00145 10 RT-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX774
|
|
00146 10 RT-AMT PIC S9(09)V99 COMP-3. DTSBX774
|
|
00147 10 RT-START-BALANCE PIC S9(09)V99 COMP-3. DTSBX774
|
|
00148 10 RT-END-BALANCE PIC S9(09)V99 COMP-3. DTSBX774
|
|
00149 10 RT-581-TYPE PIC X(01). DTSBX774
|
|
00150 88 RT-581-TYPE-ESTABLISHED-88 VALUE '0'. DTSBX774
|
|
00151 88 RT-581-TYPE-BALANCE-88 VALUE '1'. DTSBX774
|
|
00152 88 RT-581-TYPE-REMOVED-NOW-88 VALUE '2'. DTSBX774
|
|
00153 88 RT-581-TYPE-REMOVED-PRIOR-88 VALUE '3'. DTSBX774
|
|
00154 88 RT-581-TYPE-REMOVED-88 VALUE '2' '3'. DTSBX774
|
|
00155 DTSBX774
|
|
00156 ******************************************************************DTSBX774
|
|
00157 * THE LIQUIDATION TABLE CONTAINS ONE ENTRY FOR EACH LIQUIDATION DTSBX774
|
|
00158 * PROCESSED DURING THE REPORT QUARTER FOR A GIVEN EMPLOYER/QUARTERDTSBX774
|
|
00159 * THE PROCESSED DATE AND THE AMOUNT COME FROM THE DTSIY774 RECORD.DTSBX774
|
|
00160 * THE AMOUNT APPLIED IS THE PORTION OF LT-AMOUNT APPLIED TO DTSBX774
|
|
00161 * RECEIVABLES THAT HAVE NOT BEEN REMOVED (EITHER DURING THE REPORTDTSBX774
|
|
00162 * QUARTER OR PREVIOUSLY). THE TIMELY INDICATOR MARKS LIQUIDATIONS DTSBX774
|
|
00163 * APPLIED TO RECEIVABLES ESTABLISHED DURING THE REPORT QUARTER DTSBX774
|
|
00164 * WHERE THE RECEIVABLE IS COMPLETELY LIQUIDATED PRIOR TO THE DTSBX774
|
|
00165 * TAX DUE DATE. SINCE THERE WAS NEVER A PAST DUE BALANCE, THESE DTSBX774
|
|
00166 * ARE NOT ACTUAL RECEIVABLES AND ARE NOT REPORTED ON THE 581. DTSBX774
|
|
00167 ******************************************************************DTSBX774
|
|
00168 05 LT-SUB PIC S9(04) COMP VALUE +0. DTSBX774
|
|
00169 05 LT-LAST PIC S9(04) COMP VALUE +0. DTSBX774
|
|
00170 05 LT-MAX PIC S9(04) COMP VALUE +200. DTSBX774
|
|
00171 05 LIQUIDATION-TABLE OCCURS 200 TIMES. DTSBX774
|
|
00172 10 LT-PROCESSED-DATE PIC S9(09) COMP-3. DTSBX774
|
|
00173 10 LT-RCVD-DATE PIC S9(09) COMP-3. DTSBX774
|
|
00174 10 LT-AMT PIC S9(09)V99 COMP-3. DTSBX774
|
|
00175 DTSBX774
|
|
00176 ******************************************************************DTSBX774
|
|
00177 * THE LIQUIDATION APPLIED TABLE RELATES LIQUIDATIONS TO THE DTSBX774
|
|
00178 * RECEIVABLES TO WHICH THEY ARE APPLIED. LA-LIQD-IDX IS DTSBX774
|
|
00179 * THE SUBSCRIPT OF THE LIQUIDATION. LA-RCVBL-IDX IS THE DTSBX774
|
|
00180 * SUBSCRIPT OF THE RELATED RECEIVABLE. DTSBX774
|
|
00181 ******************************************************************DTSBX774
|
|
00182 05 LA-SUB PIC S9(04) COMP VALUE +0. DTSBX774
|
|
00183 05 LA-LAST PIC S9(04) COMP VALUE +0. DTSBX774
|
|
00184 05 LA-MAX PIC S9(04) COMP VALUE +200. DTSBX774
|
|
00185 05 LIQUIDATION-APPLIED-TABLE OCCURS 200 TIMES. DTSBX774
|
|
00186 10 LA-LIQD-IDX PIC S9(04) COMP. DTSBX774
|
|
00187 10 LA-RCVBL-IDX PIC S9(04) COMP. DTSBX774
|
|
00188 10 LA-AMT PIC S9(09)V99 COMP-3. DTSBX774
|
|
00189 DTSBX774
|
|
00190 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX774
|
|
00191 05 WRK-EMP-CLASS PIC X(01). DTSBX774
|
|
00192 88 WRK-EMP-CLASS-CONTRIB-88 VALUE 'R'. DTSBX774
|
|
00193 88 WRK-EMP-CLASS-REIMB-88 VALUE 'S'. DTSBX774
|
|
00194 05 WRK-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX774
|
|
00195 05 WRK-DUE-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX774
|
|
00196 05 WRK-LIQD-AMT PIC S9(11)V99 COMP-3. DTSBX774
|
|
00197 05 WRK-LIQD-REMAINING PIC S9(11)V99 COMP-3. DTSBX774
|
|
00198 05 WRK-AMT-APPLIED PIC S9(11)V99 COMP-3. DTSBX774
|
|
00199 05 WRK-P5200-AMT PIC S9(11)V99 COMP-3. DTSBX774
|
|
00200 05 WRK-RQ-END-ABS PIC S9(08) COMP. DTSBX774
|
|
00201 05 WRK-ERQ-END-ABS PIC S9(08) COMP. DTSBX774
|
|
00202 05 WRK-AGE PIC S9(05) COMP-3. DTSBX774
|
|
00203 DTSBX774
|
|
00204 05 X774-DATA. DTSBX774
|
|
00205 10 X774-OBS-NBR PIC 9(07). DTSBX774
|
|
00206 10 X774-EMP-NO PIC 9(07). DTSBX774
|
|
00207 10 X774-EMP-TYPE PIC X(24). DTSBX774
|
|
00208 10 X774-TRANS-DATE PIC X(10). DTSBX774
|
|
00209 10 X774-ESTB-Q-DATE PIC X(10). DTSBX774
|
|
00210 10 X774-EMP-RPT-QTR PIC 9(06). DTSBX774
|
|
00211 10 X774-DUE-DATE PIC X(10). DTSBX774
|
|
00212 10 X774-TRANS-TYPE PIC X(01). DTSBX774
|
|
00213 88 X774-TRANS-ESTB-RQ-88 VALUE 'E'. DTSBX774
|
|
00214 88 X774-TRANS-LIQUIDATE-88 VALUE 'L'. DTSBX774
|
|
00215 88 X774-TRANS-UNCOLLECT-88 VALUE 'U'. DTSBX774
|
|
00216 88 X774-TRANS-REMOVED-88 VALUE 'R'. DTSBX774
|
|
00217 88 X774-TRANS-BALANCE-88 VALUE 'B'. DTSBX774
|
|
00218 10 X774-AMT-ESTB-IN-RQ PIC --------9.99. DTSBX774
|
|
00219 10 X774-LIQUIDATED PIC --------9.99. DTSBX774
|
|
00220 10 X774-UNCOLLECT PIC --------9.99. DTSBX774
|
|
00221 10 X774-REMOVED PIC --------9.99. DTSBX774
|
|
00222 10 X774-BALANCE PIC --------9.99. DTSBX774
|
|
00223 10 X774-AGE PIC 9(05). DTSBX774
|
|
00224 DTSBX774
|
|
00225 05 WRK-REMOVED-CON PIC S9(11)V99 COMP-3. DTSBX774
|
|
00226 05 WRK-REMOVED-RMB PIC S9(11)V99 COMP-3. DTSBX774
|
|
00227 05 WRK-UNTIMELY-IND PIC X(01). DTSBX774
|
|
00228 88 WRK-UNTIMELY-YES-88 VALUE 'Y'. DTSBX774
|
|
00229 88 WRK-UNTIMELY-NO-88 VALUE 'N'. DTSBX774
|
|
00230 DTSBX774
|
|
00231 05 WRK-COUNT-EMP-IND PIC X(01) VALUE 'N'. DTSBX774
|
|
00232 88 WRK-COUNT-EMP-YES-88 VALUE 'Y'. DTSBX774
|
|
00233 88 WRK-COUNT-EMP-NO-88 VALUE 'N'. DTSBX774
|
|
00234 DTSBX774
|
|
00235 05 WRK-6-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774
|
|
00236 05 WRK-9-MONTHS-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX774
|
|
00237 05 WRK-9-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774
|
|
00238 05 WRK-12-MONTHS-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX774
|
|
00239 05 WRK-12-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774
|
|
00240 05 WRK-15-MONTHS-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX774
|
|
00241 05 WRK-15-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774
|
|
00242 05 WRK-OVER-15-MONTHS-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX774
|
|
00243 DTSBX774
|
|
00244 05 WRK-OBS-NBR PIC S9(07) COMP-3 VALUE +0. DTSBX774
|
|
00245 DTSBX774
|
|
00246 05 WRK-EMP-CLASS-AREA. DTSBX774
|
|
00247 10 WRK-DV-EMP-CLASS PIC X(01). DTSBX774
|
|
00248 88 WRK-DV-EMP-CLASS-CONTRIB-88 VALUE 'C'. DTSBX774
|
|
00249 88 WRK-DV-EMP-CLASS-REIMB-88 VALUE 'R'. DTSBX774
|
|
00250 10 FILLER PIC X(01) VALUE '-'. DTSBX774
|
|
00251 10 WRK-MPRF-EMP-CLASS PIC X(01). DTSBX774
|
|
00252 10 FILLER PIC X(21) VALUE SPACES. DTSBX774
|
|
00253 05 WRK-EMP-CLASS-DISP REDEFINES WRK-EMP-CLASS-AREA DTSBX774
|
|
00254 PIC X(24). DTSBX774
|
|
00255 DTSBX774
|
|
00256 05 WRK-RPT-QTR-AREA. DTSBX774
|
|
00257 10 WRK-RPT-QTR-YR PIC X(04). DTSBX774
|
|
00258 10 WRK-RPT-QTR-SLASH PIC X(01). DTSBX774
|
|
00259 10 WRK-RPT-QTR-Q PIC X(01). DTSBX774
|
|
00260 05 WRK-RPT-QTR-9 REDEFINES WRK-RPT-QTR-AREA PIC 9(06). DTSBX774
|
|
00261 DTSBX774
|
|
00262 05 WRK-ETA581-DATA-AREA. DTSBX774
|
|
00263 10 WRK-CON-RECVBL-BEG-PERIOD DTSBX774
|
|
00264 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00265 10 WRK-CON-RECVBL-DETERM DTSBX774
|
|
00266 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00267 10 WRK-CON-RECVBL-LIQUID DTSBX774
|
|
00268 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00269 10 WRK-CON-RECVBL-UNCOLLECT DTSBX774
|
|
00270 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00271 10 WRK-CON-RECVBL-REMOVED DTSBX774
|
|
00272 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00273 10 WRK-CON-RECVBL-END-PERIOD DTSBX774
|
|
00274 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00275 10 WRK-CON-RECVBL-EMP-CNT DTSBX774
|
|
00276 PIC S9(07) COMP-3. DTSBX774
|
|
00277 10 WRK-CON-RECVBL-6-MOS DTSBX774
|
|
00278 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00279 10 WRK-CON-RECVBL-9-MOS DTSBX774
|
|
00280 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00281 10 WRK-CON-RECVBL-12-MOS DTSBX774
|
|
00282 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00283 10 WRK-CON-RECVBL-15-MOS DTSBX774
|
|
00284 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00285 10 WRK-CON-RECVBL-OVER15-MOS DTSBX774
|
|
00286 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00287 DTSBX774
|
|
00288 10 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774
|
|
00289 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00290 10 WRK-REIMB-RECVBL-DETERM DTSBX774
|
|
00291 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00292 10 WRK-REIMB-RECVBL-LIQUID DTSBX774
|
|
00293 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00294 10 WRK-REIMB-RECVBL-UNCOLLECT DTSBX774
|
|
00295 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00296 10 WRK-REIMB-RECVBL-REMOVED DTSBX774
|
|
00297 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00298 10 WRK-REIMB-RECVBL-END-PERIOD DTSBX774
|
|
00299 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00300 10 WRK-REIMB-RECVBL-EMP-CNT DTSBX774
|
|
00301 PIC S9(07) COMP-3. DTSBX774
|
|
00302 10 WRK-REIMB-RECVBL-6-MOS DTSBX774
|
|
00303 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00304 10 WRK-REIMB-RECVBL-9-MOS DTSBX774
|
|
00305 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00306 10 WRK-REIMB-RECVBL-12-MOS DTSBX774
|
|
00307 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00308 10 WRK-REIMB-RECVBL-15-MOS DTSBX774
|
|
00309 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00310 10 WRK-REIMB-RECVBL-OVER15-MOS DTSBX774
|
|
00311 PIC S9(11)V9(02) COMP-3. DTSBX774
|
|
00312 DTSBX774
|
|
00313 05 WRK-RECS-WRITTEN-CNT PIC S9(07) COMP-3 DTSBX774
|
|
00314 VALUE +0. DTSBX774
|
|
00315 DTSBX774
|
|
00316 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBX774
|
|
00317 VALUE +010169. DTSBX774
|
|
00318 DTSBX774
|
|
00319 05 DISPLAY-CNT PIC Z(06)9. DTSBX774
|
|
00320 05 DISPLAY-AMT-X PIC X(15). DTSBX774
|
|
00321 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX774
|
|
00322 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX774
|
|
00323 EJECT DTSBX774
|
|
00324 01 L001-LINK-AREA. DTSBX774
|
|
00325 ++INCLUDE DTSIL001 DTSBX774
|
|
00326 EJECT DTSBX774
|
|
00327 01 L004-LINK-AREA. DTSBX774
|
|
00328 ++INCLUDE DTSIL004 DTSBX774
|
|
00329 EJECT DTSBX774
|
|
00330 SKIP3 DTSBX774
|
|
00331 01 Y774-REC. DTSBX774
|
|
00332 ++INCLUDE DTSIY774 DTSBX774
|
|
00333 EJECT DTSBX774
|
|
00334 LINKAGE SECTION. DTSBX774
|
|
00335 SKIP3 DTSBX774
|
|
00336 01 XL774-LINK-AREA. DTSBX774
|
|
00337 ++INCLUDE DTSXL774 DTSBX774
|
|
00338 DTSBX774
|
|
00339 01 X770-PARM-REC. DTSBX774
|
|
00340 ++INCLUDE DTSIX770 DTSBX774
|
|
00341 DTSBX774
|
|
00342 01 RSKL-REC. DTSBX774
|
|
00343 ++INCLUDE DTSIRSK1 DTSBX774
|
|
00344 EJECT DTSBX774
|
|
00345 PROCEDURE DIVISION USING XL774-LINK-AREA DTSBX774
|
|
00346 X770-PARM-REC DTSBX774
|
|
00347 RSKL-REC. DTSBX774
|
|
00348 DTSBX774
|
|
00349 IF XL774-CMD-PROCESS-88 DTSBX774
|
|
00350 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX774
|
|
00351 ELSE DTSBX774
|
|
00352 IF XL774-CMD-INIT-88 DTSBX774
|
|
00353 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX774
|
|
00354 ELSE DTSBX774
|
|
00355 IF XL774-CMD-TERMINATE-88 DTSBX774
|
|
00356 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX774
|
|
00357 ELSE DTSBX774
|
|
00358 MOVE 'INVALID L770-CALL-TYPE-IND ENCOUNTERED' DTSBX774
|
|
00359 TO ABEND-MSG DTSBX774
|
|
00360 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
00361 SKIP2 DTSBX774
|
|
00362 GOBACK. DTSBX774
|
|
00363 EJECT DTSBX774
|
|
00364 I0000-INITIALIZE. DTSBX774
|
|
00365 MOVE +0 TO RT-SUB DTSBX774
|
|
00366 LT-SUB. DTSBX774
|
|
00367 DTSBX774
|
|
00368 MOVE +0 TO WRK-REMOVED-CON DTSBX774
|
|
00369 WRK-REMOVED-RMB. DTSBX774
|
|
00370 OPEN OUTPUT ACCTS-RECEIVABLE DTSBX774
|
|
00371 IF NOT X774-STATUS-OK-88 DTSBX774
|
|
00372 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774
|
|
00373 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX774
|
|
00374 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
00375 DTSBX774
|
|
00376 PERFORM I1000-INIT-581-COUNTS THRU I1000-EXIT. DTSBX774
|
|
00377 DTSBX774
|
|
00378 PERFORM I2000-AGING-QTRS THRU I2000-EXIT. DTSBX774
|
|
00379 DTSBX774
|
|
00380 I0000-EXIT. DTSBX774
|
|
00381 EXIT. DTSBX774
|
|
00382 DTSBX774
|
|
00383 I1000-INIT-581-COUNTS. DTSBX774
|
|
00384 MOVE +0 TO WRK-CON-RECVBL-BEG-PERIOD DTSBX774
|
|
00385 WRK-CON-RECVBL-DETERM DTSBX774
|
|
00386 WRK-CON-RECVBL-LIQUID DTSBX774
|
|
00387 WRK-CON-RECVBL-UNCOLLECT DTSBX774
|
|
00388 WRK-CON-RECVBL-REMOVED DTSBX774
|
|
00389 WRK-CON-RECVBL-END-PERIOD DTSBX774
|
|
00390 WRK-CON-RECVBL-EMP-CNT DTSBX774
|
|
00391 WRK-CON-RECVBL-6-MOS DTSBX774
|
|
00392 WRK-CON-RECVBL-9-MOS DTSBX774
|
|
00393 WRK-CON-RECVBL-12-MOS DTSBX774
|
|
00394 WRK-CON-RECVBL-15-MOS DTSBX774
|
|
00395 WRK-CON-RECVBL-OVER15-MOS DTSBX774
|
|
00396 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774
|
|
00397 WRK-REIMB-RECVBL-DETERM DTSBX774
|
|
00398 WRK-REIMB-RECVBL-LIQUID DTSBX774
|
|
00399 WRK-REIMB-RECVBL-UNCOLLECT DTSBX774
|
|
00400 WRK-REIMB-RECVBL-REMOVED DTSBX774
|
|
00401 WRK-REIMB-RECVBL-END-PERIOD DTSBX774
|
|
00402 WRK-REIMB-RECVBL-EMP-CNT DTSBX774
|
|
00403 WRK-REIMB-RECVBL-6-MOS DTSBX774
|
|
00404 WRK-REIMB-RECVBL-9-MOS DTSBX774
|
|
00405 WRK-REIMB-RECVBL-12-MOS DTSBX774
|
|
00406 WRK-REIMB-RECVBL-15-MOS DTSBX774
|
|
00407 WRK-REIMB-RECVBL-OVER15-MOS. DTSBX774
|
|
00408 DTSBX774
|
|
00409 DTSBX774
|
|
00410 I1000-EXIT. DTSBX774
|
|
00411 EXIT. DTSBX774
|
|
00412 DTSBX774
|
|
00413 I2000-AGING-QTRS. DTSBX774
|
|
00414 MOVE X770-SUBJECT-QTR TO L004-QTR-5-9. DTSBX774
|
|
00415 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX774
|
|
00416 SUBTRACT 3 FROM L004-ABS-QTR. DTSBX774
|
|
00417 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX774
|
|
00418 MOVE L004-QTR-5-9 TO WRK-9-MONTHS-QTR. DTSBX774
|
|
00419 DTSBX774
|
|
00420 SUBTRACT 1 FROM L004-ABS-QTR. DTSBX774
|
|
00421 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX774
|
|
00422 MOVE L004-QTR-5-9 TO WRK-12-MONTHS-QTR. DTSBX774
|
|
00423 DTSBX774
|
|
00424 SUBTRACT 1 FROM L004-ABS-QTR. DTSBX774
|
|
00425 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX774
|
|
00426 MOVE L004-QTR-5-9 TO WRK-15-MONTHS-QTR. DTSBX774
|
|
00427 DTSBX774
|
|
00428 I2000-EXIT. DTSBX774
|
|
00429 EXIT. DTSBX774
|
|
00430 DTSBX774
|
|
00431 P0000-PROCESS. DTSBX774
|
|
00432 MOVE RSKL-REC TO Y774-REC. DTSBX774
|
|
00433 DTSBX774
|
|
00434 IF WRK-EMP-NO = ZERO DTSBX774
|
|
00435 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX774
|
|
00436 PERFORM P1000-BUILD-TABLES THRU P1000-EXIT DTSBX774
|
|
00437 ELSE DTSBX774
|
|
00438 IF Y774-EMP-NO = WRK-EMP-NO DTSBX774
|
|
00439 AND Y774-YRQ = WRK-YRQ DTSBX774
|
|
00440 PERFORM P1000-BUILD-TABLES THRU P1000-EXIT DTSBX774
|
|
00441 ELSE DTSBX774
|
|
00442 PERFORM P2000-STARTING-BALANCE THRU P2000-EXIT DTSBX774
|
|
00443 PERFORM P3000-SET-581-TYPE THRU P3000-EXIT DTSBX774
|
|
00444 PERFORM P4000-RPT-QTR-LIQUIDATIONS THRU P4000-EXIT DTSBX774
|
|
00445 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT DTSBX774
|
|
00446 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX774
|
|
00447 PERFORM P1000-BUILD-TABLES THRU P1000-EXIT. DTSBX774
|
|
00448 DTSBX774
|
|
00449 P0000-EXIT. DTSBX774
|
|
00450 EXIT. DTSBX774
|
|
00451 DTSBX774
|
|
00452 DTSBX774
|
|
00453 P1000-BUILD-TABLES. DTSBX774
|
|
00454 IF Y774-TYPE-RECEIVABLE-88 DTSBX774
|
|
00455 PERFORM P1100-BUILD-RCVBL-TABLE THRU P1100-EXIT DTSBX774
|
|
00456 ELSE DTSBX774
|
|
00457 IF Y774-TYPE-LIQUIDATION-88 DTSBX774
|
|
00458 PERFORM P1200-BUILD-LIQD-TABLE THRU P1200-EXIT. DTSBX774
|
|
00459 DTSBX774
|
|
00460 P1000-EXIT. DTSBX774
|
|
00461 EXIT. DTSBX774
|
|
00462 DTSBX774
|
|
00463 P1100-BUILD-RCVBL-TABLE. DTSBX774
|
|
00464 IF RT-SUB < RT-MAX DTSBX774
|
|
00465 ADD +1 TO RT-SUB DTSBX774
|
|
00466 RT-LAST DTSBX774
|
|
00467 ELSE DTSBX774
|
|
00468 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX774
|
|
00469 TO ABEND-MSG DTSBX774
|
|
00470 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
00471 DTSBX774
|
|
00472 MOVE Y774-ESTB-DATE TO RT-PROCESSED-DATE (RT-SUB). DTSBX774
|
|
00473 MOVE Y774-RCVD-DATE TO RT-RECEIVED-DATE (RT-SUB). DTSBX774
|
|
00474 MOVE Y774-AMT TO RT-AMT (RT-SUB) DTSBX774
|
|
00475 RT-START-BALANCE (RT-SUB) DTSBX774
|
|
00476 RT-END-BALANCE (RT-SUB). DTSBX774
|
|
00477 P1100-EXIT. DTSBX774
|
|
00478 EXIT. DTSBX774
|
|
00479 DTSBX774
|
|
00480 P1200-BUILD-LIQD-TABLE. DTSBX774
|
|
00481 DTSBX774
|
|
00482 IF Y774-ESTB-DATE < X770-SUBJECT-QTR-START DTSBX774
|
|
00483 ADD Y774-AMT TO WRK-LIQD-AMT DTSBX774
|
|
00484 ELSE DTSBX774
|
|
00485 IF LT-SUB < LT-MAX DTSBX774
|
|
00486 ADD +1 TO LT-SUB DTSBX774
|
|
00487 LT-LAST DTSBX774
|
|
00488 MOVE Y774-ESTB-DATE TO LT-PROCESSED-DATE (LT-SUB) DTSBX774
|
|
00489 MOVE Y774-RCVD-DATE TO LT-RCVD-DATE (LT-SUB) DTSBX774
|
|
00490 MOVE Y774-AMT TO LT-AMT (LT-SUB) DTSBX774
|
|
00491 ELSE DTSBX774
|
|
00492 MOVE 'LIQUIDATION TABLE LENGTH EXCEEDED' DTSBX774
|
|
00493 TO ABEND-MSG DTSBX774
|
|
00494 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
00495 DTSBX774
|
|
00496 P1200-EXIT. DTSBX774
|
|
00497 EXIT. DTSBX774
|
|
00498 DTSBX774
|
|
00499 P1300-INIT-TABLES. DTSBX774
|
|
00500 IF Y774-EMP-NO NOT = WRK-EMP-NO DTSBX774
|
|
00501 IF WRK-COUNT-EMP-YES-88 DTSBX774
|
|
00502 SET WRK-COUNT-EMP-NO-88 TO TRUE DTSBX774
|
|
00503 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
00504 ADD +1 TO WRK-CON-RECVBL-EMP-CNT DTSBX774
|
|
00505 ELSE DTSBX774
|
|
00506 ADD +1 TO WRK-REIMB-RECVBL-EMP-CNT DTSBX774
|
|
00507 END-IF DTSBX774
|
|
00508 END-IF DTSBX774
|
|
00509 END-IF. DTSBX774
|
|
00510 DTSBX774
|
|
00511 MOVE Y774-EMP-NO TO WRK-EMP-NO. DTSBX774
|
|
00512 MOVE Y774-EMP-CLASS TO WRK-EMP-CLASS. DTSBX774
|
|
00513 MOVE Y774-YRQ TO WRK-YRQ. DTSBX774
|
|
00514 MOVE Y774-DUE-DATE TO WRK-DUE-DATE. DTSBX774
|
|
00515 DTSBX774
|
|
00516 PERFORM DTSBX774
|
|
00517 VARYING RT-SUB FROM +1 BY +1 DTSBX774
|
|
00518 UNTIL RT-SUB > RT-MAX DTSBX774
|
|
00519 MOVE +0 TO RT-PROCESSED-DATE (RT-SUB) DTSBX774
|
|
00520 RT-RECEIVED-DATE (RT-SUB) DTSBX774
|
|
00521 RT-AMT (RT-SUB) DTSBX774
|
|
00522 RT-START-BALANCE (RT-SUB) DTSBX774
|
|
00523 RT-END-BALANCE (RT-SUB) DTSBX774
|
|
00524 MOVE SPACES TO RT-581-TYPE (RT-SUB) DTSBX774
|
|
00525 END-PERFORM. DTSBX774
|
|
00526 DTSBX774
|
|
00527 PERFORM DTSBX774
|
|
00528 VARYING LT-SUB FROM +1 BY +1 DTSBX774
|
|
00529 UNTIL LT-SUB > LT-MAX DTSBX774
|
|
00530 MOVE +0 TO LT-PROCESSED-DATE (LT-SUB) DTSBX774
|
|
00531 LT-RCVD-DATE (LT-SUB) DTSBX774
|
|
00532 LT-AMT (LT-SUB) DTSBX774
|
|
00533 END-PERFORM. DTSBX774
|
|
00534 DTSBX774
|
|
00535 PERFORM DTSBX774
|
|
00536 VARYING LA-SUB FROM +1 BY +1 DTSBX774
|
|
00537 UNTIL LA-SUB > LA-MAX DTSBX774
|
|
00538 MOVE +0 TO LA-RCVBL-IDX (LA-SUB) DTSBX774
|
|
00539 LA-LIQD-IDX (LA-SUB) DTSBX774
|
|
00540 LA-AMT (LA-SUB) DTSBX774
|
|
00541 END-PERFORM. DTSBX774
|
|
00542 DTSBX774
|
|
00543 MOVE +0 TO RT-SUB DTSBX774
|
|
00544 RT-LAST DTSBX774
|
|
00545 LT-SUB DTSBX774
|
|
00546 LT-LAST DTSBX774
|
|
00547 LA-SUB DTSBX774
|
|
00548 LA-LAST DTSBX774
|
|
00549 WRK-LIQD-AMT DTSBX774
|
|
00550 WRK-LIQD-REMAINING. DTSBX774
|
|
00551 DTSBX774
|
|
00552 P1300-EXIT. DTSBX774
|
|
00553 EXIT. DTSBX774
|
|
00554 DTSBX774
|
|
00555 DTSBX774
|
|
00556 P2000-STARTING-BALANCE. DTSBX774
|
|
00557 COMPUTE WRK-LIQD-REMAINING = (WRK-LIQD-AMT * -1). DTSBX774
|
|
00558 DTSBX774
|
|
00559 PERFORM DTSBX774
|
|
00560 VARYING RT-SUB FROM +1 BY +1 DTSBX774
|
|
00561 UNTIL RT-SUB > RT-LAST DTSBX774
|
|
00562 OR WRK-LIQD-REMAINING NOT > ZERO DTSBX774
|
|
00563 IF RT-START-BALANCE (RT-SUB) > ZERO DTSBX774
|
|
00564 IF WRK-LIQD-REMAINING >= RT-START-BALANCE (RT-SUB) DTSBX774
|
|
00565 SUBTRACT RT-START-BALANCE (RT-SUB) FROM DTSBX774
|
|
00566 WRK-LIQD-REMAINING DTSBX774
|
|
00567 MOVE ZERO TO RT-START-BALANCE (RT-SUB) DTSBX774
|
|
00568 ELSE DTSBX774
|
|
00569 SUBTRACT WRK-LIQD-REMAINING FROM DTSBX774
|
|
00570 RT-START-BALANCE (RT-SUB) DTSBX774
|
|
00571 MOVE ZERO TO WRK-LIQD-REMAINING DTSBX774
|
|
00572 END-IF DTSBX774
|
|
00573 END-IF DTSBX774
|
|
00574 END-PERFORM. DTSBX774
|
|
00575 DTSBX774
|
|
00576 P2000-EXIT. DTSBX774
|
|
00577 EXIT. DTSBX774
|
|
00578 DTSBX774
|
|
00579 P3000-SET-581-TYPE. DTSBX774
|
|
00580 PERFORM P3100-SCAN-TABLE THRU P3100-EXIT DTSBX774
|
|
00581 VARYING RT-SUB FROM +1 BY +1 DTSBX774
|
|
00582 UNTIL RT-SUB > RT-LAST. DTSBX774
|
|
00583 DTSBX774
|
|
00584 P3000-EXIT. DTSBX774
|
|
00585 EXIT. DTSBX774
|
|
00586 DTSBX774
|
|
00587 P3100-SCAN-TABLE. DTSBX774
|
|
00588 MOVE RT-START-BALANCE (RT-SUB) TO DTSBX774
|
|
00589 RT-END-BALANCE (RT-SUB). DTSBX774
|
|
00590 DTSBX774
|
|
00591 IF RT-PROCESSED-DATE (RT-SUB) >= DTSBX774
|
|
00592 X770-SUBJECT-QTR-START DTSBX774
|
|
00593 AND RT-PROCESSED-DATE (RT-SUB) <= DTSBX774
|
|
00594 X770-SUBJECT-QTR-END DTSBX774
|
|
00595 SET RT-581-TYPE-ESTABLISHED-88 (RT-SUB) TO TRUE DTSBX774
|
|
00596 ELSE DTSBX774
|
|
00597 IF RT-START-BALANCE (RT-SUB) > ZERO DTSBX774
|
|
00598 PERFORM P3110-PRIOR-QTRS THRU P3110-EXIT. DTSBX774
|
|
00599 DTSBX774
|
|
00600 P3100-EXIT. DTSBX774
|
|
00601 EXIT. DTSBX774
|
|
00602 DTSBX774
|
|
00603 P3110-PRIOR-QTRS. DTSBX774
|
|
00604 EVALUATE TRUE DTSBX774
|
|
00605 WHEN WRK-YRQ > X770-QTR8 DTSBX774
|
|
00606 SET RT-581-TYPE-BALANCE-88 (RT-SUB) TO TRUE DTSBX774
|
|
00607 DTSBX774
|
|
00608 WHEN WRK-YRQ = X770-QTR8 DTSBX774
|
|
00609 IF RT-PROCESSED-DATE (RT-SUB) < X770-QTR1-START DTSBX774
|
|
00610 SET RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) TO TRUE DTSBX774
|
|
00611 ELSE DTSBX774
|
|
00612 SET RT-581-TYPE-BALANCE-88 (RT-SUB) TO TRUE DTSBX774
|
|
00613 END-IF DTSBX774
|
|
00614 DTSBX774
|
|
00615 WHEN WRK-YRQ < X770-QTR8 DTSBX774
|
|
00616 IF RT-PROCESSED-DATE (RT-SUB) < X770-QTR2-START DTSBX774
|
|
00617 SET RT-581-TYPE-REMOVED-PRIOR-88 (RT-SUB) TO TRUE DTSBX774
|
|
00618 ELSE DTSBX774
|
|
00619 IF RT-PROCESSED-DATE (RT-SUB) < X770-QTR1-START DTSBX774
|
|
00620 SET RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) TO TRUE DTSBX774
|
|
00621 ELSE DTSBX774
|
|
00622 SET RT-581-TYPE-BALANCE-88 (RT-SUB) TO TRUE DTSBX774
|
|
00623 END-IF DTSBX774
|
|
00624 END-IF DTSBX774
|
|
00625 DTSBX774
|
|
00626 END-EVALUATE. DTSBX774
|
|
00627 DTSBX774
|
|
00628 P3110-EXIT. DTSBX774
|
|
00629 EXIT. DTSBX774
|
|
00630 DTSBX774
|
|
00631 P4000-RPT-QTR-LIQUIDATIONS. DTSBX774
|
|
00632 PERFORM DTSBX774
|
|
00633 VARYING LT-SUB FROM +1 BY +1 DTSBX774
|
|
00634 UNTIL LT-SUB > LT-LAST DTSBX774
|
|
00635 COMPUTE WRK-LIQD-REMAINING = (LT-AMT (LT-SUB) * -1) DTSBX774
|
|
00636 PERFORM P4100-APPLY-LIQD THRU P4100-EXIT DTSBX774
|
|
00637 END-PERFORM. DTSBX774
|
|
00638 DTSBX774
|
|
00639 P4000-EXIT. DTSBX774
|
|
00640 EXIT. DTSBX774
|
|
00641 DTSBX774
|
|
00642 P4100-APPLY-LIQD. DTSBX774
|
|
00643 PERFORM DTSBX774
|
|
00644 VARYING RT-SUB FROM +1 BY +1 DTSBX774
|
|
00645 UNTIL RT-SUB > RT-LAST DTSBX774
|
|
00646 OR WRK-LIQD-REMAINING NOT > ZERO DTSBX774
|
|
00647 PERFORM P4110-APPLY THRU P4110-EXIT DTSBX774
|
|
00648 END-PERFORM. DTSBX774
|
|
00649 DTSBX774
|
|
00650 P4100-EXIT. DTSBX774
|
|
00651 EXIT. DTSBX774
|
|
00652 DTSBX774
|
|
00653 P4110-APPLY. DTSBX774
|
|
00654 IF RT-END-BALANCE (RT-SUB) > ZERO DTSBX774
|
|
00655 IF WRK-LIQD-REMAINING >= RT-END-BALANCE (RT-SUB) DTSBX774
|
|
00656 SUBTRACT RT-END-BALANCE (RT-SUB) FROM DTSBX774
|
|
00657 WRK-LIQD-REMAINING DTSBX774
|
|
00658 MOVE RT-END-BALANCE (RT-SUB) TO WRK-AMT-APPLIED DTSBX774
|
|
00659 MOVE ZERO TO RT-END-BALANCE (RT-SUB) DTSBX774
|
|
00660 PERFORM P4111-BUILD-LA-TABLE THRU P4111-EXIT DTSBX774
|
|
00661 ELSE DTSBX774
|
|
00662 SUBTRACT WRK-LIQD-REMAINING FROM DTSBX774
|
|
00663 RT-END-BALANCE (RT-SUB) DTSBX774
|
|
00664 MOVE WRK-LIQD-REMAINING TO WRK-AMT-APPLIED DTSBX774
|
|
00665 MOVE ZERO TO WRK-LIQD-REMAINING DTSBX774
|
|
00666 PERFORM P4111-BUILD-LA-TABLE THRU P4111-EXIT DTSBX774
|
|
00667 END-IF DTSBX774
|
|
00668 END-IF. DTSBX774
|
|
00669 DTSBX774
|
|
00670 P4110-EXIT. DTSBX774
|
|
00671 EXIT. DTSBX774
|
|
00672 DTSBX774
|
|
00673 P4111-BUILD-LA-TABLE. DTSBX774
|
|
00674 IF RT-581-TYPE-REMOVED-88 (RT-SUB) DTSBX774
|
|
00675 GO TO P4111-EXIT. DTSBX774
|
|
00676 DTSBX774
|
|
00677 IF LA-SUB < LA-MAX DTSBX774
|
|
00678 ADD +1 TO LA-SUB DTSBX774
|
|
00679 LA-LAST DTSBX774
|
|
00680 MOVE RT-SUB TO LA-RCVBL-IDX (LA-SUB) DTSBX774
|
|
00681 MOVE LT-SUB TO LA-LIQD-IDX (LA-SUB) DTSBX774
|
|
00682 MOVE WRK-AMT-APPLIED TO LA-AMT (LA-SUB) DTSBX774
|
|
00683 ELSE DTSBX774
|
|
00684 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX774
|
|
00685 TO ABEND-MSG DTSBX774
|
|
00686 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
00687 DTSBX774
|
|
00688 DTSBX774
|
|
00689 P4111-EXIT. DTSBX774
|
|
00690 EXIT. DTSBX774
|
|
00691 DTSBX774
|
|
00692 P5000-WRITE-OUTPUT. DTSBX774
|
|
00693 PERFORM DTSBX774
|
|
00694 VARYING RT-SUB FROM +1 BY +1 DTSBX774
|
|
00695 UNTIL RT-SUB > RT-LAST DTSBX774
|
|
00696 DTSBX774
|
|
00697 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774
|
|
00698 IF RT-END-BALANCE (RT-SUB) > ZERO DTSBX774
|
|
00699 PERFORM P5100-BUILD-RCVB-X774 THRU P5100-EXIT DTSBX774
|
|
00700 PERFORM P5200-BUILD-LIQD-X774 THRU P5200-EXIT DTSBX774
|
|
00701 ELSE DTSBX774
|
|
00702 PERFORM P5010-CHECK-UNTIMELY THRU P5010-EXIT DTSBX774
|
|
00703 IF WRK-UNTIMELY-YES-88 DTSBX774
|
|
00704 PERFORM P5100-BUILD-RCVB-X774 THRU P5100-EXIT DTSBX774
|
|
00705 PERFORM P5200-BUILD-LIQD-X774 THRU P5200-EXIT DTSBX774
|
|
00706 END-IF DTSBX774
|
|
00707 END-IF DTSBX774
|
|
00708 END-IF DTSBX774
|
|
00709 DTSBX774
|
|
00710 IF RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774
|
|
00711 OR RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) DTSBX774
|
|
00712 PERFORM P5100-BUILD-RCVB-X774 THRU P5100-EXIT DTSBX774
|
|
00713 PERFORM P5200-BUILD-LIQD-X774 THRU P5200-EXIT DTSBX774
|
|
00714 END-IF DTSBX774
|
|
00715 DTSBX774
|
|
00716 IF RT-581-TYPE-REMOVED-PRIOR-88 (RT-SUB) DTSBX774
|
|
00717 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
00718 ADD RT-END-BALANCE (RT-SUB) TO WRK-REMOVED-CON DTSBX774
|
|
00719 ELSE DTSBX774
|
|
00720 ADD RT-END-BALANCE (RT-SUB) TO WRK-REMOVED-RMB DTSBX774
|
|
00721 END-IF DTSBX774
|
|
00722 END-IF DTSBX774
|
|
00723 END-PERFORM. DTSBX774
|
|
00724 DTSBX774
|
|
00725 P5000-EXIT. DTSBX774
|
|
00726 EXIT. DTSBX774
|
|
00727 DTSBX774
|
|
00728 P5010-CHECK-UNTIMELY. DTSBX774
|
|
00729 SET WRK-UNTIMELY-NO-88 TO TRUE. DTSBX774
|
|
00730 DTSBX774
|
|
00731 PERFORM DTSBX774
|
|
00732 VARYING LA-SUB FROM +1 BY +1 DTSBX774
|
|
00733 UNTIL LA-SUB > LA-LAST DTSBX774
|
|
00734 MOVE LA-LIQD-IDX (LA-SUB) TO LT-SUB DTSBX774
|
|
00735 IF LT-RCVD-DATE (LT-SUB) > WRK-DUE-DATE DTSBX774
|
|
00736 SET WRK-UNTIMELY-YES-88 TO TRUE DTSBX774
|
|
00737 END-IF DTSBX774
|
|
00738 END-PERFORM. DTSBX774
|
|
00739 DTSBX774
|
|
00740 P5010-EXIT. DTSBX774
|
|
00741 EXIT. DTSBX774
|
|
00742 DTSBX774
|
|
00743 P5100-BUILD-RCVB-X774. DTSBX774
|
|
00744 ADD +1 TO WRK-OBS-NBR. DTSBX774
|
|
00745 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX774
|
|
00746 DTSBX774
|
|
00747 MOVE WRK-EMP-NO TO X774-EMP-NO. DTSBX774
|
|
00748 MOVE WRK-OBS-NBR TO X774-OBS-NBR. DTSBX774
|
|
00749 DTSBX774
|
|
00750 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774
|
|
00751 OR RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774
|
|
00752 SET WRK-COUNT-EMP-YES-88 TO TRUE. DTSBX774
|
|
00753 DTSBX774
|
|
00754 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
00755 SET WRK-DV-EMP-CLASS-CONTRIB-88 TO TRUE DTSBX774
|
|
00756 *& DTSBX774
|
|
00757 * GO TO P5100-EXIT DTSBX774
|
|
00758 *& DTSBX774
|
|
00759 ELSE DTSBX774
|
|
00760 IF WRK-EMP-CLASS-REIMB-88 DTSBX774
|
|
00761 SET WRK-DV-EMP-CLASS-REIMB-88 TO TRUE DTSBX774
|
|
00762 ELSE DTSBX774
|
|
00763 DISPLAY 'INVALID EMPLOYER CLASS ' WRK-EMP-NO DTSBX774
|
|
00764 ' CLASS: ' Y774-EMP-CLASS DTSBX774
|
|
00765 GO TO P5100-EXIT. DTSBX774
|
|
00766 DTSBX774
|
|
00767 MOVE WRK-EMP-CLASS TO WRK-MPRF-EMP-CLASS. DTSBX774
|
|
00768 MOVE WRK-EMP-CLASS-DISP TO X774-EMP-TYPE. DTSBX774
|
|
00769 DTSBX774
|
|
00770 MOVE RT-PROCESSED-DATE (RT-SUB) TO L001-FED-8-DATE-9. DTSBX774
|
|
00771 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774
|
|
00772 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774
|
|
00773 MOVE L001-SLASH-8-DATE TO X774-TRANS-DATE DTSBX774
|
|
00774 ELSE DTSBX774
|
|
00775 MOVE SPACES TO X774-TRANS-DATE. DTSBX774
|
|
00776 DTSBX774
|
|
00777 MOVE L001-SLASH-8-DATE TO X774-ESTB-Q-DATE DTSBX774
|
|
00778 DTSBX774
|
|
00779 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBX774
|
|
00780 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX774
|
|
00781 MOVE L004-SLASH-5-QTR TO WRK-RPT-QTR-AREA. DTSBX774
|
|
00782 MOVE '0' TO WRK-RPT-QTR-SLASH. DTSBX774
|
|
00783 MOVE WRK-RPT-QTR-9 TO X774-EMP-RPT-QTR. DTSBX774
|
|
00784 DTSBX774
|
|
00785 MOVE L004-QTR-END-DATE TO L001-FED-8-DATE-9. DTSBX774
|
|
00786 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774
|
|
00787 MOVE L001-JUL-ABS-DAY TO WRK-ERQ-END-ABS. DTSBX774
|
|
00788 DTSBX774
|
|
00789 MOVE X770-SUBJECT-QTR-END TO L001-FED-8-DATE-9. DTSBX774
|
|
00790 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774
|
|
00791 MOVE L001-JUL-ABS-DAY TO WRK-RQ-END-ABS. DTSBX774
|
|
00792 DTSBX774
|
|
00793 MOVE ZERO TO X774-AGE. DTSBX774
|
|
00794 DTSBX774
|
|
00795 COMPUTE WRK-AGE = WRK-RQ-END-ABS - DTSBX774
|
|
00796 WRK-ERQ-END-ABS. DTSBX774
|
|
00797 DTSBX774
|
|
00798 MOVE WRK-DUE-DATE TO L001-FED-8-DATE-9. DTSBX774
|
|
00799 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774
|
|
00800 MOVE L001-SLASH-8-DATE TO X774-DUE-DATE. DTSBX774
|
|
00801 DTSBX774
|
|
00802 MOVE ZEROS TO X774-AMT-ESTB-IN-RQ DTSBX774
|
|
00803 X774-LIQUIDATED DTSBX774
|
|
00804 X774-UNCOLLECT DTSBX774
|
|
00805 X774-REMOVED DTSBX774
|
|
00806 X774-BALANCE. DTSBX774
|
|
00807 DTSBX774
|
|
00808 EVALUATE TRUE DTSBX774
|
|
00809 WHEN RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774
|
|
00810 SET X774-TRANS-ESTB-RQ-88 TO TRUE DTSBX774
|
|
00811 MOVE RT-START-BALANCE (RT-SUB) TO DTSBX774
|
|
00812 X774-AMT-ESTB-IN-RQ DTSBX774
|
|
00813 PERFORM P5110-ESTB THRU P5110-EXIT DTSBX774
|
|
00814 PERFORM P6010-581-ESTB THRU P6010-EXIT DTSBX774
|
|
00815 DTSBX774
|
|
00816 WHEN RT-581-TYPE-REMOVED-NOW-88 (RT-SUB) DTSBX774
|
|
00817 *& SET X774-TRANS-BALANCE-88 TO TRUE DTSBX774
|
|
00818 SET X774-TRANS-REMOVED-88 TO TRUE DTSBX774
|
|
00819 MOVE RT-START-BALANCE (RT-SUB) TO X774-REMOVED DTSBX774
|
|
00820 PERFORM P5120-REM-BAL THRU P5120-EXIT DTSBX774
|
|
00821 PERFORM P6020-581-REMOVE THRU P6020-EXIT DTSBX774
|
|
00822 DTSBX774
|
|
00823 WHEN RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774
|
|
00824 SET X774-TRANS-BALANCE-88 TO TRUE DTSBX774
|
|
00825 MOVE RT-END-BALANCE (RT-SUB) TO X774-BALANCE DTSBX774
|
|
00826 MOVE WRK-AGE TO X774-AGE DTSBX774
|
|
00827 PERFORM P5120-REM-BAL THRU P5120-EXIT DTSBX774
|
|
00828 PERFORM P6030-581-BALANCE THRU P6030-EXIT DTSBX774
|
|
00829 DTSBX774
|
|
00830 END-EVALUATE. DTSBX774
|
|
00831 DTSBX774
|
|
00832 IF RT-581-TYPE-BALANCE-88 (RT-SUB) DTSBX774
|
|
00833 IF RT-END-BALANCE (RT-SUB) = ZERO DTSBX774
|
|
00834 GO TO P5100-EXIT. DTSBX774
|
|
00835 DTSBX774
|
|
00836 WRITE ACCTS-RECEIVABLE-REC. DTSBX774
|
|
00837 DTSBX774
|
|
00838 IF NOT X774-STATUS-OK-88 DTSBX774
|
|
00839 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774
|
|
00840 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX774
|
|
00841 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
00842 DTSBX774
|
|
00843 ************************************************************** DTSBX774
|
|
00844 * WRITE BALANCE RECORD FOR RECEIVABLES ESTABLISHED IN RQ. DTSBX774
|
|
00845 ************************************************************** DTSBX774
|
|
00846 IF RT-581-TYPE-ESTABLISHED-88 (RT-SUB) DTSBX774
|
|
00847 IF RT-END-BALANCE (RT-SUB) NOT = ZERO DTSBX774
|
|
00848 PERFORM P5130-ESTB-BAL-REC THRU P5130-EXIT. DTSBX774
|
|
00849 DTSBX774
|
|
00850 P5100-EXIT. DTSBX774
|
|
00851 EXIT. DTSBX774
|
|
00852 DTSBX774
|
|
00853 P5110-ESTB. DTSBX774
|
|
00854 *********************************************************** DTSBX774
|
|
00855 * INCLUDE ALL RECONSTRUCTION RECORD FIELDS FOR DTSBX774
|
|
00856 * THE RECEIVABLES ESTABLISHED SUB-POPULATION. DTSBX774
|
|
00857 *********************************************************** DTSBX774
|
|
00858 MOVE SPACES TO WRK-REC-AREA. DTSBX774
|
|
00859 DTSBX774
|
|
00860 STRING DTSBX774
|
|
00861 X774-OBS-NBR ',' DTSBX774
|
|
00862 X774-EMP-NO ',' DTSBX774
|
|
00863 X774-EMP-TYPE ',' DTSBX774
|
|
00864 X774-TRANS-DATE ',' DTSBX774
|
|
00865 X774-ESTB-Q-DATE ',' DTSBX774
|
|
00866 X774-EMP-RPT-QTR ',' DTSBX774
|
|
00867 X774-DUE-DATE ',' DTSBX774
|
|
00868 X774-TRANS-TYPE ',' DTSBX774
|
|
00869 X774-AMT-ESTB-IN-RQ ',' DTSBX774
|
|
00870 X774-LIQUIDATED ',' DTSBX774
|
|
00871 X774-UNCOLLECT ',' DTSBX774
|
|
00872 X774-REMOVED ',' ',' DTSBX774
|
|
00873 ***** X774-BALANCE ',' DTSBX774
|
|
00874 X774-AGE ',' DTSBX774
|
|
00875 WRK-ESTB-FILLER DTSBX774
|
|
00876 DELIMITED BY SIZE DTSBX774
|
|
00877 INTO WRK-REC-AREA DTSBX774
|
|
00878 END-STRING. DTSBX774
|
|
00879 DTSBX774
|
|
00880 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774
|
|
00881 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774
|
|
00882 DTSBX774
|
|
00883 P5110-EXIT. DTSBX774
|
|
00884 EXIT. DTSBX774
|
|
00885 DTSBX774
|
|
00886 P5120-REM-BAL. DTSBX774
|
|
00887 *********************************************************** DTSBX774
|
|
00888 * EXCLUDE THE TRANSACTION DATE AND DUE DATE FOR DTSBX774
|
|
00889 * THE RECEIVABLES REMOVED AND BALANCE AT END OF REPORT DTSBX774
|
|
00890 * QUARTER SUB-POPULATIONS. DTSBX774
|
|
00891 * TWO COMMAS IN A ROW IN THE OUTPUT CSV FILE REPRESENT DTSBX774
|
|
00892 * A ZERO-LENGTH STRING. DTSBX774
|
|
00893 *********************************************************** DTSBX774
|
|
00894 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
00895 PERFORM P5121-REM-BAL-CON THRU P5121-EXIT DTSBX774
|
|
00896 ELSE DTSBX774
|
|
00897 PERFORM P5122-REM-BAL-REIMB THRU P5122-EXIT. DTSBX774
|
|
00898 DTSBX774
|
|
00899 P5120-EXIT. DTSBX774
|
|
00900 EXIT. DTSBX774
|
|
00901 DTSBX774
|
|
00902 P5121-REM-BAL-CON. DTSBX774
|
|
00903 MOVE SPACES TO WRK-REC-AREA. DTSBX774
|
|
00904 DTSBX774
|
|
00905 STRING DTSBX774
|
|
00906 X774-OBS-NBR ',' DTSBX774
|
|
00907 X774-EMP-NO ',' DTSBX774
|
|
00908 X774-EMP-TYPE ',' ',' DTSBX774
|
|
00909 X774-ESTB-Q-DATE ',' DTSBX774
|
|
00910 X774-EMP-RPT-QTR ',' ',' DTSBX774
|
|
00911 X774-TRANS-TYPE ',' DTSBX774
|
|
00912 X774-AMT-ESTB-IN-RQ ',' DTSBX774
|
|
00913 X774-LIQUIDATED ',' DTSBX774
|
|
00914 X774-UNCOLLECT ',' DTSBX774
|
|
00915 X774-REMOVED ',' DTSBX774
|
|
00916 X774-BALANCE ',' DTSBX774
|
|
00917 X774-AGE ',' DTSBX774
|
|
00918 WRK-REM-BAL-FILLER DTSBX774
|
|
00919 DELIMITED BY SIZE DTSBX774
|
|
00920 INTO WRK-REC-AREA DTSBX774
|
|
00921 END-STRING. DTSBX774
|
|
00922 DTSBX774
|
|
00923 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774
|
|
00924 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774
|
|
00925 DTSBX774
|
|
00926 P5121-EXIT. DTSBX774
|
|
00927 EXIT. DTSBX774
|
|
00928 DTSBX774
|
|
00929 P5122-REM-BAL-REIMB. DTSBX774
|
|
00930 MOVE SPACES TO WRK-REC-AREA. DTSBX774
|
|
00931 DTSBX774
|
|
00932 STRING DTSBX774
|
|
00933 X774-OBS-NBR ',' DTSBX774
|
|
00934 X774-EMP-NO ',' DTSBX774
|
|
00935 X774-EMP-TYPE ',' ',' DTSBX774
|
|
00936 X774-ESTB-Q-DATE ',' ',' DTSBX774
|
|
00937 X774-DUE-DATE ',' DTSBX774
|
|
00938 X774-TRANS-TYPE ',' DTSBX774
|
|
00939 X774-AMT-ESTB-IN-RQ ',' DTSBX774
|
|
00940 X774-LIQUIDATED ',' DTSBX774
|
|
00941 X774-UNCOLLECT ',' DTSBX774
|
|
00942 X774-REMOVED ',' DTSBX774
|
|
00943 X774-BALANCE ',' DTSBX774
|
|
00944 X774-AGE ',' DTSBX774
|
|
00945 WRK-REM-BAL-FILLER DTSBX774
|
|
00946 DELIMITED BY SIZE DTSBX774
|
|
00947 INTO WRK-REC-AREA DTSBX774
|
|
00948 END-STRING. DTSBX774
|
|
00949 DTSBX774
|
|
00950 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774
|
|
00951 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774
|
|
00952 DTSBX774
|
|
00953 P5122-EXIT. DTSBX774
|
|
00954 EXIT. DTSBX774
|
|
00955 DTSBX774
|
|
00956 P5130-ESTB-BAL-REC. DTSBX774
|
|
00957 ADD +1 TO WRK-OBS-NBR. DTSBX774
|
|
00958 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX774
|
|
00959 DTSBX774
|
|
00960 MOVE WRK-OBS-NBR TO X774-OBS-NBR. DTSBX774
|
|
00961 DTSBX774
|
|
00962 SET X774-TRANS-BALANCE-88 TO TRUE. DTSBX774
|
|
00963 MOVE ZERO TO X774-AMT-ESTB-IN-RQ. DTSBX774
|
|
00964 MOVE RT-END-BALANCE (RT-SUB) TO X774-BALANCE. DTSBX774
|
|
00965 PERFORM P5120-REM-BAL THRU P5120-EXIT. DTSBX774
|
|
00966 DTSBX774
|
|
00967 WRITE ACCTS-RECEIVABLE-REC. DTSBX774
|
|
00968 DTSBX774
|
|
00969 IF NOT X774-STATUS-OK-88 DTSBX774
|
|
00970 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774
|
|
00971 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX774
|
|
00972 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
00973 DTSBX774
|
|
00974 P5130-EXIT. DTSBX774
|
|
00975 EXIT. DTSBX774
|
|
00976 DTSBX774
|
|
00977 P5200-BUILD-LIQD-X774. DTSBX774
|
|
00978 PERFORM DTSBX774
|
|
00979 VARYING LA-SUB FROM +1 BY +1 DTSBX774
|
|
00980 UNTIL LA-SUB > LA-LAST DTSBX774
|
|
00981 IF LA-RCVBL-IDX (LA-SUB) = RT-SUB DTSBX774
|
|
00982 MOVE LA-LIQD-IDX (LA-SUB) TO LT-SUB DTSBX774
|
|
00983 MOVE LA-AMT (LA-SUB) TO WRK-P5200-AMT DTSBX774
|
|
00984 PERFORM P5210-BUILD-LIQD THRU P5210-EXIT DTSBX774
|
|
00985 END-IF DTSBX774
|
|
00986 END-PERFORM. DTSBX774
|
|
00987 DTSBX774
|
|
00988 P5200-EXIT. DTSBX774
|
|
00989 EXIT. DTSBX774
|
|
00990 DTSBX774
|
|
00991 P5210-BUILD-LIQD. DTSBX774
|
|
00992 ADD +1 TO WRK-OBS-NBR. DTSBX774
|
|
00993 ADD +1 TO WRK-RECS-WRITTEN-CNT. DTSBX774
|
|
00994 DTSBX774
|
|
00995 MOVE WRK-EMP-NO TO X774-EMP-NO. DTSBX774
|
|
00996 MOVE WRK-OBS-NBR TO X774-OBS-NBR. DTSBX774
|
|
00997 DTSBX774
|
|
00998 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
00999 SET WRK-DV-EMP-CLASS-CONTRIB-88 TO TRUE DTSBX774
|
|
01000 *& DTSBX774
|
|
01001 * GO TO P5210-EXIT DTSBX774
|
|
01002 *& DTSBX774
|
|
01003 ELSE DTSBX774
|
|
01004 IF WRK-EMP-CLASS-REIMB-88 DTSBX774
|
|
01005 SET WRK-DV-EMP-CLASS-REIMB-88 TO TRUE DTSBX774
|
|
01006 ELSE DTSBX774
|
|
01007 DISPLAY 'INVALID EMPLOYER CLASS ' WRK-EMP-NO DTSBX774
|
|
01008 ' CLASS: ' Y774-EMP-CLASS DTSBX774
|
|
01009 GO TO P5210-EXIT. DTSBX774
|
|
01010 DTSBX774
|
|
01011 MOVE WRK-EMP-CLASS TO WRK-MPRF-EMP-CLASS. DTSBX774
|
|
01012 MOVE WRK-EMP-CLASS-DISP TO X774-EMP-TYPE. DTSBX774
|
|
01013 DTSBX774
|
|
01014 MOVE LT-PROCESSED-DATE (LT-SUB) TO L001-FED-8-DATE-9. DTSBX774
|
|
01015 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX774
|
|
01016 MOVE L001-SLASH-8-DATE TO X774-TRANS-DATE. DTSBX774
|
|
01017 DTSBX774
|
|
01018 MOVE L001-SLASH-8-DATE TO X774-ESTB-Q-DATE DTSBX774
|
|
01019 *** MOVE SPACES TO X774-ESTB-Q-DATE. DTSBX774
|
|
01020 DTSBX774
|
|
01021 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBX774
|
|
01022 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX774
|
|
01023 MOVE L004-SLASH-5-QTR TO WRK-RPT-QTR-AREA. DTSBX774
|
|
01024 MOVE '0' TO WRK-RPT-QTR-SLASH. DTSBX774
|
|
01025 MOVE WRK-RPT-QTR-9 TO X774-EMP-RPT-QTR. DTSBX774
|
|
01026 DTSBX774
|
|
01027 MOVE WRK-DUE-DATE TO L001-FED-8-DATE-9 DTSBX774
|
|
01028 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX774
|
|
01029 MOVE L001-SLASH-8-DATE TO X774-DUE-DATE DTSBX774
|
|
01030 DTSBX774
|
|
01031 SET X774-TRANS-LIQUIDATE-88 TO TRUE. DTSBX774
|
|
01032 DTSBX774
|
|
01033 MOVE ZEROS TO X774-AMT-ESTB-IN-RQ DTSBX774
|
|
01034 X774-UNCOLLECT DTSBX774
|
|
01035 X774-REMOVED DTSBX774
|
|
01036 X774-BALANCE. DTSBX774
|
|
01037 DTSBX774
|
|
01038 MOVE WRK-P5200-AMT TO X774-LIQUIDATED. DTSBX774
|
|
01039 PERFORM P6040-581-LIQUIDATE THRU P6040-EXIT DTSBX774
|
|
01040 DTSBX774
|
|
01041 MOVE ZERO TO X774-AGE. DTSBX774
|
|
01042 DTSBX774
|
|
01043 PERFORM P5211-LIQD THRU P5211-EXIT. DTSBX774
|
|
01044 DTSBX774
|
|
01045 WRITE ACCTS-RECEIVABLE-REC. DTSBX774
|
|
01046 DTSBX774
|
|
01047 IF NOT X774-STATUS-OK-88 DTSBX774
|
|
01048 DISPLAY 'FILE STATUS IS : ' X774-STATUS DTSBX774
|
|
01049 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX774
|
|
01050 PERFORM S999-ABEND THRU S999-EXIT. DTSBX774
|
|
01051 DTSBX774
|
|
01052 P5210-EXIT. DTSBX774
|
|
01053 EXIT. DTSBX774
|
|
01054 DTSBX774
|
|
01055 P5211-LIQD. DTSBX774
|
|
01056 *********************************************************** DTSBX774
|
|
01057 * EXCLUDE THE TRANSACTION DATE FOR THE RECEIVABLES DTSBX774
|
|
01058 * LIQUIDATED SUB-POPULATIONS. DTSBX774
|
|
01059 * TWO COMMAS IN A ROW IN THE OUTPUT CSV FILE REPRESENT DTSBX774
|
|
01060 * A ZERO-LENGTH STRING. DTSBX774
|
|
01061 *********************************************************** DTSBX774
|
|
01062 MOVE SPACES TO WRK-REC-AREA. DTSBX774
|
|
01063 DTSBX774
|
|
01064 STRING DTSBX774
|
|
01065 X774-OBS-NBR ',' DTSBX774
|
|
01066 X774-EMP-NO ',' DTSBX774
|
|
01067 X774-EMP-TYPE ',' DTSBX774
|
|
01068 X774-TRANS-DATE ',' DTSBX774
|
|
01069 X774-ESTB-Q-DATE ',' DTSBX774
|
|
01070 X774-EMP-RPT-QTR ',' DTSBX774
|
|
01071 X774-DUE-DATE ',' DTSBX774
|
|
01072 X774-TRANS-TYPE ',' DTSBX774
|
|
01073 X774-AMT-ESTB-IN-RQ ',' DTSBX774
|
|
01074 X774-LIQUIDATED ',' DTSBX774
|
|
01075 X774-UNCOLLECT ',' DTSBX774
|
|
01076 X774-REMOVED ',' ',' DTSBX774
|
|
01077 ***** X774-BALANCE ',' DTSBX774
|
|
01078 X774-AGE ',' DTSBX774
|
|
01079 WRK-LIQD-FILLER DTSBX774
|
|
01080 DELIMITED BY SIZE DTSBX774
|
|
01081 INTO WRK-REC-AREA DTSBX774
|
|
01082 END-STRING. DTSBX774
|
|
01083 DTSBX774
|
|
01084 MOVE WRK-REC-AREA (1:WRK-LEN) TO DTSBX774
|
|
01085 ACCTS-RECEIVABLE-REC (1:WRK-LEN). DTSBX774
|
|
01086 DTSBX774
|
|
01087 P5211-EXIT. DTSBX774
|
|
01088 EXIT. DTSBX774
|
|
01089 DTSBX774
|
|
01090 P6010-581-ESTB. DTSBX774
|
|
01091 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
01092 ADD RT-START-BALANCE (RT-SUB) TO WRK-CON-RECVBL-DETERM DTSBX774
|
|
01093 PERFORM P6031-CONTRIB-AGING THRU P6031-EXIT DTSBX774
|
|
01094 ELSE DTSBX774
|
|
01095 ADD RT-START-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-DETERM DTSBX774
|
|
01096 PERFORM P6032-REIMB-AGING THRU P6032-EXIT DTSBX774
|
|
01097 END-IF. DTSBX774
|
|
01098 DTSBX774
|
|
01099 P6010-EXIT. DTSBX774
|
|
01100 EXIT. DTSBX774
|
|
01101 DTSBX774
|
|
01102 P6020-581-REMOVE. DTSBX774
|
|
01103 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
01104 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774
|
|
01105 WRK-CON-RECVBL-REMOVED DTSBX774
|
|
01106 WRK-CON-RECVBL-BEG-PERIOD DTSBX774
|
|
01107 ELSE DTSBX774
|
|
01108 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774
|
|
01109 WRK-REIMB-RECVBL-REMOVED DTSBX774
|
|
01110 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774
|
|
01111 END-IF. DTSBX774
|
|
01112 DTSBX774
|
|
01113 P6020-EXIT. DTSBX774
|
|
01114 EXIT. DTSBX774
|
|
01115 DTSBX774
|
|
01116 P6030-581-BALANCE. DTSBX774
|
|
01117 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
01118 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774
|
|
01119 WRK-CON-RECVBL-BEG-PERIOD DTSBX774
|
|
01120 PERFORM P6031-CONTRIB-AGING THRU P6031-EXIT DTSBX774
|
|
01121 ELSE DTSBX774
|
|
01122 ADD RT-START-BALANCE (RT-SUB) TO DTSBX774
|
|
01123 WRK-REIMB-RECVBL-BEG-PERIOD DTSBX774
|
|
01124 PERFORM P6032-REIMB-AGING THRU P6032-EXIT DTSBX774
|
|
01125 END-IF. DTSBX774
|
|
01126 DTSBX774
|
|
01127 P6030-EXIT. DTSBX774
|
|
01128 EXIT. DTSBX774
|
|
01129 DTSBX774
|
|
01130 P6031-CONTRIB-AGING. DTSBX774
|
|
01131 DTSBX774
|
|
01132 EVALUATE TRUE DTSBX774
|
|
01133 WHEN WRK-YRQ > WRK-9-MONTHS-QTR DTSBX774
|
|
01134 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-6-MOS DTSBX774
|
|
01135 DTSBX774
|
|
01136 WHEN WRK-YRQ = WRK-9-MONTHS-QTR DTSBX774
|
|
01137 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-9-MOS DTSBX774
|
|
01138 DTSBX774
|
|
01139 WHEN WRK-YRQ = WRK-12-MONTHS-QTR DTSBX774
|
|
01140 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-12-MOS DTSBX774
|
|
01141 DTSBX774
|
|
01142 WHEN WRK-YRQ = WRK-15-MONTHS-QTR DTSBX774
|
|
01143 ADD RT-END-BALANCE (RT-SUB) TO WRK-CON-RECVBL-15-MOS DTSBX774
|
|
01144 DTSBX774
|
|
01145 WHEN OTHER DTSBX774
|
|
01146 ADD RT-END-BALANCE (RT-SUB) DTSBX774
|
|
01147 TO WRK-CON-RECVBL-OVER15-MOS DTSBX774
|
|
01148 DTSBX774
|
|
01149 END-EVALUATE. DTSBX774
|
|
01150 DTSBX774
|
|
01151 P6031-EXIT. DTSBX774
|
|
01152 EXIT. DTSBX774
|
|
01153 DTSBX774
|
|
01154 P6032-REIMB-AGING. DTSBX774
|
|
01155 DTSBX774
|
|
01156 EVALUATE TRUE DTSBX774
|
|
01157 WHEN WRK-YRQ > WRK-9-MONTHS-QTR DTSBX774
|
|
01158 ADD RT-END-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-6-MOS DTSBX774
|
|
01159 DTSBX774
|
|
01160 WHEN WRK-YRQ = WRK-9-MONTHS-QTR DTSBX774
|
|
01161 ADD RT-END-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-9-MOS DTSBX774
|
|
01162 DTSBX774
|
|
01163 WHEN WRK-YRQ = WRK-12-MONTHS-QTR DTSBX774
|
|
01164 ADD RT-END-BALANCE (RT-SUB) TO WRK-REIMB-RECVBL-12-MOS DTSBX774
|
|
01165 DTSBX774
|
|
01166 WHEN WRK-YRQ = WRK-15-MONTHS-QTR DTSBX774
|
|
01167 ADD RT-END-BALANCE (RT-SUB) DTSBX774
|
|
01168 TO WRK-REIMB-RECVBL-15-MOS DTSBX774
|
|
01169 DTSBX774
|
|
01170 WHEN OTHER DTSBX774
|
|
01171 ADD RT-END-BALANCE (RT-SUB) DTSBX774
|
|
01172 TO WRK-REIMB-RECVBL-OVER15-MOS DTSBX774
|
|
01173 DTSBX774
|
|
01174 END-EVALUATE. DTSBX774
|
|
01175 DTSBX774
|
|
01176 P6032-EXIT. DTSBX774
|
|
01177 EXIT. DTSBX774
|
|
01178 DTSBX774
|
|
01179 P6040-581-LIQUIDATE. DTSBX774
|
|
01180 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
01181 ADD WRK-P5200-AMT TO WRK-CON-RECVBL-LIQUID DTSBX774
|
|
01182 ELSE DTSBX774
|
|
01183 ADD WRK-P5200-AMT TO WRK-REIMB-RECVBL-LIQUID DTSBX774
|
|
01184 END-IF. DTSBX774
|
|
01185 DTSBX774
|
|
01186 P6040-EXIT. DTSBX774
|
|
01187 EXIT. DTSBX774
|
|
01188 DTSBX774
|
|
01189 T0000-TERMINATE. DTSBX774
|
|
01190 PERFORM T1000-FINAL-QTR THRU T1000-EXIT. DTSBX774
|
|
01191 DTSBX774
|
|
01192 COMPUTE WRK-CON-RECVBL-END-PERIOD = DTSBX774
|
|
01193 WRK-CON-RECVBL-BEG-PERIOD + DTSBX774
|
|
01194 WRK-CON-RECVBL-DETERM - DTSBX774
|
|
01195 WRK-CON-RECVBL-LIQUID - DTSBX774
|
|
01196 WRK-CON-RECVBL-REMOVED. DTSBX774
|
|
01197 DTSBX774
|
|
01198 COMPUTE WRK-REIMB-RECVBL-END-PERIOD = DTSBX774
|
|
01199 WRK-REIMB-RECVBL-BEG-PERIOD + DTSBX774
|
|
01200 WRK-REIMB-RECVBL-DETERM - DTSBX774
|
|
01201 WRK-REIMB-RECVBL-LIQUID - DTSBX774
|
|
01202 WRK-REIMB-RECVBL-REMOVED. DTSBX774
|
|
01203 DTSBX774
|
|
01204 MOVE WRK-ETA581-DATA-AREA TO XL774-DATA-AREA. DTSBX774
|
|
01205 DTSBX774
|
|
01206 DISPLAY ' '. DTSBX774
|
|
01207 DTSBX774
|
|
01208 DISPLAY '*** DTSBX774 TERMINATION STATISTICS ***'. DTSBX774
|
|
01209 DTSBX774
|
|
01210 DISPLAY ' '. DTSBX774
|
|
01211 DISPLAY 'SUBJECT QUARTER : ' DTSBX774
|
|
01212 X770-SUBJECT-QTR. DTSBX774
|
|
01213 DTSBX774
|
|
01214 DISPLAY ' '. DTSBX774
|
|
01215 MOVE WRK-RECS-WRITTEN-CNT TO DISPLAY-CNT. DTSBX774
|
|
01216 DISPLAY 'X774 RECORDS WRITTEN : ' DTSBX774
|
|
01217 DISPLAY-CNT. DTSBX774
|
|
01218 DTSBX774
|
|
01219 DISPLAY ' '. DTSBX774
|
|
01220 DISPLAY ' ** CONTRIBUTORY TOTALS ' X770-SUBJECT-QTR ' **'. DTSBX774
|
|
01221 MOVE WRK-CON-RECVBL-BEG-PERIOD TO DISPLAY-AMT. DTSBX774
|
|
01222 DISPLAY 'RCVBLS AT BEGINNING OF PERIOD (21) : ' DTSBX774
|
|
01223 DISPLAY-AMT. DTSBX774
|
|
01224 MOVE WRK-CON-RECVBL-DETERM TO DISPLAY-AMT. DTSBX774
|
|
01225 DISPLAY 'DETERMINED RECEIVABLE DURING PERIOD (22) : ' DTSBX774
|
|
01226 DISPLAY-AMT. DTSBX774
|
|
01227 MOVE WRK-CON-RECVBL-LIQUID TO DISPLAY-AMT. DTSBX774
|
|
01228 DISPLAY 'DETERMINED LIQUIDATED DURING PERIOD (23) : ' DTSBX774
|
|
01229 DISPLAY-AMT. DTSBX774
|
|
01230 MOVE WRK-CON-RECVBL-REMOVED TO DISPLAY-AMT. DTSBX774
|
|
01231 DISPLAY 'DETERMINED REMOVED DURING PERIOD (25) : ' DTSBX774
|
|
01232 DISPLAY-AMT. DTSBX774
|
|
01233 MOVE WRK-CON-RECVBL-END-PERIOD TO DISPLAY-AMT. DTSBX774
|
|
01234 DISPLAY 'ENDING BALANCE (26) : ' DTSBX774
|
|
01235 DISPLAY-AMT. DTSBX774
|
|
01236 MOVE WRK-REMOVED-CON TO DISPLAY-AMT. DTSBX774
|
|
01237 DISPLAY 'REMOVED PRIOR : ' DTSBX774
|
|
01238 DISPLAY-AMT. DTSBX774
|
|
01239 MOVE WRK-CON-RECVBL-EMP-CNT TO DISPLAY-CNT. DTSBX774
|
|
01240 DISPLAY 'EMPLOYER COUNT (27) : ' DTSBX774
|
|
01241 DISPLAY-CNT. DTSBX774
|
|
01242 DTSBX774
|
|
01243 DISPLAY ' '. DTSBX774
|
|
01244 DISPLAY ' ** CONTRIBUTORY AGING **'. DTSBX774
|
|
01245 MOVE WRK-CON-RECVBL-6-MOS TO DISPLAY-AMT. DTSBX774
|
|
01246 DISPLAY '6 MONTHS OR LESS (28) : ' DTSBX774
|
|
01247 DISPLAY-AMT. DTSBX774
|
|
01248 MOVE WRK-CON-RECVBL-9-MOS TO DISPLAY-AMT. DTSBX774
|
|
01249 DISPLAY '9 MONTHS (29) : ' DTSBX774
|
|
01250 DISPLAY-AMT. DTSBX774
|
|
01251 MOVE WRK-CON-RECVBL-12-MOS TO DISPLAY-AMT. DTSBX774
|
|
01252 DISPLAY '12 MONTHS (30) : ' DTSBX774
|
|
01253 DISPLAY-AMT. DTSBX774
|
|
01254 MOVE WRK-CON-RECVBL-15-MOS TO DISPLAY-AMT. DTSBX774
|
|
01255 DISPLAY '15 MONTHS (31) : ' DTSBX774
|
|
01256 DISPLAY-AMT. DTSBX774
|
|
01257 MOVE WRK-CON-RECVBL-OVER15-MOS TO DISPLAY-AMT. DTSBX774
|
|
01258 DISPLAY 'OVER 15 MONTHS (32) : ' DTSBX774
|
|
01259 DISPLAY-AMT. DTSBX774
|
|
01260 DTSBX774
|
|
01261 DISPLAY ' '. DTSBX774
|
|
01262 DISPLAY ' ** REIMBURSABLE TOTALS ' X770-SUBJECT-QTR ' ** 'DTSBX774
|
|
01263 MOVE WRK-REIMB-RECVBL-BEG-PERIOD TO DISPLAY-AMT. DTSBX774
|
|
01264 DISPLAY 'RCVBLS AT BEGINNING OF PERIOD (33) : ' DTSBX774
|
|
01265 DISPLAY-AMT. DTSBX774
|
|
01266 MOVE WRK-REIMB-RECVBL-DETERM TO DISPLAY-AMT. DTSBX774
|
|
01267 DISPLAY 'DETERMINED RECEIVABLE DURING PERIOD (34) : ' DTSBX774
|
|
01268 DISPLAY-AMT. DTSBX774
|
|
01269 MOVE WRK-REIMB-RECVBL-LIQUID TO DISPLAY-AMT. DTSBX774
|
|
01270 DISPLAY 'DETERMINED LIQUIDATED DURING PERIOD (35) : ' DTSBX774
|
|
01271 DISPLAY-AMT. DTSBX774
|
|
01272 MOVE WRK-REIMB-RECVBL-REMOVED TO DISPLAY-AMT. DTSBX774
|
|
01273 DISPLAY 'DETERMINED REMOVED DURING PERIOD (37) : ' DTSBX774
|
|
01274 DISPLAY-AMT. DTSBX774
|
|
01275 MOVE WRK-REIMB-RECVBL-END-PERIOD TO DISPLAY-AMT. DTSBX774
|
|
01276 DISPLAY 'ENDING BALANCE (38) : ' DTSBX774
|
|
01277 DISPLAY-AMT. DTSBX774
|
|
01278 MOVE WRK-REMOVED-RMB TO DISPLAY-AMT. DTSBX774
|
|
01279 DISPLAY 'REMOVED PRIOR : ' DTSBX774
|
|
01280 DISPLAY-AMT. DTSBX774
|
|
01281 MOVE WRK-REIMB-RECVBL-EMP-CNT TO DISPLAY-CNT. DTSBX774
|
|
01282 DISPLAY 'EMPLOYER COUNT (39) : ' DTSBX774
|
|
01283 DISPLAY-CNT. DTSBX774
|
|
01284 DISPLAY ' '. DTSBX774
|
|
01285 DISPLAY ' ** REIMBURSABLE AGING **'. DTSBX774
|
|
01286 MOVE WRK-REIMB-RECVBL-6-MOS TO DISPLAY-AMT. DTSBX774
|
|
01287 DISPLAY '6 MONTHS OR LESS (40) : ' DTSBX774
|
|
01288 DISPLAY-AMT. DTSBX774
|
|
01289 MOVE WRK-REIMB-RECVBL-9-MOS TO DISPLAY-AMT. DTSBX774
|
|
01290 DISPLAY '9 MONTHS (41) : ' DTSBX774
|
|
01291 DISPLAY-AMT. DTSBX774
|
|
01292 MOVE WRK-REIMB-RECVBL-12-MOS TO DISPLAY-AMT. DTSBX774
|
|
01293 DISPLAY '12 MONTHS (42) : ' DTSBX774
|
|
01294 DISPLAY-AMT. DTSBX774
|
|
01295 MOVE WRK-REIMB-RECVBL-15-MOS TO DISPLAY-AMT. DTSBX774
|
|
01296 DISPLAY '15 MONTHS (43) : ' DTSBX774
|
|
01297 DISPLAY-AMT. DTSBX774
|
|
01298 MOVE WRK-REIMB-RECVBL-OVER15-MOS TO DISPLAY-AMT. DTSBX774
|
|
01299 DISPLAY 'OVER 15 MONTHS (44) : ' DTSBX774
|
|
01300 DISPLAY-AMT. DTSBX774
|
|
01301 DTSBX774
|
|
01302 T0000-EXIT. DTSBX774
|
|
01303 EXIT. DTSBX774
|
|
01304 DTSBX774
|
|
01305 T1000-FINAL-QTR. DTSBX774
|
|
01306 PERFORM P2000-STARTING-BALANCE THRU P2000-EXIT. DTSBX774
|
|
01307 PERFORM P3000-SET-581-TYPE THRU P3000-EXIT. DTSBX774
|
|
01308 PERFORM P4000-RPT-QTR-LIQUIDATIONS THRU P4000-EXIT. DTSBX774
|
|
01309 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT. DTSBX774
|
|
01310 DTSBX774
|
|
01311 IF WRK-COUNT-EMP-YES-88 DTSBX774
|
|
01312 IF WRK-EMP-CLASS-CONTRIB-88 DTSBX774
|
|
01313 ADD +1 TO WRK-CON-RECVBL-EMP-CNT DTSBX774
|
|
01314 ELSE DTSBX774
|
|
01315 ADD +1 TO WRK-REIMB-RECVBL-EMP-CNT DTSBX774
|
|
01316 END-IF DTSBX774
|
|
01317 END-IF. DTSBX774
|
|
01318 DTSBX774
|
|
01319 T1000-EXIT. DTSBX774
|
|
01320 EXIT. DTSBX774
|
|
01321 DTSBX774
|
|
01322 S001-FROM-FED-8. DTSBX774
|
|
01323 SET L001-FROM-FED-8 TO TRUE. DTSBX774
|
|
01324 GO TO S001-DATE. DTSBX774
|
|
01325 DTSBX774
|
|
01326 S001-FROM-ABS-DAY. DTSBX774
|
|
01327 SET L001-FROM-ABS-DAY TO TRUE. DTSBX774
|
|
01328 GO TO S001-DATE. DTSBX774
|
|
01329 DTSBX774
|
|
01330 S001-FROM-CAL-6. DTSBX774
|
|
01331 SET L001-FROM-CAL-6 TO TRUE. DTSBX774
|
|
01332 GO TO S001-DATE. DTSBX774
|
|
01333 DTSBX774
|
|
01334 S001-DATE. DTSBX774
|
|
01335 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX774
|
|
01336 S001-EXIT. DTSBX774
|
|
01337 EXIT. DTSBX774
|
|
01338 SKIP3 DTSBX774
|
|
01339 S004-FROM-5. DTSBX774
|
|
01340 SET L004-FROM-5 TO TRUE. DTSBX774
|
|
01341 GO TO S004-QTR. DTSBX774
|
|
01342 DTSBX774
|
|
01343 S004-FROM-ABS. DTSBX774
|
|
01344 SET L004-FROM-ABS TO TRUE. DTSBX774
|
|
01345 GO TO S004-QTR. DTSBX774
|
|
01346 DTSBX774
|
|
01347 S004-FROM-3. DTSBX774
|
|
01348 SET L004-FROM-3 TO TRUE. DTSBX774
|
|
01349 GO TO S004-QTR. DTSBX774
|
|
01350 DTSBX774
|
|
01351 S004-FROM-DATE. DTSBX774
|
|
01352 SET L004-FROM-DATE TO TRUE. DTSBX774
|
|
01353 GO TO S004-QTR. DTSBX774
|
|
01354 DTSBX774
|
|
01355 S004-QTR. DTSBX774
|
|
01356 DTSBX774
|
|
01357 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX774
|
|
01358 DTSBX774
|
|
01359 S004-EXIT. DTSBX774
|
|
01360 EXIT. DTSBX774
|
|
01361 SKIP3 DTSBX774
|
|
01362 DTSBX774
|
|
01363 S999-ABEND. DTSBX774
|
|
01364 DISPLAY '*** DTSBE774 ABENDING. ' DTSBX774
|
|
01365 ABEND-MSG. DTSBX774
|
|
01366 DTSBX774
|
|
01367 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX774
|
|
01368 S999-EXIT. DTSBX774
|
|
01369 EXIT. DTSBX774
|