2715 lines
215 KiB
COBOL
2715 lines
215 KiB
COBOL
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
|