00001 IDENTIFICATION DIVISION. 03/14/16 00002 PROGRAM-ID. DTSBD140. DTSBD140 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV024 00004 DATE-WRITTEN. MARCH 1992. DTSBD140 00005 DATE-COMPILED. DTSBD140 00006 SKIP3 DTSBD140 00007 ***** DTSBD140 00008 * DTSBD140 00009 * FUNCTION: BATCH TRANSACTION COLLECTION FILE SCAN. DTSBD140 00010 * DTSBD140 00011 * DTSBD140 00012 * MODIFICATION LOG: DTSBD140 00013 * DTSBD140 00014 * 01/06/92 INITIAL DEVELOPMENT. DTSBD140 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD140 00016 * DTSBD140 00017 * 05/09/95 AHDR-*-ITEM-CNT WERE CHANGED TO AHDR-*-TRAN-CNT. DTSBD140 00018 * THEY NO LONGER INCLUDE THE CHECKS IN THE COUNTS. DTSBD140 00019 * WORK ORDER: CR076 PROGRAMMER: RHC DTSBD140 00020 * DTSBD140 00021 * 06/14/95 TRANSFER REPORTS AND PAYMENT BETWEEN EMPLOYERS. DTSBD140 00022 * P5000 ADDED. DTSBD140 00023 * WORK ORDER: CR066 PROGRAMMER: EHH DTSBD140 00024 * DTSBD140 00025 * 11/13/95 JOINT REGISTRATION PROCESSING. T002 RECORD DTSBD140 00026 * PROCESSING. USE IWHO RECORDS TO FINE THE EMP-NO DTSBD140 00027 * ASSOCIATED WITH THE T002-WH-OFLT-SEIN AND STORE THEDTSBD140 00028 * EMP-NO IN T002-EMP-NO. DTSBD140 00029 * WORK ORDER: JR PROGRAMMER: RPA DTSBD140 00030 * DTSBD140 00031 * 04/01/96 ELECTRONIC FILE PROCESSING. T027 RECORD. DTSBD140 00032 * PLEASE NOTE THAT DTSBD140 ASSUMES T027 RECORDS DTSBD140 00033 * WILL ARRIVE IN A CLUMP AND THE T027 RECORDS WILL DTSBD140 00034 * ARRIVE IN ASCENDING ORDER BY T027-PSEUDO-ITEM-NO DTSBD140 00035 * WITHIN T027-PSEUDO-BATCH-NO SEQUENCE. DTSBD140 00036 * WORK ORDER: MTS001 - ELF PROGRAMMER: EHH DTSBD140 00037 * DTSBD140 00038 * 12/31/96 ADDED 88 LEVEL TO DTSIAHDR FOR ELECTRONIC FILER DTSBD140 00039 * BATCHES AND SET IT TO TRUE EACH TIME A NEW BATCH DTSBD140 00040 * WAS INITIATED IN P7000-ELF-RPT. DTSBD140 00041 * WORK ORDER: WARP II PROGRAMMER: MJA DTSBD140 00042 * DTSBD140 00043 * 10/07/1998 REVIEWED AND MODIFIED FOR DC. DTSBD140 00044 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD140 00045 * DTSBD140 00046 * 10/08/1999 ADDED T026-TOLERANCE PROCESSING. RECOVERY DTSBD140 00047 * FROM PROBLEMS GENERATED DURING THE CONVERSION DTSBD140 00048 * TO DUTAS. DTSBD140 00049 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD140 00050 * DTSBD140 00051 * 10/26/1999 ADDED REFERENCE FILE OPEN/CLOSE. REFERENCE DTSBD140 00052 * FILE USED IN DTSBU516. FIX OF PRODUCTION DTSBD140 00053 * ABEND. DTSBD140 00054 * REFERENCE: DC PRODUCTION PROGRAMMER: EHH DTSBD140 00055 * DTSBD140 00056 * 08/14/2002 RECOMPILED TO GET NEW VERSION OF DTSIL516 DTSBD140 00057 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD140 00058 * DTSBD140 00059 * 04/07/2003 MODIFIED FOR ELECTRONIC PAYMENT PROCESS. DTSBD140 00060 * ADDED P7000 AND ASSOCIATED CODE. DTSBD140 00061 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD140 00062 * DTSBD140 00063 * 12/14/2004 MODIFIED FOR COMPROMISE SETTLEMENTS - DTSBD140 00064 * INITIALIZE AADJ-CMP-ESTB-ABSTIME IN DTSBD140 00065 * P2400, P5193. DTSBD140 00066 * REFERENCE: COMPROMISE PROGRAMMER: GD DTSBD140 00067 * DTSBD140 00068 * 01/20/2005 REMOVED DISPLAYS DTSBD140 00069 * REFERENCE: COMPROMISE PROGRAMMER: GD DTSBD140 00070 * DTSBD140 00071 * 01/25/2005 INITILIZED NEW FIELD(APAY-NSF-MNTE-ABSTIME) DTSBD140 00072 * NEW FIELD WILL REFERENCE NSF RECORD ON THE DTSBD140 00073 * MNTE FILE. DTSBD140 00074 * REFERENCE: REFUND PROGRAMMER: ZL1 DTSBD140 00075 * DTSBD140 00076 * 02/09/2005 MODIFIED S1000 SET SET AHDR-ESTB-OP-ID TO DTSBD140 00077 * T027-RESPPONSIBLE-OP-ID WHEN CREATING A DTSBD140 00078 * BATCH WITH T027 TRANSACTIONS. DTSBD140 00079 * THIS WILL ENSURE THAT THE OP-ID ON THE 301 DTSBD140 00080 * REPORT RECORDS = 'MAG UC30' OR 'WEB UC30'. DTSBD140 00081 * CHANGED MAX RECORDS IN BATCH FROM 100 TO 50. DTSBD140 00082 * REFERENCE: ICESA PROGRAMMER: GD DTSBD140 00083 * DTSBD140 00084 * 09/02/2005 ADDED P8200 TO WRITE BATCH AUDIT RECORDS DTSBD140 00085 * TO MATCH PSEUDO-BATCH AND ITEM NUMBERS DTSBD140 00086 * TO THE TAX SYSTEM BATCH AND ITEM NUMBERS DTSBD140 00087 * ASSIGNED IN THIS PROGRAM. DTSBD140 00088 * REFERENCE: ICESA PROGRAMMER: GD DTSBD140 00089 * DTSBD140 00090 * 09/26/2005 MODIFIED P7000 FOR REFUND TRANSACTIONS GENERATED DTSBD140 00091 * BY WEB CREDIT/DEBIT VERIFICATION APPLICATION. DTSBD140 00092 * REFERENCE: CREDIT/DEBIT PROGRAMMER: GD DTSBD140 00093 * DTSBD140 00094 * 10/07/2005 MODIFIED P5191 AND P8100 TO INITIALIZE DTSBD140 00095 * ARPT-WAGE-RPT-IND AND ARPT-STATUS-CHNG-IND. DTSBD140 00096 * REFERENCE: CREDIT/DEBIT PROGRAMMER: GD DTSBD140 00097 * DTSBD140 00098 * 11/04/2005 MODIFIED P8200 TO CALL BU001 TO FORMAT DTSBD140 00099 * DATE IN X214 OUTPUT RECORD. DTSBD140 00100 * REFERENCE: CREDIT/DEBIT PROGRAMMER: GD DTSBD140 00101 * DTSBD140 00102 * 12/19/2005 INITIALIZE BANK BATCH NUMBER TO ZERO IN DTSBD140 00103 * S1000. DTSBD140 00104 * REFERENCE: PROGRAMMER: GD DTSBD140 00105 * DTSBD140 00106 * 02/21/2006 MODIFIED TO PROCESS T026 TRANSACTIONS FOR DTSBD140 00107 * ADMINISTRATIVE ASSESSMENT. P2300, P2400, DTSBD140 00108 * P2500. DTSBD140 00109 * REFERENCE: PROGRAMMER: GD DTSBD140 00110 * DTSBD140 00111 * 09/25/2006 ADDED P2540 AND FOLLOWING TO HANDLE NEGATIVE DTSBD140 00112 * CHARGE ADJUSTMENTS TO ADMINISTRATIVE ASSESSMENT. DTSBD140 00113 * REFERENCE: PROGRAMMER: GD DTSBD140 00114 * DTSBD140 00115 * 11/02/2006 MODIFIED P8200 TO MOVE SLASHED DATE TO X214 DTSBD140 00116 * BATCH CROSS-REF RECORD. IT WAS MOVING AN DTSBD140 00117 * UNSLASHED FEDERAL DATE. DTSBD140 00118 * REFERENCE: PROGRAMMER: GD DTSBD140 00119 * DTSBD140 00120 * 07/26/2007 MODIFIED FOR WEB REGISTRATION. ADDED P9000 DTSBD140 00121 * AND CALLS TO DTSBD142 TO ADD MPRF AND MERA DTSBD140 00122 * RECORDS. DTSBD140 00123 * REFERENCE: PROGRAMMER: GD DTSBD140 00124 * DTSBD140 00125 * 03/06/2009 MODIFIED TO WRITE A DUMMY RECORD TO THE DTSBD140 00126 * BATCH-AUDIT-FILE WHEN THERE ARE NO ICESA DTSBD140 00127 * REPORTS TO PROCESS. DTSBD140 00128 * REFERENCE: PROGRAMMER: GD DTSBD140 00129 * DTSBD140 00130 * 04/19/2011 MODIFIED TO INCLUDE THE LOG NUMBER IN THE DTSBD140 00131 * X214 CROSS-REFERENCE RECORD - P8200. DTSBD140 00132 * REFERENCE: PROGRAMMER: GD DTSBD140 00133 * DTSBD140 00134 * 04/10/2012 MODIFIED FOR NEW VERSION OF T027 RECORD. IT DTSBD140 00135 * HAS BEEN RENAMED T028, AND THE SORT ORDER DTSBD140 00136 * CHANGED TO GROUP REPORTS FROM THE SAME ICESA DTSBD140 00137 * SUBMITTER TOGETHER. AMENDED REPORTS WILL ALSO DTSBD140 00138 * ALSO BE SORTED IN SEPARATE BATCHES. DTSBD140 00139 * REFERENCE: PROGRAMMER: GD DTSBD140 00140 * DTSBD140 00141 * 09/13/2012 RECOMPILED AND ADDED A DISPLAY OF THE BX214 DTSBD140 00142 * RECORD COUNTER. PARAGRAPH P8200 WAS NOT BEING DTSBD140 00143 * EXECUTED. DTSBD140 00144 * REFERENCE: PROGRAMMER: GD DTSBD140 00145 * DTSBD140 00146 * 01/13/2016 MODIFY PROGRAM TO CALL NEW BATCH NO PROGRAM CL**2 00147 * TO GET THE LAST BATCH NUMBER USER. BATCH NUMBER CL**2 00148 * IS RUNNING OUT, NEED TO START REUSING OLD NUMBERS CL**2 00149 * REFERENCE: BATCH NO ISSUE PROGRAMMER: ZL1 CL**2 00150 * CL**2 00151 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD140 00152 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD140 00153 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD140 00154 * DTSBD140 00155 * DTSBD140 00156 * DESCRIPTION: DTSBD140 00157 * DTSBD140 00158 * READ THE BATCH TRANSACTION COLLECTION FILE. IF INPUT DTSBD140 00159 * REC-TYPE = '026', THEN GENERATE ACCOUNTING ADJUSTMENT DTSBD140 00160 * TRANSACTION(S). IF INPUT REC-TYPE NOT = '026, THEN WRITE DTSBD140 00161 * THE INPUT RECORD TO A SEQUENTIAL TRANSACTION FILE. DTSBD140 00162 * DTSBD140 00163 * DTSBD140 00164 * INITIATION: DTSBD140 00165 * DTSBD140 00166 * OPEN MASTER FILE (L910-UPDATE-HDR-88). DTSBD140 00167 * OPEN ACCOUNTING TRANSACTION COLLECTION FILE DTSBD140 00168 * (L923-OPEN-UPDATE-88). DTSBD140 00169 * OPEN BATCH TRANSACTION COLLECTION INPUT FILE DTSBD140 00170 * (L926-OPEN-READ-88). DTSBD140 00171 * DTSBD140 00172 * READ THE MHDR RECORD. DTSBD140 00173 * IF L910-NO-REC-88 DTSBD140 00174 * ABEND THE MODULE. DTSBD140 00175 * DTSBD140 00176 * INITIALIZE THE CONTROL COUNTS (WRK-BTC-REC-CNT THRU DTSBD140 00177 * WRK-ATC-TRAN-CNT). DTSBD140 00178 * DTSBD140 00179 * DTSBD140 00180 * PROCESSING: DTSBD140 00181 * DTSBD140 00182 * READ ALL BATCH TRANSACTION COLLECTION FILE RECORDS. DTSBD140 00183 * FOR EACH BATCH TRANSACTION COLLECTION RECORD READ: DTSBD140 00184 * DTSBD140 00185 * IF RSK3-REC-TYPE = '026' DTSBD140 00186 * PERFORM GENERATE-AADJ-RECS DTSBD140 00187 * ELSE DTSBD140 00188 * WRITE THE BTC RECORD TO THE S946-TRN-REC-O FILE. DTSBD140 00189 * DTSBD140 00190 * DTSBD140 00191 * GENERATE-AADJ-RECS. DTSBD140 00192 * DTSBD140 00193 * IF T026-REIMB-CHG DTSBD140 00194 * GENERATE ONE OR MORE AADJ-CHARGE-88 AADJ RECORDS DTSBD140 00195 * (WHEN T026-AMT IS LESS THAN ZERO SPECIAL PROCESSING DTSBD140 00196 * IS REQUIRED) DTSBD140 00197 * ELSE DTSBD140 00198 * WRITE AN R907 RECORD. DTSBD140 00199 * DTSBD140 00200 * DTSBD140 00201 * TERMINATION: DTSBD140 00202 * DTSBD140 00203 * BREAK THE LAST GENERATED BATCH (INCREMENT MHDR-LAST-USED- DTSBD140 00204 * BATCH-NO, AND WRITE AHDR RECORD). DTSBD140 00205 * DTSBD140 00206 * REWRITE THE MHDR RECORD. DTSBD140 00207 * DTSBD140 00208 * DISPLAY TERMINATION STATISTICS (MHDR-CURR-RUN-DATE, DTSBD140 00209 * MHDR-LAST-USED-BATCH-NO, WRK-BTC-REC-CNT THRU DTSBD140 00210 * WRK-ATC-TRAN-CNT. DTSBD140 00211 * DTSBD140 00212 * CLOSE THE MASTER FILE, ACCOUNTING TRANSACTION COLLECTION DTSBD140 00213 * FILE, BATCH TRANSACTION COLLECTION FILE, REPORT RECORD DTSBD140 00214 * FILE, AND TRANSACTION RECORD FILE. DTSBD140 00215 * DTSBD140 00216 * DTSBD140 00217 ***** DTSBD140 00218 SKIP3 DTSBD140 00219 ENVIRONMENT DIVISION. DTSBD140 00220 INPUT-OUTPUT SECTION. DTSBD140 00221 DTSBD140 00222 FILE-CONTROL. DTSBD140 00223 DTSBD140 00224 SELECT BATCH-AUDIT-FILE ASSIGN TO DTSBX214 DTSBD140 00225 FILE STATUS IS BATCH-AUDIT-STATUS. DTSBD140 00226 SKIP3 DTSBD140 00227 DATA DIVISION. DTSBD140 00228 FILE SECTION. DTSBD140 00229 DTSBD140 00230 FD BATCH-AUDIT-FILE DTSBD140 00231 RECORDING MODE IS F DTSBD140 00232 BLOCK CONTAINS 0 RECORDS DTSBD140 00233 LABEL RECORDS ARE OMITTED. DTSBD140 00234 DTSBD140 00235 01 BATCH-AUDIT-REC PIC X(30). DTSBD140 00236 DTSBD140 00237 SKIP3 DTSBD140 00238 WORKING-STORAGE SECTION. DTSBD140 002385 77 PAN-VALET PICTURE X(24) VALUE '024DTSBD140 03/14/16'. DTSBD140 00239 77 PAN-VALET PICTURE X(24) VALUE '060DTSBD140 12/16/15'. DTSBD140 00240 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD140 11/20/15'. DTSBD140 00241 77 PAN-VALET PICTURE X(24) VALUE '058DTSBD140 06/10/15'. DTSBD140 00242 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD140 04/28/15'. DTSBD140 00243 77 PAN-VALET PICTURE X(24) VALUE '056DTSBD140 09/13/12'. DTSBD140 00244 77 PAN-VALET PICTURE X(24) VALUE '006DTSBD140 09/13/12'. DTSBD140 00245 77 PAN-VALET PICTURE X(24) VALUE '054DTSBD140 05/02/12'. DTSBD140 00246 SKIP3 DTSBD140 00247 01 WRK-AREA. DTSBD140 00248 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +140.DTSBD140 00249 DTSBD140 00250 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD140'.DTSBD140 00251 DTSBD140 00252 05 BATCH-AUDIT-STATUS PIC X(02). DTSBD140 00253 88 BATCH-AUDIT-OK-88 VALUE '00'. DTSBD140 00254 DTSBD140 00255 05 WRK-CURR-REC-TYPE PIC X(03) VALUE SPACES. DTSBD140 00256 DTSBD140 00257 05 WRK-CURR-KEY PIC X(04) VALUE SPACES. DTSBD140 00258 DTSBD140 00259 05 TRANSFER-RESPONSIBLE-ACTIVITY DTSBD140 00260 PIC X(03) VALUE 'TRN'. DTSBD140 00261 DTSBD140 00262 05 TRANSFER-RESPONSIBLE-OP-ID PIC X(08) VALUE 'TRANSFER'.DTSBD140 00263 DTSBD140 00264 05 WRK-BTC-REC-CNT PIC S9(07) COMP-3. DTSBD140 00265 05 WRK-AHDR-ITEM-NO PIC S9(03) COMP-3. CL*16 00266 DTSBD140 00267 05 WRK-BTC-TRAN-CNT PIC S9(07) COMP-3. DTSBD140 00268 DTSBD140 00269 05 WRK-ATC-BATCH-CNT PIC S9(07) COMP-3. DTSBD140 00270 DTSBD140 00271 05 WRK-ATC-TRAN-CNT PIC S9(07) COMP-3. DTSBD140 00272 DTSBD140 00273 05 WRK-T002-CNT PIC S9(07) COMP-3. DTSBD140 00274 DTSBD140 00275 05 WRK-BX214-CNT PIC S9(07) COMP-3. DTSBD140 00276 DTSBD140 00277 05 WRK-R907-REC-CNT PIC S9(07) COMP-3. DTSBD140 00278 DTSBD140 00279 05 WRK-MSG-TEXT. DTSBD140 00280 10 WRK-MSG-TEXT-1 PIC X(30). DTSBD140 00281 10 WRK-MSG-TEXT-2 PIC X(70). DTSBD140 00282 DTSBD140 00283 05 WS-AMT-X PIC ZZZ,ZZZ,ZZ9.99-. DTSBD140 00284 05 AMT-DISP1 PIC ----------9.99. DTSBD140 00285 05 AMT-DISP2 PIC ----------9.99. DTSBD140 00286 DTSBD140 00287 05 START-ABS-QTR PIC S9(04) COMP. DTSBD140 00288 DTSBD140 00289 05 END-ABS-QTR PIC S9(04) COMP. DTSBD140 00290 DTSBD140 00291 05 HOLD-T026-AMT PIC S9(09)V9(02) COMP-3.DTSBD140 00292 DTSBD140 00293 DTSBD140 00294 05 HOLD-EMP-NO PIC S9(07) COMP-3. DTSBD140 00295 DTSBD140 00296 05 HOLD-CREDIT-MSG-WRITTEN-IND PIC X(01). DTSBD140 00297 DTSBD140 00298 05 HOLD-YRQ-MAX PIC S9(04) COMP DTSBD140 00299 VALUE +400. DTSBD140 00300 DTSBD140 00301 05 HOLD-YRQ-SUB PIC S9(04) COMP. DTSBD140 00302 DTSBD140 00303 05 HOLD-YRQ-CNT PIC S9(04) COMP. DTSBD140 00304 DTSBD140 00305 05 HOLD-TRANSFERRED-YRQ OCCURS 400 TIMES DTSBD140 00306 INDEXED BY HOLD-YRQ-IDX DTSBD140 00307 PIC S9(05) COMP-3. DTSBD140 00308 DTSBD140 00309 05 TRANSFER-FROM-EMP-CLASS PIC X(01). DTSBD140 00310 88 TRANSFER-FROM-EMP-SELF-INS-88 VALUE 'S'. DTSBD140 00311 DTSBD140 00312 05 TRANSFER-FROM-NAME-CHECK PIC X(04). DTSBD140 00313 DTSBD140 00314 05 TRANSFER-FROM-TOT-CREDIT-AMT PIC S9(09)V9(02) COMP-3.DTSBD140 00315 DTSBD140 00316 05 TRANSFER-TO-NAME-CHECK PIC X(04). DTSBD140 00317 DTSBD140 00318 DTSBD140 00319 05 RECENT-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD140 00320 DTSBD140 00321 DTSBD140 00322 05 TRANSFER-YRQ PIC S9(05) COMP-3. DTSBD140 00323 DTSBD140 00324 DTSBD140 00325 05 TRANSFER-TOT-WAGE PIC S9(11)V9(02) COMP-3.DTSBD140 00326 DTSBD140 00327 05 TRANSFER-EXCESS-WAGE PIC S9(11)V9(02) COMP-3.DTSBD140 00328 DTSBD140 00329 05 TRANSFER-TAX-WAGE PIC S9(11)V9(02) COMP-3.DTSBD140 00330 DTSBD140 00331 05 TRANSFER-WAGE-RPT-IND PIC X(01). DTSBD140 00332 88 TRANSFER-WAGE-RPT-YES-88 VALUE 'Y'. DTSBD140 00333 DTSBD140 00334 05 TRANSFER-LATE-PEN-CHARGED PIC S9(09)V9(02) COMP-3.DTSBD140 00335 DTSBD140 00336 05 TRANSFER-LATE-PEN-WAIVED PIC S9(09)V9(02) COMP-3.DTSBD140 00337 DTSBD140 00338 05 TRANSFER-1ST-MTH-EMPL-CNT PIC S9(07) COMP-3.DTSBD140 00339 DTSBD140 00340 05 TRANSFER-2ND-MTH-EMPL-CNT PIC S9(07) COMP-3.DTSBD140 00341 DTSBD140 00342 05 TRANSFER-3RD-MTH-EMPL-CNT PIC S9(07) COMP-3.DTSBD140 00343 DTSBD140 00344 DTSBD140 00345 05 PRIOR-PSEUDO-BATCH-NO PIC S9(05) COMP-3. DTSBD140 00346 DTSBD140 00347 ** 05 FIRST-TIME-T025-IND PIC X(01). DTSBD140 00348 * 88 FIRST-TIME-T025-YES-88 VALUE 'Y'. DTSBD140 00349 * 88 FIRST-TIME-T025-NO-88 VALUE 'N'. DTSBD140 00350 * DTSBD140 00351 * 05 FIRST-TIME-T026-IND PIC X(01). DTSBD140 00352 * 88 FIRST-TIME-T026-YES-88 VALUE 'Y'. DTSBD140 00353 * 88 FIRST-TIME-T026-NO-88 VALUE 'N'. DTSBD140 00354 * DTSBD140 00355 * 05 FIRST-TIME-T027-IND PIC X(01). DTSBD140 00356 * 88 FIRST-TIME-T027-YES-88 VALUE 'Y'. DTSBD140 00357 ** 88 FIRST-TIME-T027-NO-88 VALUE 'N'. DTSBD140 00358 DTSBD140 00359 DTSBD140 00360 01 TRANSFER-MESSAGES. DTSBD140 00361 05 MSG387-AREA. DTSBD140 00362 10 MSG387-ID PIC X(03) VALUE '387'. DTSBD140 00363 10 MSG387-TEXT. DTSBD140 00364 15 FILLER PIC X(25) DTSBD140 00365 VALUE 'REPORT NOT TRANSFERRED. '. DTSBD140 00366 15 FILLER PIC X(38) DTSBD140 00367 VALUE 'REPORT ALREADY RECORDED. SOURCE EMP: '. DTSBD140 00368 15 MSG387-SOURCE-EMP-NO PIC 999B999. DTSBD140 00369 15 FILLER PIC X(14) DTSBD140 00370 VALUE ' TARGET EMP: '. DTSBD140 00371 15 MSG387-TARGET-EMP-NO PIC 999B999. DTSBD140 00372 15 FILLER PIC X(07) DTSBD140 00373 VALUE ' QTR: '. DTSBD140 00374 15 MSG387-SLASH-QTR PIC X(40). DTSBD140 00375 DTSBD140 00376 05 MSG388-AREA. DTSBD140 00377 10 MSG388-ID PIC X(03) VALUE '388'. DTSBD140 00378 10 MSG388-TEXT. DTSBD140 00379 15 FILLER PIC X(25) DTSBD140 00380 VALUE 'REPORTS TRANSFERRED FROM '. DTSBD140 00381 15 FILLER PIC X(38) DTSBD140 00382 VALUE 'AN EMPLOYER WITH A CREDIT. CREDIT NOT'. DTSBD140 00383 15 FILLER PIC X(14) DTSBD140 00384 VALUE ' TRANSFERRED. '. DTSBD140 00385 EJECT DTSBD140 00386 01 L001-LINK-AREA. DTSBD140 00387 ++INCLUDE DTSIL001 DTSBD140 00388 EJECT DTSBD140 00389 01 L004-LINK-AREA. DTSBD140 00390 ++INCLUDE DTSIL004 DTSBD140 00391 EJECT DTSBD140 00392 01 L142-LINK-AREA. DTSBD140 00393 ++INCLUDE DTSIL142 DTSBD140 00394 EJECT DTSBD140 00395 01 T002-REC. DTSBD140 00396 ++INCLUDE DTSIT002 DTSBD140 00397 EJECT DTSBD140 00398 01 Y104-REC. DTSBD140 00399 ++INCLUDE DTSIY104 DTSBD140 00400 EJECT DTSBD140 00401 01 L516-LINK-AREA. DTSBD140 00402 ++INCLUDE DTSIL516 DTSBD140 00403 EJECT DTSBD140 00404 01 L910-LINK-AREA. DTSBD140 00405 ++INCLUDE DTSIL910 DTSBD140 00406 EJECT DTSBD140 00407 01 MSKL-REC. DTSBD140 00408 ++INCLUDE DTSIMSKL DTSBD140 00409 EJECT DTSBD140 00410 01 MHDR-REC. DTSBD140 00411 ++INCLUDE DTSIMHDR DTSBD140 00412 EJECT DTSBD140 00413 01 MPRF-REC. DTSBD140 00414 ++INCLUDE DTSIMPRF DTSBD140 00415 EJECT DTSBD140 00416 01 MQTR-REC. DTSBD140 00417 ++INCLUDE DTSIMQTR DTSBD140 00418 EJECT DTSBD140 00419 01 MRPT-REC. DTSBD140 00420 ++INCLUDE DTSIMRPT DTSBD140 00421 EJECT DTSBD140 00422 01 MDST-REC. DTSBD140 00423 ++INCLUDE DTSIMDST DTSBD140 00424 EJECT DTSBD140 00425 01 L921-LINK-AREA. DTSBD140 00426 ++INCLUDE DTSIL921 DTSBD140 00427 EJECT DTSBD140 00428 01 ISKL-REC. DTSBD140 00429 ++INCLUDE DTSIISKL DTSBD140 00430 EJECT DTSBD140 00431 01 L923-LINK-AREA. DTSBD140 00432 ++INCLUDE DTSIL923 DTSBD140 00433 EJECT DTSBD140 00434 01 ASKL-REC. DTSBD140 00435 ++INCLUDE DTSIASKL DTSBD140 00436 EJECT DTSBD140 00437 01 AHDR-REC. DTSBD140 00438 ++INCLUDE DTSIAHDR DTSBD140 00439 EJECT DTSBD140 00440 01 ARPT-REC. DTSBD140 00441 ++INCLUDE DTSIARPT DTSBD140 00442 EJECT DTSBD140 00443 01 APAY-REC. DTSBD140 00444 ++INCLUDE DTSIAPAY DTSBD140 00445 EJECT DTSBD140 00446 01 AADJ-REC. DTSBD140 00447 ++INCLUDE DTSIAADJ DTSBD140 00448 EJECT DTSBD140 00449 01 L926-LINK-AREA. DTSBD140 00450 ++INCLUDE DTSIL926 DTSBD140 00451 EJECT DTSBD140 00452 01 RSKL-REC. DTSBD140 00453 ++INCLUDE DTSIRSK5 DTSBD140 00454 EJECT DTSBD140 00455 01 T025-REC. DTSBD140 00456 ++INCLUDE DTSIT025 DTSBD140 00457 EJECT DTSBD140 00458 01 T026-REC. DTSBD140 00459 ++INCLUDE DTSIT026 DTSBD140 00460 EJECT DTSBD140 00461 01 T028-REC. DTSBD140 00462 ++INCLUDE DTSIT028 DTSBD140 00463 EJECT DTSBD140 00464 01 T027-REC. DTSBD140 00465 ++INCLUDE DTSIT027 DTSBD140 00466 EJECT DTSBD140 00467 01 T031-REC. DTSBD140 00468 ++INCLUDE DTSIT031 DTSBD140 00469 EJECT DTSBD140 00470 01 L931-LINK-AREA. DTSBD140 00471 ++INCLUDE DTSIL931 DTSBD140 00472 EJECT DTSBD140 00473 01 FSKL-REC. DTSBD140 00474 ++INCLUDE DTSIFSKL DTSBD140 00475 EJECT DTSBD140 00476 01 R907-REC. DTSBD140 00477 ++INCLUDE DTSIR907 DTSBD140 00478 EJECT DTSBD140 00479 01 WRK-BATCH-AUDIT-REC. DTSBD140 00480 ++INCLUDE DTSIX214 DTSBD140 00481 EJECT DTSBD140 00482 CL**2 00483 01 L985-LINK-AREA. CL**2 00484 ++INCLUDE DTSIL985 CL**2 00485 01 LINK-REC. CL**2 00486 ++INCLUDE DTSIWBAT CL**2 00487 CL**2 00488 PROCEDURE DIVISION. DTSBD140 00489 DTSBD140 00490 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD140 00491 DTSBD140 00492 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD140 00493 DTSBD140 00494 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD140 00495 DTSBD140 00496 DTSBD140 00497 GOBACK. DTSBD140 00498 EJECT DTSBD140 00499 I0000-INITIATE. DTSBD140 00500 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD140 00501 DTSBD140 00502 PERFORM I2000-INITIALIZE-WRK THRU I2000-EXIT. DTSBD140 00503 I0000-EXIT. DTSBD140 00504 EXIT. DTSBD140 00505 EJECT DTSBD140 00506 I1000-OPEN-FILES. DTSBD140 00507 MOVE 'N' TO L910-TRACE-IND DTSBD140 00508 L923-TRACE-IND DTSBD140 00509 L926-TRACE-IND DTSBD140 00510 L931-TRACE-IND DTSBD140 00511 L985-TRACE-IND CL*12 00512 L516-TRACE-IND. DTSBD140 00513 DTSBD140 00514 DTSBD140 00515 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD140 00516 L923-MOD-NAME DTSBD140 00517 L926-MOD-NAME DTSBD140 00518 L985-MOD-NAME CL*12 00519 L931-MOD-NAME. DTSBD140 00520 DTSBD140 00521 DTSBD140 00522 *** PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT. DTSBD140 00523 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBD140 00524 DTSBD140 00525 PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBD140 00526 DTSBD140 00527 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. DTSBD140 00528 DTSBD140 00529 PERFORM S926-OPEN-READ THRU S926-EXIT. DTSBD140 00530 DTSBD140 00531 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD140 00532 CL**3 00533 PERFORM S985-OPEN THRU S985-EXIT. CL**3 00534 DTSBD140 00535 OPEN OUTPUT BATCH-AUDIT-FILE. DTSBD140 00536 IF BATCH-AUDIT-OK-88 DTSBD140 00537 NEXT SENTENCE DTSBD140 00538 ELSE DTSBD140 00539 DISPLAY 'CANNOT OPEN BATCH AUDIT FILE ' DTSBD140 00540 BATCH-AUDIT-STATUS DTSBD140 00541 PERFORM S999-ABEND THRU S999-EXIT DTSBD140 00542 END-IF. DTSBD140 00543 DTSBD140 00544 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD140 00545 I1000-EXIT. DTSBD140 00546 EXIT. DTSBD140 00547 EJECT DTSBD140 00548 I2000-INITIALIZE-WRK. DTSBD140 00549 MOVE +0 TO WRK-BTC-REC-CNT DTSBD140 00550 WRK-BTC-TRAN-CNT DTSBD140 00551 WRK-ATC-BATCH-CNT DTSBD140 00552 WRK-AHDR-ITEM-NO CL*18 00553 WRK-ATC-TRAN-CNT DTSBD140 00554 WRK-T002-CNT DTSBD140 00555 WRK-BX214-CNT DTSBD140 00556 WRK-R907-REC-CNT. DTSBD140 00557 DTSBD140 00558 MOVE SPACES TO RSK5-REC-TYPE. DTSBD140 00559 DTSBD140 00560 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD140 00561 DTSBD140 00562 MOVE +0 TO MHDR-EMP-NO. DTSBD140 00563 DTSBD140 00564 SET MHDR-HDR-88 TO TRUE. DTSBD140 00565 DTSBD140 00566 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 00567 DTSBD140 00568 PERFORM S910-READ THRU S910-EXIT. DTSBD140 00569 DTSBD140 00570 IF L910-OK-88 DTSBD140 00571 MOVE MSKL-REC TO MHDR-REC DTSBD140 00572 ELSE DTSBD140 00573 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 00574 DTSBD140 00575 DTSBD140 00576 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSBD140 00577 DTSBD140 00578 DTSBD140 00579 MOVE +0 TO HOLD-EMP-NO DTSBD140 00580 HOLD-YRQ-CNT. DTSBD140 00581 DTSBD140 00582 DTSBD140 00583 MOVE +0 TO PRIOR-PSEUDO-BATCH-NO. DTSBD140 00584 DTSBD140 00585 * SET FIRST-TIME-T025-YES-88 TO TRUE. DTSBD140 00586 * SET FIRST-TIME-T026-YES-88 TO TRUE. DTSBD140 00587 * SET FIRST-TIME-T027-YES-88 TO TRUE. DTSBD140 00588 DTSBD140 00589 SET L142-INITIATE-88 TO TRUE. DTSBD140 00590 MOVE MHDR-CURR-RUN-DATE TO L142-CURR-RUN-DATE. DTSBD140 00591 PERFORM S142-NEW-EMP THRU S142-EXIT. DTSBD140 00592 DTSBD140 00593 I2000-EXIT. DTSBD140 00594 EXIT. DTSBD140 00595 EJECT DTSBD140 00596 P0000-PROCESS. DTSBD140 00597 PERFORM P1000-BTC-FILE THRU P1000-EXIT DTSBD140 00598 UNTIL L926-NO-REC-88. DTSBD140 00599 P0000-EXIT. DTSBD140 00600 EXIT. DTSBD140 00601 EJECT DTSBD140 00602 P1000-BTC-FILE. DTSBD140 00603 PERFORM S926-READ-NEXT THRU S926-EXIT. DTSBD140 00604 DTSBD140 00605 IF L926-NO-REC-88 DTSBD140 00606 GO TO P1000-EXIT. DTSBD140 00607 DTSBD140 00608 DTSBD140 00609 ADD +1 TO WRK-BTC-REC-CNT. DTSBD140 00610 DTSBD140 00611 *& DTSBD140 00612 DISPLAY 'DTSBD140 P1000 ' RSK5-REC-TYPE. DTSBD140 00613 *& DTSBD140 00614 EVALUATE TRUE DTSBD140 00615 WHEN RSK5-REC-TYPE = '002' DTSBD140 00616 PERFORM P9000-ADD-PROFILE THRU P9000-EXIT DTSBD140 00617 DTSBD140 00618 WHEN RSK5-REC-TYPE = '026' DTSBD140 00619 PERFORM P2000-GENERATE-ADJ THRU P2000-EXIT DTSBD140 00620 DTSBD140 00621 WHEN RSK5-REC-TYPE = '031' DTSBD140 00622 PERFORM P5000-TRANSFER THRU P5000-EXIT DTSBD140 00623 DTSBD140 00624 WHEN RSK5-REC-TYPE = '025' DTSBD140 00625 PERFORM P7000-GENERATE-PAY THRU P7000-EXIT DTSBD140 00626 DTSBD140 00627 WHEN RSK5-REC-TYPE = '028' DTSBD140 00628 PERFORM P8000-GENERATE-RPT THRU P8000-EXIT DTSBD140 00629 DTSBD140 00630 WHEN OTHER DTSBD140 00631 PERFORM P3000-GENERATE-TRAN THRU P3000-EXIT DTSBD140 00632 DTSBD140 00633 END-EVALUATE. DTSBD140 00634 P1000-EXIT. DTSBD140 00635 EXIT. DTSBD140 00636 DTSBD140 00637 P2000-GENERATE-ADJ. DTSBD140 00638 ***** DTSBD140 00639 * IF T026 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN DTSBD140 00640 * BATCH INCLUDES T026 GENERATED AADJ RECOPRDS, THE BATCH MAY DTSBD140 00641 * INCLUDE ONLY T026 GENERATED AADJ RECORDS) TERMINATE THE OPEN DTSBD140 00642 * BATCH AND INITIATE A NEW BATCH. DTSBD140 00643 ***** DTSBD140 00644 *& DTSBD140 00645 DISPLAY 'DTSBD140 P2000 T026 FIRST TIME ' DTSBD140 00646 ' ' AHDR-BATCH-NO. DTSBD140 00647 *& DTSBD140 00648 ** IF FIRST-TIME-T027-NO-88 DTSBD140 00649 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 00650 * PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 00651 * SET FIRST-TIME-T027-YES-88 TO TRUE. DTSBD140 00652 * DTSBD140 00653 * IF FIRST-TIME-T025-NO-88 DTSBD140 00654 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 00655 * PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 00656 ** SET FIRST-TIME-T025-YES-88 TO TRUE. DTSBD140 00657 DTSBD140 00658 IF WRK-CURR-REC-TYPE NOT = '026' DTSBD140 00659 MOVE RSK5-REC-TYPE TO WRK-CURR-REC-TYPE DTSBD140 00660 IF AHDR-ATC-FILE-TRAN-CNT > 0 DTSBD140 00661 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 00662 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 00663 END-IF DTSBD140 00664 END-IF. DTSBD140 00665 DTSBD140 00666 IF AHDR-ATC-FILE-TRAN-CNT NOT < +475 CL**4 00667 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 00668 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSBD140 00669 DTSBD140 00670 IF RSK5-REC-TYPE = '026' DTSBD140 00671 MOVE RSKL-REC TO T026-REC DTSBD140 00672 PERFORM P2300-ATC-ADJUSTMENT THRU P2300-EXIT DTSBD140 00673 ELSE DTSBD140 00674 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 00675 SKIP2 DTSBD140 00676 P2000-EXIT. DTSBD140 00677 EXIT. DTSBD140 00678 EJECT DTSBD140 00679 P2300-ATC-ADJUSTMENT. DTSBD140 00680 PERFORM P2400-GEN-ATC-TRAN-FORMAT THRU P2400-EXIT. DTSBD140 00681 DTSBD140 00682 IF T026-REIMB-CHG DTSBD140 00683 OR T026-ADM-ASSESSMNT DTSBD140 00684 PERFORM P2500-REIMB-CHG THRU P2500-EXIT DTSBD140 00685 ELSE DTSBD140 00686 IF T026-LATE-PEN-CHG OR T026-LATE-PEN-WAIVE DTSBD140 00687 PERFORM P4300-WRITE-AADJ THRU P4300-EXIT DTSBD140 00688 ELSE DTSBD140 00689 IF T026-TOLERANCE DTSBD140 00690 PERFORM P4300-WRITE-AADJ THRU P4300-EXIT DTSBD140 00691 ELSE DTSBD140 00692 MOVE '331' TO R907-MSG-ID DTSBD140 00693 MOVE 'T026-TRN-CD NOT VALID : ' DTSBD140 00694 TO WRK-MSG-TEXT-1 DTSBD140 00695 MOVE T026-TRN-CD TO WRK-MSG-TEXT-2 DTSBD140 00696 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT. DTSBD140 00697 SKIP2 DTSBD140 00698 P2300-EXIT. DTSBD140 00699 EXIT. DTSBD140 00700 EJECT DTSBD140 00701 P2400-GEN-ATC-TRAN-FORMAT. DTSBD140 00702 MOVE LOW-VALUES TO AADJ-REC. DTSBD140 00703 DTSBD140 00704 MOVE AHDR-BATCH-NO TO AADJ-BATCH-NO. DTSBD140 00705 DTSBD140 00706 MOVE +0 TO AADJ-ITEM-NO. CL**6 00707 DTSBD140 00708 SET AADJ-ADJ-88 TO TRUE. DTSBD140 00709 DTSBD140 00710 MOVE T026-NAME-CHECK TO AADJ-NAME-CHECK. DTSBD140 00711 DTSBD140 00712 MOVE T026-EMP-NO TO AADJ-EMP-NO. DTSBD140 00713 DTSBD140 00714 IF T026-REIMB-CHG DTSBD140 00715 OR T026-ADM-ASSESSMNT DTSBD140 00716 SET AADJ-CHARGE-88 TO TRUE DTSBD140 00717 ELSE DTSBD140 00718 IF T026-LATE-PEN-CHG DTSBD140 00719 SET AADJ-CHARGE-88 TO TRUE DTSBD140 00720 ELSE DTSBD140 00721 IF T026-LATE-PEN-WAIVE DTSBD140 00722 SET AADJ-WAIVE-88 TO TRUE DTSBD140 00723 ELSE DTSBD140 00724 IF T026-TOLERANCE DTSBD140 00725 SET AADJ-TOLER-88 TO TRUE DTSBD140 00726 ELSE DTSBD140 00727 MOVE SPACE TO AADJ-ADJ-TYPE. DTSBD140 00728 DTSBD140 00729 IF T026-AMT NUMERIC DTSBD140 00730 MOVE T026-AMT TO AADJ-AMT DTSBD140 00731 ELSE DTSBD140 00732 MOVE +0 TO AADJ-AMT. DTSBD140 00733 DTSBD140 00734 IF T026-RECEIVED-DATE NUMERIC DTSBD140 00735 MOVE T026-RECEIVED-DATE TO AADJ-RECEIVED-DATE DTSBD140 00736 ELSE DTSBD140 00737 MOVE +0 TO AADJ-RECEIVED-DATE. DTSBD140 00738 DTSBD140 00739 MOVE +0 TO AADJ-DEPOSIT-DATE. DTSBD140 00740 DTSBD140 00741 IF T026-APPLIC-YRQ NUMERIC DTSBD140 00742 MOVE T026-APPLIC-YRQ TO AADJ-APPLIC-YRQ DTSBD140 00743 ELSE DTSBD140 00744 MOVE +0 TO AADJ-APPLIC-YRQ. DTSBD140 00745 DTSBD140 00746 MOVE T026-APPLIC-IND TO AADJ-APPLIC-IND. DTSBD140 00747 DTSBD140 00748 IF (T026-APPLIC-BATCH-NO NUMERIC) DTSBD140 00749 AND DTSBD140 00750 (T026-APPLIC-ITEM-NO NUMERIC) DTSBD140 00751 MOVE T026-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO DTSBD140 00752 ELSE DTSBD140 00753 MOVE +0 TO AADJ-APPLIC-BATCH-NO DTSBD140 00754 AADJ-APPLIC-ITEM-NO. DTSBD140 00755 DTSBD140 00756 IF T026-DATE-1 NUMERIC DTSBD140 00757 MOVE T026-DATE-1 TO AADJ-DATE-1 DTSBD140 00758 ELSE DTSBD140 00759 MOVE +0 TO AADJ-DATE-1. DTSBD140 00760 DTSBD140 00761 IF T026-DATE-2 NUMERIC DTSBD140 00762 MOVE T026-DATE-2 TO AADJ-DATE-2 DTSBD140 00763 ELSE DTSBD140 00764 MOVE +0 TO AADJ-DATE-2. DTSBD140 00765 DTSBD140 00766 MOVE T026-INT-SPAN-IND TO AADJ-INT-SPAN-IND. DTSBD140 00767 DTSBD140 00768 IF T026-INT-RATE NUMERIC DTSBD140 00769 MOVE T026-INT-RATE TO AADJ-INT-RATE DTSBD140 00770 ELSE DTSBD140 00771 SET MQTR-NO-UI-RATE-88 TO TRUE DTSBD140 00772 MOVE MQTR-UI-RATE TO AADJ-INT-RATE. DTSBD140 00773 DTSBD140 00774 MOVE 'N' TO AADJ-DISREGARD-EDITS-IND. DTSBD140 00775 DTSBD140 00776 MOVE T026-RESPONSIBLE-ACTIVITY DTSBD140 00777 TO AADJ-RESPONSIBLE-ACTIVITY. DTSBD140 00778 DTSBD140 00779 MOVE T026-RESPONSIBLE-OP-ID TO AADJ-RESPONSIBLE-OP-ID. DTSBD140 00780 DTSBD140 00781 MOVE +0 TO AADJ-CMP-ESTB-ABSTIME. DTSBD140 00782 DTSBD140 00783 SET AADJ-NOT-PROCESSED-88 TO TRUE. DTSBD140 00784 P2400-EXIT. DTSBD140 00785 EXIT. DTSBD140 00786 EJECT DTSBD140 00787 P2500-REIMB-CHG. DTSBD140 00788 IF T026-REIMB-CHG DTSBD140 00789 SET AADJ-UI-88 TO TRUE DTSBD140 00790 ELSE DTSBD140 00791 IF T026-ADM-ASSESSMNT DTSBD140 00792 SET AADJ-SUR-88 TO TRUE DTSBD140 00793 ELSE DTSBD140 00794 MOVE '336' TO R907-MSG-ID DTSBD140 00795 MOVE 'T026-TRN-CD (REIMB CHG) NOT VALID' DTSBD140 00796 TO WRK-MSG-TEXT DTSBD140 00797 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT DTSBD140 00798 GO TO P2500-EXIT. DTSBD140 00799 DTSBD140 00800 MOVE +0 DTSBD140 00801 TO AADJ-APPLIC-BATCH-NO DTSBD140 00802 AADJ-APPLIC-ITEM-NO DTSBD140 00803 AADJ-DATE-1 DTSBD140 00804 AADJ-DATE-2. DTSBD140 00805 DTSBD140 00806 MOVE SPACE TO AADJ-INT-SPAN-IND. DTSBD140 00807 DTSBD140 00808 SET MQTR-NO-UI-RATE-88 TO TRUE. DTSBD140 00809 DTSBD140 00810 MOVE MQTR-UI-RATE TO AADJ-INT-RATE. DTSBD140 00811 DTSBD140 00812 MOVE AADJ-APPLIC-YRQ TO L004-QTR-5-9. DTSBD140 00813 DTSBD140 00814 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD140 00815 DTSBD140 00816 IF L004-INVALID-QTR DTSBD140 00817 MOVE '332' TO R907-MSG-ID DTSBD140 00818 MOVE 'T026-APPLIC-YRQ (REIMB CHG) NOT VALID' DTSBD140 00819 TO WRK-MSG-TEXT DTSBD140 00820 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT DTSBD140 00821 GO TO P2500-EXIT. DTSBD140 00822 DTSBD140 00823 IF AADJ-AMT > +0 DTSBD140 00824 PERFORM P4300-WRITE-AADJ THRU P4300-EXIT DTSBD140 00825 GO TO P2500-EXIT. DTSBD140 00826 DTSBD140 00827 IF AADJ-AMT = +0 DTSBD140 00828 MOVE '333' TO R907-MSG-ID DTSBD140 00829 MOVE 'T026-AMT NOT VALID (REIMB CHG) : ' DTSBD140 00830 TO WRK-MSG-TEXT-1 DTSBD140 00831 MOVE AADJ-AMT TO WS-AMT-X DTSBD140 00832 MOVE WS-AMT-X TO WRK-MSG-TEXT-2 DTSBD140 00833 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT DTSBD140 00834 GO TO P2500-EXIT. DTSBD140 00835 DTSBD140 00836 ********************************************************* DTSBD140 00837 * HANDLE NEGATIVE CHARGE ADJUSTMENTS FOR ADMINISTRATIVE DTSBD140 00838 * ASSESSMENT IN P2540. DTSBD140 00839 ********************************************************* DTSBD140 00840 IF T026-ADM-ASSESSMNT DTSBD140 00841 PERFORM P2540-ADM-ASSESS-ADJ THRU P2540-EXIT DTSBD140 00842 GO TO P2500-EXIT DTSBD140 00843 END-IF. DTSBD140 00844 DTSBD140 00845 MOVE +0 TO START-ABS-QTR DTSBD140 00846 END-ABS-QTR. DTSBD140 00847 DTSBD140 00848 PERFORM P2510-CALC-START-END-QTR THRU P2510-EXIT. DTSBD140 00849 DTSBD140 00850 IF START-ABS-QTR = 0 DTSBD140 00851 GO TO P2500-EXIT. DTSBD140 00852 DTSBD140 00853 MOVE AADJ-AMT TO T026-AMT. DTSBD140 00854 DTSBD140 00855 PERFORM P2520-READ-QTR THRU P2520-EXIT DTSBD140 00856 UNTIL START-ABS-QTR > END-ABS-QTR OR DTSBD140 00857 T026-AMT NOT < +0. DTSBD140 00858 DTSBD140 00859 IF T026-AMT NOT = +0 DTSBD140 00860 MOVE '334' TO R907-MSG-ID DTSBD140 00861 MOVE 'REIMB CHARGE AMT NOT ALLOCATED : ' DTSBD140 00862 TO WRK-MSG-TEXT-1 DTSBD140 00863 MOVE T026-AMT TO WS-AMT-X DTSBD140 00864 MOVE WS-AMT-X TO WRK-MSG-TEXT-2 DTSBD140 00865 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT. DTSBD140 00866 P2500-EXIT. DTSBD140 00867 EXIT. DTSBD140 00868 EJECT DTSBD140 00869 P2510-CALC-START-END-QTR. DTSBD140 00870 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD140 00871 DTSBD140 00872 MOVE AADJ-EMP-NO TO MPRF-EMP-NO. DTSBD140 00873 DTSBD140 00874 SET MPRF-PRF-88 TO TRUE. DTSBD140 00875 DTSBD140 00876 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 00877 DTSBD140 00878 PERFORM S910-READ THRU S910-EXIT. DTSBD140 00879 DTSBD140 00880 IF L910-OK-88 DTSBD140 00881 MOVE MSKL-REC TO MPRF-REC DTSBD140 00882 ELSE DTSBD140 00883 MOVE '334' TO R907-MSG-ID DTSBD140 00884 MOVE 'REIMB CHARGE AMT NOT ALLOCATED : ' DTSBD140 00885 TO WRK-MSG-TEXT-1 DTSBD140 00886 MOVE AADJ-AMT TO WS-AMT-X DTSBD140 00887 MOVE WS-AMT-X TO WRK-MSG-TEXT-2 DTSBD140 00888 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT DTSBD140 00889 GO TO P2510-EXIT. DTSBD140 00890 DTSBD140 00891 DTSBD140 00892 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD140 00893 DTSBD140 00894 MOVE AADJ-EMP-NO TO MQTR-EMP-NO. DTSBD140 00895 DTSBD140 00896 SET MQTR-QTR-88 TO TRUE. DTSBD140 00897 DTSBD140 00898 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 00899 DTSBD140 00900 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD140 00901 DTSBD140 00902 IF L910-OK-88 DTSBD140 00903 MOVE MSKL-REC TO MQTR-REC DTSBD140 00904 ELSE DTSBD140 00905 MOVE '334' TO R907-MSG-ID DTSBD140 00906 MOVE 'REIMB CHARGE AMT NOT ALLOCATED : ' DTSBD140 00907 TO WRK-MSG-TEXT-1 DTSBD140 00908 MOVE AADJ-AMT TO WS-AMT-X DTSBD140 00909 MOVE WS-AMT-X TO WRK-MSG-TEXT-2 DTSBD140 00910 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT DTSBD140 00911 GO TO P2510-EXIT. DTSBD140 00912 DTSBD140 00913 DTSBD140 00914 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBD140 00915 DTSBD140 00916 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD140 00917 DTSBD140 00918 IF L004-INVALID-QTR DTSBD140 00919 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 00920 DTSBD140 00921 MOVE L004-ABS-QTR TO START-ABS-QTR. DTSBD140 00922 DTSBD140 00923 DTSBD140 00924 MOVE T026-APPLIC-YRQ TO L004-QTR-5-9. DTSBD140 00925 DTSBD140 00926 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD140 00927 DTSBD140 00928 IF L004-INVALID-QTR DTSBD140 00929 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 00930 DTSBD140 00931 MOVE L004-ABS-QTR TO END-ABS-QTR. DTSBD140 00932 DTSBD140 00933 DTSBD140 00934 IF START-ABS-QTR > END-ABS-QTR DTSBD140 00935 MOVE END-ABS-QTR TO START-ABS-QTR. DTSBD140 00936 P2510-EXIT. DTSBD140 00937 EXIT. DTSBD140 00938 EJECT DTSBD140 00939 P2520-READ-QTR. DTSBD140 00940 MOVE END-ABS-QTR TO L004-ABS-QTR. DTSBD140 00941 DTSBD140 00942 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD140 00943 DTSBD140 00944 IF L004-INVALID-QTR DTSBD140 00945 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 00946 DTSBD140 00947 DTSBD140 00948 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD140 00949 DTSBD140 00950 MOVE AADJ-EMP-NO TO MQTR-EMP-NO. DTSBD140 00951 DTSBD140 00952 SET MQTR-QTR-88 TO TRUE. DTSBD140 00953 DTSBD140 00954 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBD140 00955 DTSBD140 00956 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 00957 DTSBD140 00958 PERFORM S910-READ THRU S910-EXIT. DTSBD140 00959 DTSBD140 00960 SUBTRACT +1 FROM END-ABS-QTR. DTSBD140 00961 DTSBD140 00962 IF L910-OK-88 DTSBD140 00963 MOVE MSKL-REC TO MQTR-REC DTSBD140 00964 PERFORM P2530-SCAN-QTR-ACCTS THRU P2530-EXIT DTSBD140 00965 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD140 00966 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBD140 00967 P2520-EXIT. DTSBD140 00968 EXIT. DTSBD140 00969 EJECT DTSBD140 00970 P2530-SCAN-QTR-ACCTS. DTSBD140 00971 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) AND DTSBD140 00972 MQTR-CHARGED-AMT(MQTR-ACCT-IDX) > +0 DTSBD140 00973 NEXT SENTENCE DTSBD140 00974 ELSE DTSBD140 00975 GO TO P2530-EXIT. DTSBD140 00976 DTSBD140 00977 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) T026-AMT DTSBD140 00978 GIVING HOLD-T026-AMT. DTSBD140 00979 DTSBD140 00980 IF HOLD-T026-AMT < +0 DTSBD140 00981 MULTIPLY MQTR-CHARGED-AMT (MQTR-ACCT-IDX) BY -1 DTSBD140 00982 GIVING AADJ-AMT DTSBD140 00983 MOVE HOLD-T026-AMT TO T026-AMT DTSBD140 00984 ELSE DTSBD140 00985 MOVE T026-AMT TO AADJ-AMT DTSBD140 00986 MOVE +0 TO T026-AMT. DTSBD140 00987 DTSBD140 00988 MOVE MQTR-YRQ TO AADJ-APPLIC-YRQ. DTSBD140 00989 DTSBD140 00990 PERFORM P4300-WRITE-AADJ THRU P4300-EXIT. DTSBD140 00991 DTSBD140 00992 *****MOVE '335' TO R907-MSG-ID. DTSBD140 00993 *****MOVE 'REIMB CHARGE AMT ALLOCATED : ' DTSBD140 00994 ***** TO WRK-MSG-TEXT-1. DTSBD140 00995 *****MOVE AADJ-AMT TO WS-AMT-X. DTSBD140 00996 *****MOVE WS-AMT-X TO WRK-MSG-TEXT-2. DTSBD140 00997 *****PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT. DTSBD140 00998 P2530-EXIT. DTSBD140 00999 EXIT. DTSBD140 01000 DTSBD140 01001 P2540-ADM-ASSESS-ADJ. DTSBD140 01002 *& DTSBD140 01003 * MOVE T026-AMT TO AMT-DISP1. DTSBD140 01004 * DISPLAY 'DTSBD140 P2540 ' T026-EMP-NO ' ' T026-APPLIC-YRQ DTSBD140 01005 * ' ' AMT-DISP1. DTSBD140 01006 *& DTSBD140 01007 MOVE T026-APPLIC-YRQ TO L004-QTR-5-9. DTSBD140 01008 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD140 01009 IF L004-INVALID-QTR DTSBD140 01010 PERFORM S999-ABEND THRU S999-EXIT DTSBD140 01011 END-IF. DTSBD140 01012 DTSBD140 01013 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD140 01014 DTSBD140 01015 MOVE AADJ-EMP-NO TO MQTR-EMP-NO. DTSBD140 01016 DTSBD140 01017 SET MQTR-QTR-88 TO TRUE. DTSBD140 01018 DTSBD140 01019 MOVE T026-APPLIC-YRQ TO MQTR-YRQ. DTSBD140 01020 DTSBD140 01021 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 01022 DTSBD140 01023 PERFORM S910-READ THRU S910-EXIT. DTSBD140 01024 IF L910-OK-88 DTSBD140 01025 MOVE MSKL-REC TO MQTR-REC DTSBD140 01026 PERFORM P2541-SCAN-QTR-ACCTS THRU P2541-EXIT DTSBD140 01027 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD140 01028 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD140 01029 END-IF. DTSBD140 01030 DTSBD140 01031 P2540-EXIT. DTSBD140 01032 EXIT. DTSBD140 01033 DTSBD140 01034 P2541-SCAN-QTR-ACCTS. DTSBD140 01035 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSBD140 01036 MQTR-CHARGED-AMT(MQTR-ACCT-IDX) > +0 DTSBD140 01037 NEXT SENTENCE DTSBD140 01038 ELSE DTSBD140 01039 GO TO P2541-EXIT DTSBD140 01040 END-IF. DTSBD140 01041 DTSBD140 01042 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) T026-AMT DTSBD140 01043 GIVING HOLD-T026-AMT. DTSBD140 01044 DTSBD140 01045 IF HOLD-T026-AMT < +0 DTSBD140 01046 MULTIPLY MQTR-CHARGED-AMT (MQTR-ACCT-IDX) BY -1 DTSBD140 01047 GIVING AADJ-AMT DTSBD140 01048 MOVE HOLD-T026-AMT TO T026-AMT DTSBD140 01049 ELSE DTSBD140 01050 MOVE T026-AMT TO AADJ-AMT DTSBD140 01051 MOVE +0 TO T026-AMT DTSBD140 01052 END-IF. DTSBD140 01053 DTSBD140 01054 MOVE T026-APPLIC-YRQ TO AADJ-APPLIC-YRQ. DTSBD140 01055 DTSBD140 01056 *& DTSBD140 01057 * MOVE AADJ-AMT TO AMT-DISP1. DTSBD140 01058 * DISPLAY 'DTSBD140 P2541 ' T026-EMP-NO ' ' T026-APPLIC-YRQ DTSBD140 01059 * ' ' AMT-DISP1. DTSBD140 01060 *& DTSBD140 01061 PERFORM P4300-WRITE-AADJ THRU P4300-EXIT. DTSBD140 01062 DTSBD140 01063 IF T026-AMT NOT = +0 DTSBD140 01064 MOVE '334' TO R907-MSG-ID DTSBD140 01065 MOVE 'REIMB CHARGE AMT NOT ALLOCATED : ' DTSBD140 01066 TO WRK-MSG-TEXT-1 DTSBD140 01067 MOVE T026-AMT TO WS-AMT-X DTSBD140 01068 MOVE WS-AMT-X TO WRK-MSG-TEXT-2 DTSBD140 01069 PERFORM P2800-GENERATE-R907-REC THRU P2800-EXIT DTSBD140 01070 END-IF. DTSBD140 01071 DTSBD140 01072 P2541-EXIT. DTSBD140 01073 EXIT. DTSBD140 01074 DTSBD140 01075 P2800-GENERATE-R907-REC. DTSBD140 01076 MOVE T026-EMP-NO TO R907-EMP-NO. DTSBD140 01077 DTSBD140 01078 MOVE WRK-MSG-TEXT TO R907-MSG-TEXT. DTSBD140 01079 DTSBD140 01080 MOVE WRK-MOD-NAME TO R907-MODULE-NAME. DTSBD140 01081 DTSBD140 01082 PERFORM S947-R907-WRITE THRU S947-EXIT. DTSBD140 01083 DTSBD140 01084 ADD +1 TO WRK-R907-REC-CNT. DTSBD140 01085 P2800-EXIT. DTSBD140 01086 EXIT. DTSBD140 01087 EJECT DTSBD140 01088 P3000-GENERATE-TRAN. DTSBD140 01089 *& DTSBD140 01090 IF RSK5-REC-TYPE = '002' DTSBD140 01091 DISPLAY 'DTSBD140 P3000 ' T002-EMP-NO ' ' T002-TRN-CD. DTSBD140 01092 *& DTSBD140 01093 PERFORM S946-TRN-REC-O THRU S946-EXIT. DTSBD140 01094 DTSBD140 01095 ADD +1 TO WRK-BTC-TRAN-CNT. DTSBD140 01096 P3000-EXIT. DTSBD140 01097 EXIT. DTSBD140 01098 EJECT DTSBD140 01099 P4100-WRITE-ARPT. DTSBD140 01100 IF AHDR-ATC-FILE-TRAN-CNT < +475 CL**4 01101 NEXT SENTENCE DTSBD140 01102 ELSE DTSBD140 01103 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01104 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01105 MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO. DTSBD140 01106 DTSBD140 01107 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT CL**4 01108 WRK-AHDR-ITEM-NO. CL*16 01109 CL**4 01110 MOVE WRK-AHDR-ITEM-NO TO ARPT-ITEM-NO. CL*16 01111 DTSBD140 01112 MOVE ARPT-REC TO ASKL-REC. DTSBD140 01113 DTSBD140 01114 PERFORM S923-WRITE THRU S923-EXIT. DTSBD140 01115 *& CL*16 01116 DISPLAY 'DTSBD140 P4100 ' ARPT-EMP-NO ' ' ARPT-BATCH-NO CL*16 01117 ' ' ARPT-ITEM-NO. CL*16 01118 *& CL*16 01119 DTSBD140 01120 ADD +1 TO WRK-ATC-TRAN-CNT. DTSBD140 01121 P4100-EXIT. DTSBD140 01122 EXIT. DTSBD140 01123 SKIP3 DTSBD140 01124 P4200-WRITE-APAY. DTSBD140 01125 IF AHDR-ATC-FILE-TRAN-CNT < +475 CL**4 01126 NEXT SENTENCE DTSBD140 01127 ELSE DTSBD140 01128 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01129 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01130 MOVE AHDR-BATCH-NO TO APAY-BATCH-NO. DTSBD140 01131 DTSBD140 01132 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT CL**4 01133 WRK-AHDR-ITEM-NO. CL*16 01134 CL**4 01135 MOVE WRK-AHDR-ITEM-NO TO APAY-ITEM-NO. CL*16 01136 DTSBD140 01137 MOVE APAY-REC TO ASKL-REC. DTSBD140 01138 DTSBD140 01139 PERFORM S923-WRITE THRU S923-EXIT. DTSBD140 01140 DTSBD140 01141 *& DTSBD140 01142 DISPLAY 'DTSBD140 P4200 ' APAY-EMP-NO ' ' APAY-BATCH-NO CL*16 01143 ' ' APAY-ITEM-NO. CL*16 01144 *& DTSBD140 01145 ADD +1 TO WRK-ATC-TRAN-CNT. DTSBD140 01146 P4200-EXIT. DTSBD140 01147 EXIT. DTSBD140 01148 SKIP3 DTSBD140 01149 P4300-WRITE-AADJ. DTSBD140 01150 IF AHDR-ATC-FILE-TRAN-CNT < +475 CL**4 01151 NEXT SENTENCE DTSBD140 01152 ELSE DTSBD140 01153 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01154 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01155 MOVE AHDR-BATCH-NO TO AADJ-BATCH-NO. DTSBD140 01156 DTSBD140 01157 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT CL**4 01158 WRK-AHDR-ITEM-NO. CL*16 01159 CL**4 01160 MOVE WRK-AHDR-ITEM-NO TO AADJ-ITEM-NO. CL*16 01161 DTSBD140 01162 MOVE AADJ-REC TO ASKL-REC. DTSBD140 01163 DTSBD140 01164 PERFORM S923-WRITE THRU S923-EXIT. DTSBD140 01165 DTSBD140 01166 *& CL*16 01167 DISPLAY 'DTSBD140 P4300 ' AADJ-EMP-NO ' ' AADJ-BATCH-NO CL*16 01168 ' ' AADJ-ITEM-NO. CL*16 01169 *& CL*16 01170 ADD +1 TO WRK-ATC-TRAN-CNT. DTSBD140 01171 P4300-EXIT. DTSBD140 01172 EXIT. DTSBD140 01173 EJECT DTSBD140 01174 P5000-TRANSFER. DTSBD140 01175 PERFORM P3000-GENERATE-TRAN THRU P3000-EXIT. DTSBD140 01176 DTSBD140 01177 MOVE RSKL-REC TO T031-REC. DTSBD140 01178 DTSBD140 01179 IF T031-TRANSFER-YES-88 DTSBD140 01180 NEXT SENTENCE DTSBD140 01181 ELSE DTSBD140 01182 GO TO P5000-EXIT. DTSBD140 01183 DTSBD140 01184 ***** DTSBD140 01185 * IF T027 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN DTSBD140 01186 * BATCH INCLUDES T027 GENERATED ARPT RECORDS, THE BATCH MAY DTSBD140 01187 * INCLUDE ONLY T027 GENERATED ARPT RECORDS) TERMINATE THE OPEN DTSBD140 01188 * BATCH AND INITIATE A NEW BATCH. DTSBD140 01189 ***** DTSBD140 01190 *& DTSBD140 01191 * DISPLAY 'DTSBD140 P5000 T025 FIRST TIME ' DTSBD140 01192 * FIRST-TIME-T027-IND ' T027 ' FIRST-TIME-T025-IND DTSBD140 01193 * ' ' AHDR-BATCH-NO. DTSBD140 01194 *& DTSBD140 01195 ** IF FIRST-TIME-T027-NO-88 DTSBD140 01196 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01197 * PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01198 * SET FIRST-TIME-T027-YES-88 TO TRUE. DTSBD140 01199 * DTSBD140 01200 * IF FIRST-TIME-T025-NO-88 DTSBD140 01201 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01202 * PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01203 ** SET FIRST-TIME-T025-YES-88 TO TRUE. DTSBD140 01204 DTSBD140 01205 IF WRK-CURR-REC-TYPE NOT = '031' DTSBD140 01206 MOVE RSK5-REC-TYPE TO WRK-CURR-REC-TYPE DTSBD140 01207 IF AHDR-ATC-FILE-TRAN-CNT > 0 DTSBD140 01208 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01209 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01210 END-IF DTSBD140 01211 END-IF. DTSBD140 01212 DTSBD140 01213 IF AHDR-ATC-FILE-TRAN-CNT NOT < +475 CL**4 01214 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01215 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSBD140 01216 DTSBD140 01217 IF T031-EMP-NO = HOLD-EMP-NO DTSBD140 01218 NEXT SENTENCE DTSBD140 01219 ELSE DTSBD140 01220 MOVE T031-EMP-NO TO HOLD-EMP-NO DTSBD140 01221 MOVE 'N' TO HOLD-CREDIT-MSG-WRITTEN-IND DTSBD140 01222 MOVE +0 TO HOLD-YRQ-CNT. DTSBD140 01223 DTSBD140 01224 DTSBD140 01225 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD140 01226 DTSBD140 01227 MOVE T031-EMP-NO TO MSKL-EMP-NO. DTSBD140 01228 DTSBD140 01229 SET MSKL-PRF-88 TO TRUE. DTSBD140 01230 DTSBD140 01231 PERFORM S910-READ THRU S910-EXIT. DTSBD140 01232 DTSBD140 01233 IF L910-OK-88 DTSBD140 01234 MOVE MSKL-REC TO MPRF-REC DTSBD140 01235 IF NOT MPRF-CLASS-SUB-88 DTSBD140 01236 MOVE HIGH-VALUES TO TRANSFER-FROM-NAME-CHECK DTSBD140 01237 ELSE DTSBD140 01238 MOVE MPRF-EMP-CLASS TO TRANSFER-FROM-EMP-CLASS DTSBD140 01239 MOVE MPRF-TOT-CREDIT-AMT DTSBD140 01240 TO TRANSFER-FROM-TOT-CREDIT-AMT DTSBD140 01241 MOVE MPRF-PRIMARY-NAME TO TRANSFER-FROM-NAME-CHECK DTSBD140 01242 ELSE DTSBD140 01243 MOVE HIGH-VALUES TO TRANSFER-FROM-NAME-CHECK. DTSBD140 01244 DTSBD140 01245 DTSBD140 01246 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD140 01247 DTSBD140 01248 MOVE T031-TRANSFER-TO-EMP-NO TO MSKL-EMP-NO. DTSBD140 01249 DTSBD140 01250 SET MSKL-PRF-88 TO TRUE. DTSBD140 01251 DTSBD140 01252 PERFORM S910-READ THRU S910-EXIT. DTSBD140 01253 DTSBD140 01254 IF L910-OK-88 DTSBD140 01255 MOVE MSKL-REC TO MPRF-REC DTSBD140 01256 IF NOT MPRF-CLASS-SUB-88 DTSBD140 01257 MOVE HIGH-VALUES TO TRANSFER-TO-NAME-CHECK DTSBD140 01258 ELSE DTSBD140 01259 MOVE MPRF-PRIMARY-NAME TO TRANSFER-TO-NAME-CHECK DTSBD140 01260 ELSE DTSBD140 01261 MOVE HIGH-VALUES TO TRANSFER-TO-NAME-CHECK. DTSBD140 01262 DTSBD140 01263 DTSBD140 01264 IF (TRANSFER-FROM-NAME-CHECK = HIGH-VALUES) DTSBD140 01265 OR DTSBD140 01266 (TRANSFER-TO-NAME-CHECK = HIGH-VALUES) DTSBD140 01267 GO TO P5000-EXIT. DTSBD140 01268 DTSBD140 01269 DTSBD140 01270 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD140 01271 DTSBD140 01272 MOVE T031-EMP-NO TO MQTR-EMP-NO. DTSBD140 01273 DTSBD140 01274 SET MQTR-QTR-88 TO TRUE. DTSBD140 01275 DTSBD140 01276 MOVE T031-START-YRQ TO MQTR-YRQ. DTSBD140 01277 DTSBD140 01278 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 01279 DTSBD140 01280 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD140 01281 DTSBD140 01282 IF L910-OK-88 DTSBD140 01283 MOVE MSKL-REC TO MQTR-REC. DTSBD140 01284 DTSBD140 01285 PERFORM DTSBD140 01286 UNTIL (L910-NO-REC-88) DTSBD140 01287 OR DTSBD140 01288 (MQTR-YRQ > T031-END-YRQ) DTSBD140 01289 MOVE MQTR-YRQ TO TRANSFER-YRQ DTSBD140 01290 PERFORM P5100-PROCESS-MQTR THRU P5100-EXIT DTSBD140 01291 MOVE LOW-VALUES TO MQTR-KEY-AREA DTSBD140 01292 MOVE T031-EMP-NO TO MQTR-EMP-NO DTSBD140 01293 SET MQTR-QTR-88 TO TRUE DTSBD140 01294 MOVE TRANSFER-YRQ TO MQTR-YRQ DTSBD140 01295 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBD140 01296 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD140 01297 IF L910-OK-88 DTSBD140 01298 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD140 01299 IF L910-OK-88 DTSBD140 01300 MOVE MSKL-REC TO MQTR-REC DTSBD140 01301 END-IF DTSBD140 01302 END-IF DTSBD140 01303 END-PERFORM. DTSBD140 01304 P5000-EXIT. DTSBD140 01305 EXIT. DTSBD140 01306 DTSBD140 01307 DTSBD140 01308 DTSBD140 01309 P5100-PROCESS-MQTR. DTSBD140 01310 MOVE +0 TO HOLD-YRQ-SUB. DTSBD140 01311 DTSBD140 01312 PERFORM DTSBD140 01313 VARYING HOLD-YRQ-IDX FROM 1 BY 1 DTSBD140 01314 UNTIL (HOLD-YRQ-IDX > HOLD-YRQ-CNT) DTSBD140 01315 OR DTSBD140 01316 (HOLD-YRQ-SUB NOT = +0) DTSBD140 01317 IF HOLD-TRANSFERRED-YRQ (HOLD-YRQ-IDX) = TRANSFER-YRQ DTSBD140 01318 SET HOLD-YRQ-SUB TO HOLD-YRQ-IDX DTSBD140 01319 END-IF DTSBD140 01320 END-PERFORM. DTSBD140 01321 DTSBD140 01322 IF HOLD-YRQ-SUB > +0 DTSBD140 01323 GO TO P5100-EXIT. DTSBD140 01324 DTSBD140 01325 IF MQTR-CURR-RCVD-88 DTSBD140 01326 NEXT SENTENCE DTSBD140 01327 ELSE DTSBD140 01328 GO TO P5100-EXIT. DTSBD140 01329 DTSBD140 01330 DTSBD140 01331 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD140 01332 DTSBD140 01333 MOVE T031-EMP-NO TO MSKL-EMP-NO. DTSBD140 01334 DTSBD140 01335 SET MSKL-PRF-88 TO TRUE. DTSBD140 01336 DTSBD140 01337 PERFORM S910-READ THRU S910-EXIT. DTSBD140 01338 DTSBD140 01339 IF L910-NO-REC-88 DTSBD140 01340 GO TO P5100-EXIT. DTSBD140 01341 DTSBD140 01342 MOVE MSKL-REC TO MPRF-REC. DTSBD140 01343 DTSBD140 01344 DTSBD140 01345 MOVE TRANSFER-YRQ TO L516-YRQ. DTSBD140 01346 DTSBD140 01347 PERFORM S516-DETERMINE-LIABILITY THRU S516-EXIT. DTSBD140 01348 DTSBD140 01349 IF L516-LIABLE-88 DTSBD140 01350 GO TO P5100-EXIT. DTSBD140 01351 DTSBD140 01352 DTSBD140 01353 MOVE MQTR-TOT-WAGE TO TRANSFER-TOT-WAGE. DTSBD140 01354 DTSBD140 01355 MOVE MQTR-EXCESS-WAGE TO TRANSFER-EXCESS-WAGE. DTSBD140 01356 DTSBD140 01357 MOVE MQTR-TAX-WAGE TO TRANSFER-TAX-WAGE. DTSBD140 01358 DTSBD140 01359 DTSBD140 01360 MOVE MQTR-1ST-MTH-EMPL-CNT TO TRANSFER-1ST-MTH-EMPL-CNT. DTSBD140 01361 DTSBD140 01362 MOVE MQTR-2ND-MTH-EMPL-CNT TO TRANSFER-2ND-MTH-EMPL-CNT. DTSBD140 01363 DTSBD140 01364 MOVE MQTR-3RD-MTH-EMPL-CNT TO TRANSFER-3RD-MTH-EMPL-CNT. DTSBD140 01365 DTSBD140 01366 MOVE +0 TO TRANSFER-LATE-PEN-CHARGED DTSBD140 01367 TRANSFER-LATE-PEN-WAIVED. DTSBD140 01368 DTSBD140 01369 PERFORM DTSBD140 01370 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD140 01371 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD140 01372 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBD140 01373 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD140 01374 TO TRANSFER-LATE-PEN-CHARGED DTSBD140 01375 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD140 01376 TO TRANSFER-LATE-PEN-WAIVED DTSBD140 01377 END-IF DTSBD140 01378 END-PERFORM. DTSBD140 01379 DTSBD140 01380 DTSBD140 01381 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD140 01382 DTSBD140 01383 MOVE T031-TRANSFER-TO-EMP-NO TO MSKL-EMP-NO. DTSBD140 01384 DTSBD140 01385 SET MSKL-PRF-88 TO TRUE. DTSBD140 01386 DTSBD140 01387 PERFORM S910-READ THRU S910-EXIT. DTSBD140 01388 DTSBD140 01389 IF L910-NO-REC-88 DTSBD140 01390 GO TO P5100-EXIT. DTSBD140 01391 DTSBD140 01392 MOVE MSKL-REC TO MPRF-REC. DTSBD140 01393 DTSBD140 01394 DTSBD140 01395 MOVE TRANSFER-YRQ TO L516-YRQ. DTSBD140 01396 DTSBD140 01397 PERFORM S516-DETERMINE-LIABILITY THRU S516-EXIT. DTSBD140 01398 DTSBD140 01399 IF L516-NOT-LIABLE-88 DTSBD140 01400 GO TO P5100-EXIT. DTSBD140 01401 DTSBD140 01402 DTSBD140 01403 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD140 01404 DTSBD140 01405 MOVE T031-TRANSFER-TO-EMP-NO TO MQTR-EMP-NO. DTSBD140 01406 DTSBD140 01407 SET MQTR-QTR-88 TO TRUE. DTSBD140 01408 DTSBD140 01409 MOVE TRANSFER-YRQ TO MQTR-YRQ. DTSBD140 01410 DTSBD140 01411 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 01412 DTSBD140 01413 PERFORM S910-READ THRU S910-EXIT. DTSBD140 01414 DTSBD140 01415 IF L910-OK-88 DTSBD140 01416 MOVE MSKL-REC TO MQTR-REC DTSBD140 01417 IF MQTR-CURR-RCVD-88 DTSBD140 01418 PERFORM P5101-MSG387 THRU P5101-EXIT DTSBD140 01419 GO TO P5100-EXIT. DTSBD140 01420 DTSBD140 01421 DTSBD140 01422 IF HOLD-CREDIT-MSG-WRITTEN-IND = 'N' DTSBD140 01423 IF TRANSFER-FROM-TOT-CREDIT-AMT > +0 DTSBD140 01424 PERFORM P5102-MSG388 THRU P5102-EXIT DTSBD140 01425 MOVE 'Y' TO HOLD-CREDIT-MSG-WRITTEN-IND. DTSBD140 01426 DTSBD140 01427 DTSBD140 01428 MOVE +0 TO RECENT-RECEIVED-DATE. DTSBD140 01429 DTSBD140 01430 DTSBD140 01431 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBD140 01432 DTSBD140 01433 MOVE T031-EMP-NO TO MRPT-EMP-NO. DTSBD140 01434 DTSBD140 01435 SET MRPT-RPT-88 TO TRUE. DTSBD140 01436 DTSBD140 01437 MOVE TRANSFER-YRQ TO MRPT-YRQ. DTSBD140 01438 DTSBD140 01439 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 01440 DTSBD140 01441 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD140 01442 DTSBD140 01443 PERFORM P5110-MRPT-SCAN THRU P5110-EXIT DTSBD140 01444 UNTIL L910-NO-REC-88. DTSBD140 01445 DTSBD140 01446 DTSBD140 01447 IF HOLD-YRQ-CNT < HOLD-YRQ-MAX DTSBD140 01448 ADD +1 TO HOLD-YRQ-CNT DTSBD140 01449 MOVE TRANSFER-YRQ DTSBD140 01450 TO HOLD-TRANSFERRED-YRQ (HOLD-YRQ-CNT). DTSBD140 01451 DTSBD140 01452 DTSBD140 01453 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD140 01454 DTSBD140 01455 MOVE T031-EMP-NO TO MDST-EMP-NO. DTSBD140 01456 DTSBD140 01457 SET MDST-DST-88 TO TRUE. DTSBD140 01458 DTSBD140 01459 MOVE TRANSFER-YRQ TO MDST-YRQ. DTSBD140 01460 DTSBD140 01461 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 01462 DTSBD140 01463 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD140 01464 DTSBD140 01465 IF L910-OK-88 DTSBD140 01466 MOVE MSKL-REC TO MDST-REC. DTSBD140 01467 DTSBD140 01468 PERFORM DTSBD140 01469 UNTIL (L910-NO-REC-88) DTSBD140 01470 OR DTSBD140 01471 (MDST-YRQ NOT = TRANSFER-YRQ) DTSBD140 01472 PERFORM P5150-GENERATE-PEN-INT-PR THRU P5150-EXIT DTSBD140 01473 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD140 01474 IF L910-OK-88 DTSBD140 01475 MOVE MSKL-REC TO MDST-REC DTSBD140 01476 END-IF DTSBD140 01477 END-PERFORM. DTSBD140 01478 DTSBD140 01479 DTSBD140 01480 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD140 01481 DTSBD140 01482 MOVE T031-EMP-NO TO MDST-EMP-NO. DTSBD140 01483 DTSBD140 01484 SET MDST-DST-88 TO TRUE. DTSBD140 01485 DTSBD140 01486 MOVE TRANSFER-YRQ TO MDST-YRQ. DTSBD140 01487 DTSBD140 01488 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 01489 DTSBD140 01490 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD140 01491 DTSBD140 01492 IF L910-OK-88 DTSBD140 01493 MOVE MSKL-REC TO MDST-REC. DTSBD140 01494 DTSBD140 01495 PERFORM DTSBD140 01496 UNTIL (L910-NO-REC-88) DTSBD140 01497 OR DTSBD140 01498 (MDST-YRQ NOT = TRANSFER-YRQ) DTSBD140 01499 PERFORM P5160-GENERATE-TAX-PR THRU P5160-EXIT DTSBD140 01500 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD140 01501 IF L910-OK-88 DTSBD140 01502 MOVE MSKL-REC TO MDST-REC DTSBD140 01503 END-IF DTSBD140 01504 END-PERFORM. DTSBD140 01505 DTSBD140 01506 DTSBD140 01507 PERFORM P5120-GENERATE-WITHDRAWAL THRU P5120-EXIT. DTSBD140 01508 DTSBD140 01509 DTSBD140 01510 PERFORM P5140-GENERATE-OR THRU P5140-EXIT. DTSBD140 01511 DTSBD140 01512 DTSBD140 01513 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD140 01514 DTSBD140 01515 MOVE T031-EMP-NO TO MDST-EMP-NO. DTSBD140 01516 DTSBD140 01517 SET MDST-DST-88 TO TRUE. DTSBD140 01518 DTSBD140 01519 MOVE TRANSFER-YRQ TO MDST-YRQ. DTSBD140 01520 DTSBD140 01521 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 01522 DTSBD140 01523 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD140 01524 DTSBD140 01525 IF L910-OK-88 DTSBD140 01526 MOVE MSKL-REC TO MDST-REC. DTSBD140 01527 DTSBD140 01528 PERFORM DTSBD140 01529 UNTIL (L910-NO-REC-88) DTSBD140 01530 OR DTSBD140 01531 (MDST-YRQ NOT = TRANSFER-YRQ) DTSBD140 01532 PERFORM P5170-GENERATE-PA THRU P5170-EXIT DTSBD140 01533 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD140 01534 IF L910-OK-88 DTSBD140 01535 MOVE MSKL-REC TO MDST-REC DTSBD140 01536 END-IF DTSBD140 01537 END-PERFORM. DTSBD140 01538 DTSBD140 01539 DTSBD140 01540 IF (TRANSFER-LATE-PEN-CHARGED > +0) DTSBD140 01541 AND DTSBD140 01542 (NOT TRANSFER-FROM-EMP-SELF-INS-88) DTSBD140 01543 PERFORM P5180-TRANSFER-LATE-PEN THRU P5180-EXIT. DTSBD140 01544 P5100-EXIT. DTSBD140 01545 EXIT. DTSBD140 01546 SKIP3 DTSBD140 01547 P5101-MSG387. DTSBD140 01548 MOVE MSG387-ID TO R907-MSG-ID. DTSBD140 01549 DTSBD140 01550 MOVE T031-EMP-NO TO R907-EMP-NO. DTSBD140 01551 DTSBD140 01552 MOVE T031-EMP-NO TO MSG387-SOURCE-EMP-NO. DTSBD140 01553 DTSBD140 01554 MOVE T031-TRANSFER-TO-EMP-NO TO MSG387-TARGET-EMP-NO. DTSBD140 01555 DTSBD140 01556 MOVE TRANSFER-YRQ TO L004-QTR-5-9. DTSBD140 01557 DTSBD140 01558 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD140 01559 DTSBD140 01560 MOVE L004-SLASH-QTR TO MSG387-SLASH-QTR. DTSBD140 01561 DTSBD140 01562 MOVE MSG387-TEXT TO R907-MSG-TEXT. DTSBD140 01563 DTSBD140 01564 MOVE WRK-MOD-NAME TO R907-MODULE-NAME. DTSBD140 01565 DTSBD140 01566 PERFORM S947-R907-WRITE THRU S947-EXIT. DTSBD140 01567 P5101-EXIT. DTSBD140 01568 EXIT. DTSBD140 01569 SKIP3 DTSBD140 01570 P5102-MSG388. DTSBD140 01571 MOVE MSG388-ID TO R907-MSG-ID. DTSBD140 01572 DTSBD140 01573 MOVE T031-EMP-NO TO R907-EMP-NO. DTSBD140 01574 DTSBD140 01575 MOVE MSG388-TEXT TO R907-MSG-TEXT. DTSBD140 01576 DTSBD140 01577 MOVE WRK-MOD-NAME TO R907-MODULE-NAME. DTSBD140 01578 DTSBD140 01579 PERFORM S947-R907-WRITE THRU S947-EXIT. DTSBD140 01580 P5102-EXIT. DTSBD140 01581 EXIT. DTSBD140 01582 SKIP3 DTSBD140 01583 P5110-MRPT-SCAN. DTSBD140 01584 MOVE MSKL-REC TO MRPT-REC. DTSBD140 01585 DTSBD140 01586 IF MRPT-YRQ = TRANSFER-YRQ DTSBD140 01587 NEXT SENTENCE DTSBD140 01588 ELSE DTSBD140 01589 SET L910-NO-REC-88 TO TRUE DTSBD140 01590 GO TO P5110-EXIT. DTSBD140 01591 DTSBD140 01592 IF MRPT-ORIG-88 DTSBD140 01593 IF MRPT-RECEIVED-DATE > RECENT-RECEIVED-DATE DTSBD140 01594 MOVE MRPT-RECEIVED-DATE TO RECENT-RECEIVED-DATE. DTSBD140 01595 DTSBD140 01596 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD140 01597 P5110-EXIT. DTSBD140 01598 EXIT. DTSBD140 01599 SKIP3 DTSBD140 01600 P5120-GENERATE-WITHDRAWAL. DTSBD140 01601 PERFORM P5191-INITIALIZE-ARPT THRU P5191-EXIT. DTSBD140 01602 DTSBD140 01603 MOVE TRANSFER-FROM-NAME-CHECK TO ARPT-NAME-CHECK. DTSBD140 01604 DTSBD140 01605 MOVE T031-EMP-NO TO ARPT-EMP-NO. DTSBD140 01606 DTSBD140 01607 SET ARPT-WITHDRW-88 TO TRUE. DTSBD140 01608 DTSBD140 01609 IF TRANSFER-TOT-WAGE = +0 DTSBD140 01610 MOVE +0 TO ARPT-TOT-WAGE DTSBD140 01611 ELSE DTSBD140 01612 COMPUTE ARPT-TOT-WAGE = TRANSFER-TOT-WAGE * -1. DTSBD140 01613 DTSBD140 01614 IF TRANSFER-EXCESS-WAGE = +0 DTSBD140 01615 MOVE +0 TO ARPT-EXCESS-WAGE DTSBD140 01616 ELSE DTSBD140 01617 COMPUTE ARPT-EXCESS-WAGE = TRANSFER-EXCESS-WAGE * -1. DTSBD140 01618 DTSBD140 01619 IF TRANSFER-TAX-WAGE = +0 DTSBD140 01620 MOVE +0 TO ARPT-TAX-WAGE DTSBD140 01621 ELSE DTSBD140 01622 COMPUTE ARPT-TAX-WAGE = TRANSFER-TAX-WAGE * -1. DTSBD140 01623 DTSBD140 01624 PERFORM P4100-WRITE-ARPT THRU P4100-EXIT. DTSBD140 01625 P5120-EXIT. DTSBD140 01626 EXIT. DTSBD140 01627 SKIP3 DTSBD140 01628 *P5130-GENERATE-AC. DTSBD140 01629 *****PERFORM P5191-INITIALIZE-ARPT THRU P5191-EXIT. DTSBD140 01630 ***** DTSBD140 01631 *****MOVE TRANSFER-TO-NAME-CHECK TO ARPT-NAME-CHECK. DTSBD140 01632 ***** DTSBD140 01633 *****MOVE T031-TRANSFER-TO-EMP-NO TO ARPT-EMP-NO. DTSBD140 01634 ***** DTSBD140 01635 *****SET ARPT-ADMIN-CORR-88 TO TRUE. DTSBD140 01636 ***** DTSBD140 01637 *****COMPUTE ARPT-TOT-WAGE DTSBD140 01638 ***** = TRANSFER-TOT-WAGE + MQTR-TOT-WAGE. DTSBD140 01639 ***** DTSBD140 01640 *****COMPUTE ARPT-EXCESS-WAGE DTSBD140 01641 ***** = TRANSFER-EXCESS-WAGE + MQTR-EXCESS-WAGE. DTSBD140 01642 ***** DTSBD140 01643 *****COMPUTE ARPT-TAX-WAGE DTSBD140 01644 ***** = TRANSFER-TAX-WAGE + MQTR-TAX-WAGE. DTSBD140 01645 ***** DTSBD140 01646 *****MOVE L516-UI-RATE TO ARPT-UI-RATE. DTSBD140 01647 ***** DTSBD140 01648 *****PERFORM P4100-WRITE-ARPT THRU P4100-EXIT. DTSBD140 01649 *P5130-EXIT. DTSBD140 01650 *****EXIT. DTSBD140 01651 SKIP3 DTSBD140 01652 P5140-GENERATE-OR. DTSBD140 01653 PERFORM P5191-INITIALIZE-ARPT THRU P5191-EXIT. DTSBD140 01654 DTSBD140 01655 MOVE TRANSFER-TO-NAME-CHECK TO ARPT-NAME-CHECK. DTSBD140 01656 DTSBD140 01657 MOVE T031-TRANSFER-TO-EMP-NO TO ARPT-EMP-NO. DTSBD140 01658 DTSBD140 01659 SET ARPT-ORIG-88 TO TRUE. DTSBD140 01660 DTSBD140 01661 MOVE TRANSFER-TOT-WAGE TO ARPT-TOT-WAGE. DTSBD140 01662 DTSBD140 01663 MOVE TRANSFER-EXCESS-WAGE TO ARPT-EXCESS-WAGE. DTSBD140 01664 DTSBD140 01665 MOVE TRANSFER-TAX-WAGE TO ARPT-TAX-WAGE. DTSBD140 01666 DTSBD140 01667 IF TRANSFER-WAGE-RPT-YES-88 DTSBD140 01668 MOVE TRANSFER-WAGE-RPT-IND TO ARPT-WAGE-RPT-IND. DTSBD140 01669 DTSBD140 01670 MOVE TRANSFER-1ST-MTH-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSBD140 01671 DTSBD140 01672 MOVE TRANSFER-2ND-MTH-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSBD140 01673 DTSBD140 01674 MOVE TRANSFER-3RD-MTH-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSBD140 01675 DTSBD140 01676 MOVE RECENT-RECEIVED-DATE TO ARPT-RECEIVED-DATE. DTSBD140 01677 DTSBD140 01678 PERFORM P4100-WRITE-ARPT THRU P4100-EXIT. DTSBD140 01679 P5140-EXIT. DTSBD140 01680 EXIT. DTSBD140 01681 SKIP3 DTSBD140 01682 P5150-GENERATE-PEN-INT-PR. DTSBD140 01683 PERFORM P5192-INITIALIZE-APAY THRU P5192-EXIT. DTSBD140 01684 DTSBD140 01685 MOVE TRANSFER-FROM-NAME-CHECK TO APAY-NAME-CHECK. DTSBD140 01686 DTSBD140 01687 MOVE T031-EMP-NO TO APAY-EMP-NO. DTSBD140 01688 DTSBD140 01689 SET APAY-PAY-REV-88 TO TRUE. DTSBD140 01690 DTSBD140 01691 MOVE MDST-DOC-NO TO APAY-APPLIC-DOC-NO. DTSBD140 01692 DTSBD140 01693 PERFORM P5151-MDST-ACCT-LOOP THRU P5151-EXIT DTSBD140 01694 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD140 01695 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD140 01696 P5150-EXIT. DTSBD140 01697 EXIT. DTSBD140 01698 SKIP3 DTSBD140 01699 P5151-MDST-ACCT-LOOP. DTSBD140 01700 IF MDST-ACCT-LATE-PEN-88 (MDST-ACCT-IDX) DTSBD140 01701 OR DTSBD140 01702 MDST-ACCT-INT-88 (MDST-ACCT-IDX) DTSBD140 01703 NEXT SENTENCE DTSBD140 01704 ELSE DTSBD140 01705 GO TO P5151-EXIT. DTSBD140 01706 DTSBD140 01707 COMPUTE APAY-REMIT-AMT = MDST-AMT (MDST-ACCT-IDX) * -1. DTSBD140 01708 DTSBD140 01709 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO APAY-APPLIC-IND. DTSBD140 01710 DTSBD140 01711 PERFORM P4200-WRITE-APAY THRU P4200-EXIT. DTSBD140 01712 P5151-EXIT. DTSBD140 01713 EXIT. DTSBD140 01714 SKIP3 DTSBD140 01715 P5160-GENERATE-TAX-PR. DTSBD140 01716 PERFORM P5192-INITIALIZE-APAY THRU P5192-EXIT. DTSBD140 01717 DTSBD140 01718 MOVE TRANSFER-FROM-NAME-CHECK TO APAY-NAME-CHECK. DTSBD140 01719 DTSBD140 01720 MOVE T031-EMP-NO TO APAY-EMP-NO. DTSBD140 01721 DTSBD140 01722 SET APAY-PAY-REV-88 TO TRUE. DTSBD140 01723 DTSBD140 01724 MOVE MDST-DOC-NO TO APAY-APPLIC-DOC-NO. DTSBD140 01725 DTSBD140 01726 PERFORM P5161-MDST-ACCT-LOOP THRU P5161-EXIT DTSBD140 01727 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD140 01728 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD140 01729 P5160-EXIT. DTSBD140 01730 EXIT. DTSBD140 01731 SKIP3 DTSBD140 01732 P5161-MDST-ACCT-LOOP. DTSBD140 01733 IF MDST-ACCT-TAX-88 (MDST-ACCT-IDX) DTSBD140 01734 NEXT SENTENCE DTSBD140 01735 ELSE DTSBD140 01736 GO TO P5161-EXIT. DTSBD140 01737 DTSBD140 01738 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBD140 01739 IF TRANSFER-FROM-EMP-SELF-INS-88 DTSBD140 01740 GO TO P5161-EXIT. DTSBD140 01741 DTSBD140 01742 COMPUTE APAY-REMIT-AMT = MDST-AMT (MDST-ACCT-IDX) * -1. DTSBD140 01743 DTSBD140 01744 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO APAY-APPLIC-IND. DTSBD140 01745 DTSBD140 01746 PERFORM P4200-WRITE-APAY THRU P4200-EXIT. DTSBD140 01747 P5161-EXIT. DTSBD140 01748 EXIT. DTSBD140 01749 SKIP3 DTSBD140 01750 P5170-GENERATE-PA. DTSBD140 01751 PERFORM P5192-INITIALIZE-APAY THRU P5192-EXIT. DTSBD140 01752 DTSBD140 01753 PERFORM P5171-MDST-ACCT-LOOP THRU P5171-EXIT DTSBD140 01754 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD140 01755 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD140 01756 DTSBD140 01757 IF APAY-REMIT-AMT = +0 DTSBD140 01758 GO TO P5170-EXIT. DTSBD140 01759 DTSBD140 01760 MOVE TRANSFER-TO-NAME-CHECK TO APAY-NAME-CHECK. DTSBD140 01761 DTSBD140 01762 MOVE T031-TRANSFER-TO-EMP-NO TO APAY-EMP-NO. DTSBD140 01763 DTSBD140 01764 SET APAY-PAYMENT-88 TO TRUE. DTSBD140 01765 DTSBD140 01766 MOVE MDST-RECEIVED-DATE TO APAY-RECEIVED-DATE. DTSBD140 01767 DTSBD140 01768 PERFORM P4200-WRITE-APAY THRU P4200-EXIT. DTSBD140 01769 P5170-EXIT. DTSBD140 01770 EXIT. DTSBD140 01771 SKIP3 DTSBD140 01772 P5171-MDST-ACCT-LOOP. DTSBD140 01773 IF MDST-ACCT-LATE-PEN-88 (MDST-ACCT-IDX) DTSBD140 01774 OR DTSBD140 01775 MDST-ACCT-INT-88 (MDST-ACCT-IDX) DTSBD140 01776 OR DTSBD140 01777 MDST-ACCT-TAX-88 (MDST-ACCT-IDX) DTSBD140 01778 NEXT SENTENCE DTSBD140 01779 ELSE DTSBD140 01780 GO TO P5171-EXIT. DTSBD140 01781 DTSBD140 01782 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBD140 01783 IF TRANSFER-FROM-EMP-SELF-INS-88 DTSBD140 01784 GO TO P5171-EXIT. DTSBD140 01785 DTSBD140 01786 ADD MDST-AMT (MDST-ACCT-IDX) TO APAY-REMIT-AMT. DTSBD140 01787 P5171-EXIT. DTSBD140 01788 EXIT. DTSBD140 01789 SKIP3 DTSBD140 01790 P5180-TRANSFER-LATE-PEN. DTSBD140 01791 PERFORM P5193-INITIALIZE-AADJ THRU P5193-EXIT. DTSBD140 01792 DTSBD140 01793 MOVE TRANSFER-TO-NAME-CHECK TO AADJ-NAME-CHECK. DTSBD140 01794 DTSBD140 01795 MOVE T031-TRANSFER-TO-EMP-NO TO AADJ-EMP-NO. DTSBD140 01796 DTSBD140 01797 SET AADJ-CHARGE-88 TO TRUE. DTSBD140 01798 DTSBD140 01799 MOVE TRANSFER-LATE-PEN-CHARGED TO AADJ-AMT. DTSBD140 01800 DTSBD140 01801 MOVE TRANSFER-YRQ TO AADJ-APPLIC-YRQ. DTSBD140 01802 DTSBD140 01803 SET AADJ-LATE-PEN-88 TO TRUE. DTSBD140 01804 DTSBD140 01805 PERFORM P4300-WRITE-AADJ THRU P4300-EXIT. DTSBD140 01806 DTSBD140 01807 DTSBD140 01808 IF TRANSFER-LATE-PEN-WAIVED > +0 DTSBD140 01809 SET AADJ-WAIVE-88 TO TRUE DTSBD140 01810 MOVE TRANSFER-LATE-PEN-WAIVED TO AADJ-AMT DTSBD140 01811 PERFORM P4300-WRITE-AADJ THRU P4300-EXIT. DTSBD140 01812 P5180-EXIT. DTSBD140 01813 EXIT. DTSBD140 01814 SKIP3 DTSBD140 01815 P5191-INITIALIZE-ARPT. DTSBD140 01816 MOVE LOW-VALUES TO ARPT-REC. DTSBD140 01817 DTSBD140 01818 DTSBD140 01819 MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO. DTSBD140 01820 DTSBD140 01821 MOVE +0 TO ARPT-ITEM-NO. CL**7 01822 DTSBD140 01823 SET ARPT-RPT-88 TO TRUE. DTSBD140 01824 DTSBD140 01825 MOVE SPACE TO ARPT-NAME-CHECK. DTSBD140 01826 DTSBD140 01827 MOVE +0 TO ARPT-EMP-NO. DTSBD140 01828 DTSBD140 01829 MOVE SPACE TO ARPT-RPT-TYPE. DTSBD140 01830 DTSBD140 01831 MOVE TRANSFER-YRQ TO ARPT-YRQ. DTSBD140 01832 DTSBD140 01833 MOVE +0 TO ARPT-TOT-WAGE DTSBD140 01834 ARPT-EXCESS-WAGE DTSBD140 01835 ARPT-TAX-WAGE DTSBD140 01836 ARPT-REMIT-AMT. DTSBD140 01837 DTSBD140 01838 SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE. DTSBD140 01839 DTSBD140 01840 SET ARPT-WAIVE-BOTH-NO-88 TO TRUE. DTSBD140 01841 DTSBD140 01842 SET ARPT-WAIVE-INT-NO-88 TO TRUE. DTSBD140 01843 DTSBD140 01844 SET ARPT-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBD140 01845 DTSBD140 01846 SET ARPT-TOTAL-NO-ENTRY-88 TO TRUE. DTSBD140 01847 DTSBD140 01848 SET ARPT-1ST-MTH-NO-ENTRY-88 TO TRUE. DTSBD140 01849 DTSBD140 01850 SET ARPT-2ND-MTH-NO-ENTRY-88 TO TRUE. DTSBD140 01851 DTSBD140 01852 SET ARPT-3RD-MTH-NO-ENTRY-88 TO TRUE. DTSBD140 01853 DTSBD140 01854 SET ARPT-VERIFIED-NO-88 TO TRUE. DTSBD140 01855 DTSBD140 01856 MOVE +0 TO ARPT-RECEIVED-DATE DTSBD140 01857 ARPT-DEPOSIT-DATE DTSBD140 01858 ARPT-TRACE-NO. DTSBD140 01859 DTSBD140 01860 MOVE 'N' TO ARPT-DISREGARD-EDITS-IND. DTSBD140 01861 DTSBD140 01862 SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE. DTSBD140 01863 DTSBD140 01864 MOVE TRANSFER-RESPONSIBLE-ACTIVITY DTSBD140 01865 TO ARPT-RESPONSIBLE-ACTIVITY. DTSBD140 01866 DTSBD140 01867 MOVE TRANSFER-RESPONSIBLE-OP-ID TO ARPT-RESPONSIBLE-OP-ID. DTSBD140 01868 DTSBD140 01869 SET ARPT-STATUS-CHNG-NO-88 TO TRUE. DTSBD140 01870 DTSBD140 01871 SET ARPT-NOT-PROCESSED-88 TO TRUE. DTSBD140 01872 P5191-EXIT. DTSBD140 01873 EXIT. DTSBD140 01874 SKIP3 DTSBD140 01875 P5192-INITIALIZE-APAY. DTSBD140 01876 MOVE LOW-VALUES TO APAY-REC. DTSBD140 01877 DTSBD140 01878 DTSBD140 01879 MOVE AHDR-BATCH-NO TO APAY-BATCH-NO. DTSBD140 01880 DTSBD140 01881 MOVE +0 TO APAY-ITEM-NO CL**7 01882 MOVE +0 TO APAY-NSF-MNTE-ABSTIME. CL**4 01883 DTSBD140 01884 SET APAY-PAY-88 TO TRUE. DTSBD140 01885 DTSBD140 01886 MOVE SPACE TO APAY-NAME-CHECK. DTSBD140 01887 DTSBD140 01888 MOVE +0 TO APAY-EMP-NO. DTSBD140 01889 DTSBD140 01890 MOVE SPACE TO APAY-PAY-TYPE. DTSBD140 01891 DTSBD140 01892 MOVE +0 TO APAY-REMIT-AMT. DTSBD140 01893 DTSBD140 01894 SET APAY-WAIVE-INT-NO-88 TO TRUE. DTSBD140 01895 DTSBD140 01896 SET APAY-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBD140 01897 DTSBD140 01898 SET APAY-NSF-PEN-CHARGE-NO-88 TO TRUE. DTSBD140 01899 DTSBD140 01900 MOVE +0 TO APAY-RECEIVED-DATE DTSBD140 01901 APAY-DEPOSIT-DATE DTSBD140 01902 APAY-TRACE-NO. DTSBD140 01903 DTSBD140 01904 MOVE TRANSFER-YRQ TO APAY-APPLIC-YRQ. DTSBD140 01905 DTSBD140 01906 MOVE SPACES TO APAY-APPLIC-IND. DTSBD140 01907 DTSBD140 01908 MOVE +0 TO APAY-APPLIC-BATCH-NO DTSBD140 01909 APAY-APPLIC-ITEM-NO. DTSBD140 01910 DTSBD140 01911 MOVE 'N' TO APAY-DISREGARD-EDITS-IND. DTSBD140 01912 DTSBD140 01913 MOVE TRANSFER-RESPONSIBLE-ACTIVITY DTSBD140 01914 TO APAY-RESPONSIBLE-ACTIVITY. DTSBD140 01915 DTSBD140 01916 MOVE TRANSFER-RESPONSIBLE-OP-ID TO APAY-RESPONSIBLE-OP-ID. DTSBD140 01917 DTSBD140 01918 SET APAY-NOT-PROCESSED-88 TO TRUE. DTSBD140 01919 P5192-EXIT. DTSBD140 01920 EXIT. DTSBD140 01921 SKIP3 DTSBD140 01922 P5193-INITIALIZE-AADJ. DTSBD140 01923 MOVE LOW-VALUES TO AADJ-REC. DTSBD140 01924 DTSBD140 01925 DTSBD140 01926 MOVE AHDR-BATCH-NO TO AADJ-BATCH-NO. DTSBD140 01927 DTSBD140 01928 MOVE +0 TO AADJ-ITEM-NO. CL**7 01929 DTSBD140 01930 SET AADJ-ADJ-88 TO TRUE. DTSBD140 01931 DTSBD140 01932 MOVE SPACE TO AADJ-NAME-CHECK. DTSBD140 01933 DTSBD140 01934 MOVE +0 TO AADJ-EMP-NO. DTSBD140 01935 DTSBD140 01936 MOVE SPACE TO AADJ-ADJ-TYPE. DTSBD140 01937 DTSBD140 01938 MOVE +0 TO AADJ-AMT. DTSBD140 01939 DTSBD140 01940 MOVE +0 TO AADJ-RECEIVED-DATE DTSBD140 01941 AADJ-DEPOSIT-DATE. DTSBD140 01942 DTSBD140 01943 MOVE +0 TO AADJ-APPLIC-YRQ. DTSBD140 01944 DTSBD140 01945 MOVE SPACES TO AADJ-APPLIC-IND. DTSBD140 01946 DTSBD140 01947 MOVE +0 TO AADJ-APPLIC-BATCH-NO DTSBD140 01948 AADJ-APPLIC-ITEM-NO. DTSBD140 01949 DTSBD140 01950 MOVE +0 TO AADJ-DATE-1 DTSBD140 01951 AADJ-DATE-2. DTSBD140 01952 DTSBD140 01953 MOVE SPACE TO AADJ-INT-SPAN-IND. DTSBD140 01954 DTSBD140 01955 MOVE +0 TO AADJ-INT-RATE. DTSBD140 01956 DTSBD140 01957 MOVE 'N' TO AADJ-DISREGARD-EDITS-IND. DTSBD140 01958 DTSBD140 01959 MOVE TRANSFER-RESPONSIBLE-ACTIVITY DTSBD140 01960 TO AADJ-RESPONSIBLE-ACTIVITY. DTSBD140 01961 DTSBD140 01962 MOVE TRANSFER-RESPONSIBLE-OP-ID TO AADJ-RESPONSIBLE-OP-ID. DTSBD140 01963 DTSBD140 01964 MOVE +0 TO AADJ-CMP-ESTB-ABSTIME. DTSBD140 01965 DTSBD140 01966 SET AADJ-NOT-PROCESSED-88 TO TRUE. DTSBD140 01967 P5193-EXIT. DTSBD140 01968 EXIT. DTSBD140 01969 EJECT DTSBD140 01970 P7000-GENERATE-PAY. DTSBD140 01971 ***** DTSBD140 01972 * IF T025 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN DTSBD140 01973 * BATCH INCLUDES T025 GENERATED APAY RECOPRDS, THE BATCH MAY DTSBD140 01974 * INCLUDE ONLY T025 GENERATED APAY RECORDS) TERMINATE THE OPEN DTSBD140 01975 * BATCH AND INITIATE A NEW BATCH. DTSBD140 01976 ***** DTSBD140 01977 *& DTSBD140 01978 * DISPLAY 'DTSBD140 P7000 ' RSK5-REC-TYPE. DTSBD140 01979 * FIRST-TIME-T027-IND ' T027 ' FIRST-TIME-T025-IND DTSBD140 01980 * ' ' AHDR-BATCH-NO. DTSBD140 01981 *& DTSBD140 01982 ** IF FIRST-TIME-T025-YES-88 DTSBD140 01983 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01984 * PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01985 ** SET FIRST-TIME-T025-NO-88 TO TRUE. DTSBD140 01986 DTSBD140 01987 IF WRK-CURR-REC-TYPE NOT = '025' DTSBD140 01988 MOVE RSK5-REC-TYPE TO WRK-CURR-REC-TYPE DTSBD140 01989 IF AHDR-ATC-FILE-TRAN-CNT > 0 DTSBD140 01990 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01991 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 01992 END-IF DTSBD140 01993 END-IF. DTSBD140 01994 DTSBD140 01995 IF AHDR-ATC-FILE-TRAN-CNT NOT < +475 CL**4 01996 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 01997 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSBD140 01998 DTSBD140 01999 IF RSK5-REC-TYPE = '025' DTSBD140 02000 MOVE RSKL-REC TO T025-REC DTSBD140 02001 PERFORM P7100-PAYMENT THRU P7100-EXIT DTSBD140 02002 ELSE DTSBD140 02003 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 02004 DTSBD140 02005 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT CL**9 02006 WRK-AHDR-ITEM-NO. CL*16 02007 CL**7 02008 ADD APAY-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT. DTSBD140 02009 DTSBD140 02010 MOVE WRK-AHDR-ITEM-NO TO APAY-ITEM-NO. CL*16 02011 DTSBD140 02012 MOVE APAY-REC TO ASKL-REC. DTSBD140 02013 DTSBD140 02014 *& DTSBD140 02015 DISPLAY 'DTSBD140 P7000 ' APAY-EMP-NO ' ' APAY-BATCH-NO DTSBD140 02016 ' ' APAY-ITEM-NO ' ' AHDR-ATC-FILE-REMIT-AMT. DTSBD140 02017 *& DTSBD140 02018 PERFORM S923-WRITE THRU S923-EXIT. DTSBD140 02019 DTSBD140 02020 ADD +1 TO WRK-ATC-TRAN-CNT. DTSBD140 02021 DTSBD140 02022 P7000-EXIT. DTSBD140 02023 EXIT. DTSBD140 02024 DTSBD140 02025 P7100-PAYMENT. DTSBD140 02026 *& DTSBD140 02027 * DISPLAY 'DTSBD140 P7100 ' T025-EMP-NO ' ' AHDR-BATCH-NO DTSBD140 02028 * ' ' T025-REMIT-AMT ' ' T025-PAY-TYPE. DTSBD140 02029 *& DTSBD140 02030 MOVE LOW-VALUES TO APAY-REC. DTSBD140 02031 DTSBD140 02032 MOVE AHDR-BATCH-NO TO APAY-BATCH-NO. DTSBD140 02033 DTSBD140 02034 MOVE +0 TO APAY-ITEM-NO. CL**7 02035 DTSBD140 02036 SET APAY-PAY-88 TO TRUE. DTSBD140 02037 DTSBD140 02038 MOVE T025-NAME-CHECK TO APAY-NAME-CHECK. DTSBD140 02039 DTSBD140 02040 MOVE T025-EMP-NO TO APAY-EMP-NO. DTSBD140 02041 DTSBD140 02042 EVALUATE TRUE DTSBD140 02043 WHEN T025-OR-PAY-88 DTSBD140 02044 SET APAY-OR-PAY-88 TO TRUE DTSBD140 02045 DTSBD140 02046 WHEN T025-PA-PAY-88 DTSBD140 02047 SET APAY-PAYMENT-88 TO TRUE DTSBD140 02048 DTSBD140 02049 WHEN T025-PAY-REV-88 DTSBD140 02050 SET APAY-PAY-REV-88 TO TRUE DTSBD140 02051 DTSBD140 02052 WHEN T025-NG-CHECK-88 DTSBD140 02053 SET APAY-NG-CHECK-88 TO TRUE DTSBD140 02054 DTSBD140 02055 WHEN T025-REFUND-88 DTSBD140 02056 SET APAY-REFUND-88 TO TRUE DTSBD140 02057 DTSBD140 02058 WHEN OTHER DTSBD140 02059 PERFORM S999-ABEND THRU S999-EXIT DTSBD140 02060 DTSBD140 02061 END-EVALUATE. DTSBD140 02062 DTSBD140 02063 IF T025-REMIT-AMT NUMERIC DTSBD140 02064 MOVE T025-REMIT-AMT TO APAY-REMIT-AMT DTSBD140 02065 ELSE DTSBD140 02066 MOVE +0 TO APAY-REMIT-AMT. DTSBD140 02067 DTSBD140 02068 SET APAY-WAIVE-INT-NO-88 TO TRUE. DTSBD140 02069 SET APAY-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBD140 02070 DTSBD140 02071 MOVE +0 TO APAY-NSF-MNTE-ABSTIME. DTSBD140 02072 IF APAY-NG-CHECK-88 AND T025-NSF-PEN-CHARGE-YES-88 DTSBD140 02073 SET APAY-NSF-PEN-CHARGE-YES-88 TO TRUE DTSBD140 02074 ELSE DTSBD140 02075 SET APAY-NSF-PEN-CHARGE-NO-88 TO TRUE. DTSBD140 02076 DTSBD140 02077 IF T025-RECEIVED-DATE NUMERIC DTSBD140 02078 MOVE T025-RECEIVED-DATE TO APAY-RECEIVED-DATE DTSBD140 02079 APAY-DEPOSIT-DATE DTSBD140 02080 ELSE DTSBD140 02081 MOVE +0 TO APAY-RECEIVED-DATE. DTSBD140 02082 DTSBD140 02083 MOVE T025-TRACE-NO TO APAY-TRACE-NO. DTSBD140 02084 DTSBD140 02085 IF T025-APPLIC-YRQ NUMERIC DTSBD140 02086 MOVE T025-APPLIC-YRQ TO APAY-APPLIC-YRQ DTSBD140 02087 ELSE DTSBD140 02088 MOVE +0 TO APAY-APPLIC-YRQ. DTSBD140 02089 DTSBD140 02090 MOVE T025-APPLIC-IND TO APAY-APPLIC-IND. DTSBD140 02091 DTSBD140 02092 IF (T025-APPLIC-BATCH-NO NUMERIC) DTSBD140 02093 AND DTSBD140 02094 (T025-APPLIC-ITEM-NO NUMERIC) DTSBD140 02095 MOVE T025-APPLIC-DOC-NO TO APAY-APPLIC-DOC-NO DTSBD140 02096 ELSE DTSBD140 02097 MOVE +0 TO APAY-APPLIC-BATCH-NO DTSBD140 02098 APAY-APPLIC-ITEM-NO. DTSBD140 02099 DTSBD140 02100 MOVE 'N' TO APAY-DISREGARD-EDITS-IND. DTSBD140 02101 DTSBD140 02102 SET APAY-ANNUAL-RPT-NULL-88 TO TRUE. DTSBD140 02103 DTSBD140 02104 MOVE T025-RESPONSIBLE-ACTIVITY DTSBD140 02105 TO APAY-RESPONSIBLE-ACTIVITY. DTSBD140 02106 DTSBD140 02107 MOVE T025-RESPONSIBLE-OP-ID TO APAY-RESPONSIBLE-OP-ID. DTSBD140 02108 DTSBD140 02109 SET APAY-NOT-PROCESSED-88 TO TRUE. DTSBD140 02110 P7100-EXIT. DTSBD140 02111 EXIT. DTSBD140 02112 EJECT DTSBD140 02113 P8000-GENERATE-RPT. DTSBD140 02114 *& DTSBD140 02115 * DISPLAY 'DTSBD140 P8000-1'. DTSBD140 02116 *& DTSBD140 02117 IF RSK5-REC-TYPE = '028' DTSBD140 02118 MOVE RSKL-REC TO T028-REC DTSBD140 02119 ELSE DTSBD140 02120 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 02121 DTSBD140 02122 *& DTSBD140 02123 DISPLAY 'DTSBD140 P8000-2 ' T028-EMP-NO ' ' T028-RPT-TYPE DTSBD140 02124 ' ' T028-TRN-TYPE ' ' T028-LOG-NBR. DTSBD140 02125 *& DTSBD140 02126 ***** DTSBD140 02127 * IF T027 RECORDS HAVE BEEN PROCESSED, THEN (BECAUSE IF A GIVEN DTSBD140 02128 * BATCH INCLUDES T027 GENERATED ARPT RECOPRDS, THE BATCH MAY DTSBD140 02129 * INCLUDE ONLY T027 GENERATED ARPT RECORDS) TERMINATE THE OPEN DTSBD140 02130 * BATCH AND INITIATE A NEW BATCH. DTSBD140 02131 ***** DTSBD140 02132 ** IF FIRST-TIME-T027-YES-88 DTSBD140 02133 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 02134 * PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 02135 ** SET FIRST-TIME-T027-NO-88 TO TRUE. DTSBD140 02136 DTSBD140 02137 ** DISPLAY 'REC TYPE: ' WRK-CURR-REC-TYPE. DTSBD140 02138 ** DISPLAY 'CURR: ' WRK-CURR-KEY ' NEW: ' RSK5-KEY-AREA. DTSBD140 02139 DTSBD140 02140 IF WRK-CURR-REC-TYPE = '028' DTSBD140 02141 AND WRK-CURR-KEY NOT = RSK5-KEY-AREA DTSBD140 02142 MOVE RSK5-KEY-AREA TO WRK-CURR-KEY DTSBD140 02143 IF AHDR-ATC-FILE-TRAN-CNT > 0 DTSBD140 02144 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 02145 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 02146 END-IF DTSBD140 02147 END-IF. DTSBD140 02148 DTSBD140 02149 IF WRK-CURR-REC-TYPE NOT = '028' DTSBD140 02150 MOVE RSK5-REC-TYPE TO WRK-CURR-REC-TYPE DTSBD140 02151 MOVE RSK5-KEY-AREA TO WRK-CURR-KEY DTSBD140 02152 IF AHDR-ATC-FILE-TRAN-CNT > 0 DTSBD140 02153 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 02154 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBD140 02155 END-IF DTSBD140 02156 END-IF. DTSBD140 02157 DTSBD140 02158 IF AHDR-ATC-FILE-TRAN-CNT NOT < +475 CL**4 02159 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBD140 02160 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSBD140 02161 DTSBD140 02162 PERFORM P8100-ATC-REPORT THRU P8100-EXIT. DTSBD140 02163 *& DTSBD140 02164 * DISPLAY 'DTSBD140 P8000 ' APAY-EMP-NO ' ' APAY-BATCH-NO DTSBD140 02165 * ' ' APAY-ITEM-NO ' ' AHDR-ATC-FILE-REMIT-AMT. DTSBD140 02166 *& DTSBD140 02167 DTSBD140 02168 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT CL**4 02169 WRK-AHDR-ITEM-NO. CL*16 02170 DTSBD140 02171 MOVE WRK-AHDR-ITEM-NO TO ARPT-ITEM-NO. CL*16 02172 ADD ARPT-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT. DTSBD140 02173 DTSBD140 02174 MOVE ARPT-REC TO ASKL-REC. DTSBD140 02175 DTSBD140 02176 PERFORM S923-WRITE THRU S923-EXIT. DTSBD140 02177 DTSBD140 02178 ADD +1 TO WRK-ATC-TRAN-CNT. DTSBD140 02179 DTSBD140 02180 PERFORM P8200-BATCH-AUDIT THRU P8200-EXIT. DTSBD140 02181 DTSBD140 02182 P8000-EXIT. DTSBD140 02183 EXIT. DTSBD140 02184 DTSBD140 02185 P8100-ATC-REPORT. DTSBD140 02186 *& DTSBD140 02187 * DISPLAY 'DTSBD140 P8100 ' T028-EMP-NO DTSBD140 02188 * ' ' T028-PSEUDO-BATCH-NO ' ' T028-PSEUDO-ITEM-NO DTSBD140 02189 * ' ' T028-RPT-TYPE ' ' T028-YRQ. DTSBD140 02190 * DISPLAY T028-TRACE-NO. DTSBD140 02191 *& DTSBD140 02192 MOVE LOW-VALUES TO ARPT-REC. DTSBD140 02193 DTSBD140 02194 MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO. DTSBD140 02195 DTSBD140 02196 MOVE +0 TO ARPT-ITEM-NO. CL**7 02197 DTSBD140 02198 SET ARPT-RPT-88 TO TRUE. DTSBD140 02199 DTSBD140 02200 MOVE T028-PSEUDO-DOC-NO TO ARPT-PSEUDO-DOC-NO. DTSBD140 02201 DTSBD140 02202 MOVE T028-NAME-CHECK TO ARPT-NAME-CHECK. DTSBD140 02203 DTSBD140 02204 MOVE T028-EMP-NO TO ARPT-EMP-NO. DTSBD140 02205 DTSBD140 02206 MOVE T028-RPT-TYPE TO ARPT-RPT-TYPE. DTSBD140 02207 DTSBD140 02208 MOVE T028-YRQ TO ARPT-YRQ. DTSBD140 02209 DTSBD140 02210 MOVE T028-TOT-WAGE TO ARPT-TOT-WAGE. DTSBD140 02211 DTSBD140 02212 MOVE T028-EXCESS-WAGE TO ARPT-EXCESS-WAGE. DTSBD140 02213 DTSBD140 02214 MOVE T028-TAX-WAGE TO ARPT-TAX-WAGE. DTSBD140 02215 DTSBD140 02216 MOVE T028-REMIT-AMT TO ARPT-REMIT-AMT. DTSBD140 02217 DTSBD140 02218 MOVE T028-WAIVE-BOTH-IND TO ARPT-WAIVE-BOTH-IND. DTSBD140 02219 DTSBD140 02220 MOVE T028-WAIVE-INT-IND TO ARPT-WAIVE-INT-IND. DTSBD140 02221 DTSBD140 02222 MOVE T028-WAIVE-LATE-PEN-IND TO ARPT-WAIVE-LATE-PEN-IND. DTSBD140 02223 DTSBD140 02224 MOVE T028-TOTAL-EMPL-CNT TO ARPT-TOTAL-EMPL-CNT. DTSBD140 02225 DTSBD140 02226 MOVE T028-1ST-MTH-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSBD140 02227 DTSBD140 02228 MOVE T028-2ND-MTH-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSBD140 02229 DTSBD140 02230 MOVE T028-3RD-MTH-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSBD140 02231 DTSBD140 02232 MOVE T028-RECEIVED-DATE TO ARPT-RECEIVED-DATE DTSBD140 02233 ARPT-DEPOSIT-DATE. DTSBD140 02234 DTSBD140 02235 SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE. DTSBD140 02236 MOVE T028-TRACE-NO TO ARPT-TRACE-NO. DTSBD140 02237 DTSBD140 02238 SET ARPT-STATUS-CHNG-NO-88 TO TRUE. DTSBD140 02239 DTSBD140 02240 DTSBD140 02241 MOVE T028-RESPONSIBLE-ACTIVITY DTSBD140 02242 TO ARPT-RESPONSIBLE-ACTIVITY. DTSBD140 02243 DTSBD140 02244 MOVE T028-RESPONSIBLE-OP-ID TO ARPT-RESPONSIBLE-OP-ID. DTSBD140 02245 DTSBD140 02246 *& DTSBD140 02247 * DISPLAY 'DTSBD140 P8100 PASSED EDITS ' DTSBD140 02248 * T028-PASSED-FULL-EDITS-IND DTSBD140 02249 * ' ' ARPT-BATCH-NO. DTSBD140 02250 *& DTSBD140 02251 MOVE T028-PASSED-FULL-EDITS-IND DTSBD140 02252 TO ARPT-PASSED-FULL-EDITS-IND. DTSBD140 02253 DTSBD140 02254 SET ARPT-NOT-PROCESSED-88 TO TRUE. DTSBD140 02255 P8100-EXIT. DTSBD140 02256 EXIT. DTSBD140 02257 DTSBD140 02258 P8200-BATCH-AUDIT. DTSBD140 02259 MOVE ARPT-BATCH-NO TO X214-BATCH. DTSBD140 02260 MOVE ARPT-ITEM-NO TO X214-ITEM. DTSBD140 02261 MOVE ARPT-PSEUDO-BATCH-NO TO X214-PSEUDO-BATCH. DTSBD140 02262 MOVE ARPT-PSEUDO-ITEM-NO TO X214-PSEUDO-ITEM. DTSBD140 02263 MOVE T028-LOG-NBR TO X214-LOG-NBR. DTSBD140 02264 ** MOVE T028-DEPOSIT-DATE TO L001-FED-8-DATE-9. DTSBD140 02265 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD140 02266 ** MOVE L001-SLASH-8-DATE TO X214-DEPOSIT-DT. DTSBD140 02267 DTSBD140 02268 WRITE BATCH-AUDIT-REC FROM WRK-BATCH-AUDIT-REC. DTSBD140 02269 IF BATCH-AUDIT-OK-88 DTSBD140 02270 ADD +1 TO WRK-BX214-CNT DTSBD140 02271 ELSE DTSBD140 02272 DISPLAY 'CANNOT WRITE BATCH-AUDIT FILE: ' DTSBD140 02273 BATCH-AUDIT-STATUS DTSBD140 02274 PERFORM S999-ABEND THRU S999-EXIT DTSBD140 02275 END-IF. DTSBD140 02276 DTSBD140 02277 *& DTSBD140 02278 * DISPLAY 'DTSBD140 P8200 ' ARPT-EMP-NO ' ' X214-BATCH DTSBD140 02279 * ' ' X214-ITEM ' ' X214-LOG-NBR ' ' WRK-BX214-CNT. DTSBD140 02280 *& DTSBD140 02281 P8200-EXIT. DTSBD140 02282 EXIT. DTSBD140 02283 EJECT DTSBD140 02284 P9000-ADD-PROFILE. DTSBD140 02285 ************************************************************** DTSBD140 02286 * WHEN PROCESSING T002 DETERMINATION RECORDS, CALL DTSBD142 DTSBD140 02287 * TO ADD MPRF AND MERA RECORDS. PASS THE TRANSACTION ON TO DTSBD140 02288 * DTSBD381 (THROUGH CALL TO P3000) ONLY IF THE DETERMINATION DTSBD140 02289 * IS COMPLETE (I.E., THE REGISTRATION IS NOT FROM A UC-30 AND DTSBD140 02290 * IS NOT FROM A FISCAL AGENT RATE TAPE). DTSBD140 02291 ************************************************************** DTSBD140 02292 MOVE RSKL-REC TO T002-REC. DTSBD140 02293 *& DTSBD140 02294 DISPLAY 'DTSBD140 P9000 ' T002-EMP-NO ' ' T002-TRN-CD. DTSBD140 02295 *& DTSBD140 02296 DTSBD140 02297 MOVE RSK5-REC-TYPE TO WRK-CURR-REC-TYPE. DTSBD140 02298 DTSBD140 02299 IF T002-DETERM-88 DTSBD140 02300 MOVE T002-DATA-AREA TO Y104-REC DTSBD140 02301 ADD +1 TO WRK-T002-CNT DTSBD140 02302 SET L142-PROCESS-88 TO TRUE DTSBD140 02303 PERFORM S142-NEW-EMP THRU S142-EXIT DTSBD140 02304 IF Y104-SOURCE-UC30-88 DTSBD140 02305 OR Y104-SOURCE-FISC-AGNT-88 DTSBD140 02306 NEXT SENTENCE DTSBD140 02307 ELSE DTSBD140 02308 PERFORM P3000-GENERATE-TRAN THRU P3000-EXIT DTSBD140 02309 END-IF DTSBD140 02310 ELSE DTSBD140 02311 PERFORM P3000-GENERATE-TRAN THRU P3000-EXIT DTSBD140 02312 END-IF. DTSBD140 02313 DTSBD140 02314 P9000-EXIT. DTSBD140 02315 EXIT. DTSBD140 02316 DTSBD140 02317 T0000-TERMINATE. DTSBD140 02318 *& DTSBD140 02319 * DISPLAY 'DTSBD140 T0000 T025 FIRST TIME ' DTSBD140 02320 * FIRST-TIME-T027-IND ' T027 ' FIRST-TIME-T025-IND DTSBD140 02321 * ' ' AHDR-BATCH-NO. DTSBD140 02322 *& DTSBD140 02323 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT. DTSBD140 02324 DTSBD140 02325 DTSBD140 02326 PERFORM T1000-UPDATE-MHDR-REC THRU T1000-EXIT. DTSBD140 02327 DTSBD140 02328 DISPLAY 'T0000 ' WRK-BX214-CNT. DTSBD140 02329 IF WRK-BX214-CNT = 0 DTSBD140 02330 MOVE ZEROS TO X214-BATCH DTSBD140 02331 X214-PSEUDO-BATCH DTSBD140 02332 X214-ITEM DTSBD140 02333 X214-PSEUDO-ITEM DTSBD140 02334 MOVE ZEROS TO X214-LOG-NBR DTSBD140 02335 *** MOVE SPACES TO X214-DEPOSIT-DT DTSBD140 02336 WRITE BATCH-AUDIT-REC FROM WRK-BATCH-AUDIT-REC DTSBD140 02337 DISPLAY 'DUMMY X214 WRITTEN ' WRK-BATCH-AUDIT-REC DTSBD140 02338 END-IF. DTSBD140 02339 DTSBD140 02340 DISPLAY ' '. DTSBD140 02341 DTSBD140 02342 DISPLAY '*** DTSBD140 TERMINATION STATISTICS ***'. DTSBD140 02343 DTSBD140 02344 DISPLAY 'NUMBER OF BTC RECORDS ENCOUNTERED : ' DTSBD140 02345 WRK-BTC-REC-CNT. DTSBD140 02346 DTSBD140 02347 DISPLAY 'NUMBER OF TRANSACTION RECORDS CREATED: ' DTSBD140 02348 WRK-BTC-TRAN-CNT. DTSBD140 02349 DTSBD140 02350 DISPLAY 'NUMBER OF ATC BATCHES CREATED : ' DTSBD140 02351 WRK-ATC-BATCH-CNT. DTSBD140 02352 DTSBD140 02353 DISPLAY 'NUMBER OF ATC TRANSACTIONS CREATED : ' DTSBD140 02354 WRK-ATC-TRAN-CNT. DTSBD140 02355 DTSBD140 02356 DISPLAY ' '. DTSBD140 02357 DTSBD140 02358 DISPLAY 'NUMBER OF R907 RECORDS CREATED : ' DTSBD140 02359 WRK-R907-REC-CNT. DTSBD140 02360 DTSBD140 02361 DISPLAY ' '. DTSBD140 02362 DTSBD140 02363 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD140 02364 DTSBD140 02365 PERFORM S923-CLOSE THRU S923-EXIT. DTSBD140 02366 DTSBD140 02367 PERFORM S926-CLOSE THRU S926-EXIT. DTSBD140 02368 DTSBD140 02369 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD140 02370 DTSBD140 02371 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD140 02372 CL*19 02373 DTSBD140 02374 MOVE -1 TO RSK5-LENGTH. DTSBD140 02375 DTSBD140 02376 PERFORM S946-TRN-REC-O THRU S946-EXIT. DTSBD140 02377 DTSBD140 02378 MOVE -1 TO R907-LENGTH. DTSBD140 02379 DTSBD140 02380 PERFORM S947-R907-WRITE THRU S947-EXIT. DTSBD140 02381 DTSBD140 02382 CLOSE BATCH-AUDIT-FILE. DTSBD140 02383 DTSBD140 02384 SET L142-TERMINATE-88 TO TRUE. DTSBD140 02385 PERFORM S142-NEW-EMP THRU S142-EXIT. DTSBD140 02386 PERFORM S985-CLOSE THRU S985-EXIT. CL*20 02387 DTSBD140 02388 T0000-EXIT. DTSBD140 02389 EXIT. DTSBD140 02390 EJECT DTSBD140 02391 T1000-UPDATE-MHDR-REC. DTSBD140 02392 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD140 02393 DTSBD140 02394 PERFORM S910-READ THRU S910-EXIT. DTSBD140 02395 DTSBD140 02396 IF L910-OK-88 DTSBD140 02397 MOVE MHDR-REC TO MSKL-REC DTSBD140 02398 PERFORM S910-REWRITE THRU S910-EXIT DTSBD140 02399 ELSE DTSBD140 02400 PERFORM S999-ABEND THRU S999-EXIT. DTSBD140 02401 T1000-EXIT. DTSBD140 02402 EXIT. DTSBD140 02403 EJECT DTSBD140 02404 S1000-INITIATE-AHDR. DTSBD140 02405 MOVE LOW-VALUES TO AHDR-REC. DTSBD140 02406 DTSBD140 02407 PERFORM S1100-DETERMINE-BATCH-NO THRU S1100-EXIT. DTSBD140 02408 DTSBD140 02409 DISPLAY 'NEW HEADER: ' AHDR-BATCH-NO. DTSBD140 02410 DTSBD140 02411 MOVE +0 TO AHDR-ITEM-NO. CL*23 02412 MOVE +500 TO WRK-AHDR-ITEM-NO. CL*23 02413 DTSBD140 02414 SET AHDR-HDR-88 TO TRUE. DTSBD140 02415 DTSBD140 02416 SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSBD140 02417 DTSBD140 02418 SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSBD140 02419 DTSBD140 02420 IF RSK5-REC-TYPE = '028' DTSBD140 02421 MOVE T028-RESPONSIBLE-OP-ID TO AHDR-ESTB-OP-ID DTSBD140 02422 ELSE DTSBD140 02423 SET AHDR-ESTB-SYSTEM-88 TO TRUE DTSBD140 02424 END-IF. DTSBD140 02425 DTSBD140 02426 MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE. DTSBD140 02427 DTSBD140 02428 MOVE SPACES TO AHDR-CHNG-OP-ID. DTSBD140 02429 DTSBD140 02430 MOVE +0 TO AHDR-CHNG-DATE. DTSBD140 02431 DTSBD140 02432 MOVE MHDR-CURR-MAIL-DATE TO AHDR-DEPOSIT-DATE. DTSBD140 02433 DTSBD140 02434 MOVE MHDR-CURR-RUN-DATE TO AHDR-RECEIVED-DATE. DTSBD140 02435 CL**3 02436 DTSBD140 02437 MOVE +0 TO AHDR-LAST-USED-ITEM-NO DTSBD140 02438 AHDR-ATC-FILE-TRAN-CNT CL**4 02439 AHDR-CONTROL-TRAN-CNT DTSBD140 02440 AHDR-PROC-TRAN-CNT DTSBD140 02441 AHDR-CONTROL-REMIT-AMT DTSBD140 02442 AHDR-ATC-FILE-REMIT-AMT DTSBD140 02443 AHDR-PROC-REMIT-AMT DTSBD140 02444 AHDR-BANK-BATCH-NO. DTSBD140 02445 S1000-EXIT. DTSBD140 02446 EXIT. DTSBD140 02447 SKIP3 DTSBD140 02448 S1100-DETERMINE-BATCH-NO. DTSBD140 02449 DISPLAY 'MHDR LAST BATCH NO: ' MHDR-LAST-USED-BATCH-NO. CL**3 02450 CL**3 02451 IF MHDR-LAST-USED-BATCH-NO < +99999 CL**3 02452 MOVE MHDR-LAST-USED-BATCH-NO TO WBAT-BATCH-NO CL*13 02453 PERFORM S985-START-BROWSE THRU S985-EXIT CL*24 02454 IF L985-OK-88 CL*13 02455 MOVE WBAT-BATCH-NO TO AHDR-BATCH-NO CL*13 02456 ELSE CL*13 02457 DISPLAY 'ERROR-L985 RETURN CODE: ' L985-RESULT-IND CL*22 02458 PERFORM S999-ABEND THRU S999-EXIT CL*14 02459 END-IF CL*13 02460 END-IF. CL*13 02461 CL**3 02462 DISPLAY 'NEW MHDR-LAST BATCH NO: ' AHDR-BATCH-NO. CL**3 02463 CL**3 02464 S1100-EXIT. DTSBD140 02465 EXIT. DTSBD140 02466 SKIP3 DTSBD140 02467 S2000-TERMINATE-AHDR. DTSBD140 02468 *& DTSBD140 02469 DISPLAY 'DTSBD140 S2000 TRAN CNT ' DTSBD140 02470 AHDR-ATC-FILE-TRAN-CNT ' REMIT ' DTSBD140 02471 AHDR-ATC-FILE-REMIT-AMT DTSBD140 02472 ' ' AHDR-BATCH-NO. DTSBD140 02473 *& DTSBD140 02474 IF AHDR-ATC-FILE-TRAN-CNT = 0 DTSBD140 02475 GO TO S2000-EXIT. DTSBD140 02476 DTSBD140 02477 MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSBD140 02478 DTSBD140 02479 MOVE WRK-AHDR-ITEM-NO TO AHDR-LAST-USED-ITEM-NO. CL*23 02480 DTSBD140 02481 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT. DTSBD140 02482 DTSBD140 02483 MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT. DTSBD140 02484 DTSBD140 02485 MOVE AHDR-REC TO ASKL-REC. DTSBD140 02486 DTSBD140 02487 PERFORM S923-WRITE THRU S923-EXIT. DTSBD140 02488 DTSBD140 02489 ADD +1 TO WRK-ATC-BATCH-CNT. DTSBD140 02490 S2000-EXIT. DTSBD140 02491 EXIT. DTSBD140 02492 EJECT DTSBD140 02493 S001-FROM-FED-8. DTSBD140 02494 SET L001-FROM-FED-8 TO TRUE. DTSBD140 02495 GO TO S001-DATE. DTSBD140 02496 DTSBD140 02497 S001-FROM-CAL-8. DTSBD140 02498 SET L001-FROM-CAL-8 TO TRUE. DTSBD140 02499 GO TO S001-DATE. DTSBD140 02500 DTSBD140 02501 S001-DATE. DTSBD140 02502 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD140 02503 S001-EXIT. DTSBD140 02504 EXIT. DTSBD140 02505 DTSBD140 02506 S004-FROM-5. DTSBD140 02507 SET L004-FROM-5 TO TRUE. DTSBD140 02508 GO TO S004-YRQ. DTSBD140 02509 DTSBD140 02510 S004-FROM-ABS. DTSBD140 02511 SET L004-FROM-ABS TO TRUE. DTSBD140 02512 GO TO S004-YRQ. DTSBD140 02513 DTSBD140 02514 S004-YRQ. DTSBD140 02515 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD140 02516 S004-EXIT. DTSBD140 02517 EXIT. DTSBD140 02518 DTSBD140 02519 S142-NEW-EMP. DTSBD140 02520 CALL 'DTSBD142' USING L142-LINK-AREA DTSBD140 02521 T002-REC. DTSBD140 02522 DTSBD140 02523 S142-EXIT. DTSBD140 02524 EXIT. DTSBD140 02525 DTSBD140 02526 S516-DETERMINE-LIABILITY. DTSBD140 02527 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD140 02528 MPRF-REC. DTSBD140 02529 S516-EXIT. DTSBD140 02530 EXIT. DTSBD140 02531 SKIP3 DTSBD140 02532 S910-OPEN-UPDATE-HDR. DTSBD140 02533 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DTSBD140 02534 GO TO S910-MSTR-CALL. DTSBD140 02535 DTSBD140 02536 S910-OPEN-UPDATE. DTSBD140 02537 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD140 02538 GO TO S910-MSTR-CALL. DTSBD140 02539 DTSBD140 02540 S910-READ. DTSBD140 02541 SET L910-READ-88 TO TRUE. DTSBD140 02542 GO TO S910-MSTR-CALL. DTSBD140 02543 DTSBD140 02544 S910-START-BROWSE. DTSBD140 02545 SET L910-START-BROWSE-88 TO TRUE. DTSBD140 02546 GO TO S910-MSTR-CALL. DTSBD140 02547 DTSBD140 02548 S910-READ-NEXT. DTSBD140 02549 SET L910-READ-NEXT-88 TO TRUE. DTSBD140 02550 GO TO S910-MSTR-CALL. DTSBD140 02551 DTSBD140 02552 *S910-COUNT. DTSBD140 02553 *****SET L910-COUNT-88 TO TRUE. DTSBD140 02554 *****GO TO S910-MSTR-CALL. DTSBD140 02555 DTSBD140 02556 *S910-WRITE. DTSBD140 02557 *****SET L910-WRITE-88 TO TRUE. DTSBD140 02558 *****GO TO S910-MSTR-CALL. DTSBD140 02559 DTSBD140 02560 S910-REWRITE. DTSBD140 02561 SET L910-REWRITE-88 TO TRUE. DTSBD140 02562 GO TO S910-MSTR-CALL. DTSBD140 02563 DTSBD140 02564 *S910-DELETE. DTSBD140 02565 *****SET L910-DELETE-88 TO TRUE. DTSBD140 02566 *****GO TO S910-MSTR-CALL. DTSBD140 02567 DTSBD140 02568 S910-CLOSE. DTSBD140 02569 SET L910-CLOSE-88 TO TRUE. DTSBD140 02570 GO TO S910-MSTR-CALL. DTSBD140 02571 DTSBD140 02572 S910-MSTR-CALL. DTSBD140 02573 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD140 02574 MSKL-REC. DTSBD140 02575 S910-EXIT. DTSBD140 02576 EXIT. DTSBD140 02577 DTSBD140 02578 S921-OPEN-UPDATE. DTSBD140 02579 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD140 02580 GO TO S921-AIX-IO. DTSBD140 02581 DTSBD140 02582 S921-CLOSE. DTSBD140 02583 SET L921-CLOSE-88 TO TRUE. DTSBD140 02584 GO TO S921-AIX-IO. DTSBD140 02585 DTSBD140 02586 S921-AIX-IO. DTSBD140 02587 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD140 02588 ISKL-REC. DTSBD140 02589 S921-EXIT. DTSBD140 02590 EXIT. DTSBD140 02591 DTSBD140 02592 DTSBD140 02593 S923-OPEN-UPDATE. DTSBD140 02594 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBD140 02595 GO TO S923-ATC-CALL. DTSBD140 02596 DTSBD140 02597 *S923-READ. DTSBD140 02598 *****SET L923-READ-88 TO TRUE. DTSBD140 02599 *****GO TO S923-ATC-CALL. DTSBD140 02600 DTSBD140 02601 *S923-START-BROWSE. DTSBD140 02602 *****SET L923-START-BROWSE-88 TO TRUE. DTSBD140 02603 *****GO TO S923-ATC-CALL. DTSBD140 02604 DTSBD140 02605 *S923-READ-NEXT. DTSBD140 02606 *****SET L923-READ-NEXT-88 TO TRUE. DTSBD140 02607 *****GO TO S923-ATC-CALL. DTSBD140 02608 DTSBD140 02609 S923-WRITE. DTSBD140 02610 SET L923-WRITE-88 TO TRUE. DTSBD140 02611 GO TO S923-ATC-CALL. DTSBD140 02612 DTSBD140 02613 *S923-REWRITE. DTSBD140 02614 *****SET L923-REWRITE-88 TO TRUE. DTSBD140 02615 *****GO TO S923-ATC-CALL. DTSBD140 02616 DTSBD140 02617 *S923-DELETE. DTSBD140 02618 *****SET L923-DELETE-88 TO TRUE. DTSBD140 02619 *****GO TO S923-ATC-CALL. DTSBD140 02620 DTSBD140 02621 S923-CLOSE. DTSBD140 02622 SET L923-CLOSE-88 TO TRUE. DTSBD140 02623 GO TO S923-ATC-CALL. DTSBD140 02624 DTSBD140 02625 S923-ATC-CALL. DTSBD140 02626 CALL 'DTSBU923' USING L923-LINK-AREA DTSBD140 02627 ASKL-REC. DTSBD140 02628 S923-EXIT. DTSBD140 02629 EXIT. DTSBD140 02630 SKIP3 DTSBD140 02631 S926-OPEN-READ. DTSBD140 02632 SET L926-OPEN-READ-88 TO TRUE. DTSBD140 02633 GO TO S926-BTC-I. DTSBD140 02634 DTSBD140 02635 S926-READ-NEXT. DTSBD140 02636 SET L926-READ-NEXT-88 TO TRUE. DTSBD140 02637 GO TO S926-BTC-I. DTSBD140 02638 DTSBD140 02639 S926-CLOSE. DTSBD140 02640 SET L926-CLOSE-88 TO TRUE. DTSBD140 02641 GO TO S926-BTC-I. DTSBD140 02642 DTSBD140 02643 S926-BTC-I. DTSBD140 02644 CALL 'DTSBU926' USING L926-LINK-AREA DTSBD140 02645 RSKL-REC. DTSBD140 02646 S926-EXIT. DTSBD140 02647 EXIT. DTSBD140 02648 SKIP3 DTSBD140 02649 S931-OPEN-READ. DTSBD140 02650 SET L931-OPEN-READ-88 TO TRUE. DTSBD140 02651 GO TO S931-REF-CALL. DTSBD140 02652 DTSBD140 02653 S931-CLOSE. DTSBD140 02654 SET L931-CLOSE-88 TO TRUE. DTSBD140 02655 GO TO S931-REF-CALL. DTSBD140 02656 DTSBD140 02657 S931-REF-CALL. DTSBD140 02658 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD140 02659 FSKL-REC. DTSBD140 02660 S931-EXIT. DTSBD140 02661 EXIT. DTSBD140 02662 SKIP3 DTSBD140 02663 S946-TRN-REC-O. DTSBD140 02664 CALL 'DTSBU946' USING RSKL-REC. DTSBD140 02665 S946-EXIT. DTSBD140 02666 EXIT. DTSBD140 02667 SKIP3 DTSBD140 02668 S947-R907-WRITE. DTSBD140 02669 CALL 'DTSBU947' USING R907-REC. DTSBD140 02670 S947-EXIT. DTSBD140 02671 EXIT. DTSBD140 02672 SKIP3 DTSBD140 02673 CL**9 02674 S985-OPEN. CL**9 02675 SET L985-OPEN-READ-88 TO TRUE. CL**9 02676 GO TO S985-BAT-IO. CL**9 02677 S985-READ. CL**9 02678 SET L985-READ-88 TO TRUE. CL**9 02679 GO TO S985-BAT-IO. CL**9 02680 CL**9 02681 S985-START-BROWSE. CL**9 02682 SET L985-START-BROWSE-88 TO TRUE. CL**9 02683 GO TO S985-BAT-IO. CL**9 02684 CL**9 02685 S985-READ-NEXT. CL**9 02686 SET L985-READ-NEXT-88 TO TRUE. CL**9 02687 GO TO S985-BAT-IO. CL**9 02688 CL**9 02689 S985-WRITE. CL**9 02690 SET L985-WRITE-88 TO TRUE. CL**9 02691 GO TO S985-BAT-IO. CL**9 02692 CL**9 02693 S985-REWRITE. CL**9 02694 SET L985-REWRITE-88 TO TRUE. CL**9 02695 GO TO S985-BAT-IO. CL**9 02696 CL**9 02697 S985-DELETE. CL**9 02698 SET L985-DELETE-88 TO TRUE. CL**9 02699 GO TO S985-BAT-IO. CL**9 02700 CL**9 02701 S985-CLOSE. CL**9 02702 SET L985-CLOSE-88 TO TRUE. CL**9 02703 GO TO S985-BAT-IO. CL**9 02704 CL**9 02705 S985-BAT-IO. CL**9 02706 CALL 'DTSBU985' USING L985-LINK-AREA CL**9 02707 LINK-REC. CL**9 02708 S985-EXIT. CL**9 02709 EXIT. CL**9 02710 S999-ABEND. DTSBD140 02711 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD140 02712 S999-EXIT. DTSBD140 02713 EXIT. DTSBD140