From 00bf12a4f5921ba658a4547dbf4a29d5dba41f97 Mon Sep 17 00:00:00 2001 From: faizana Date: Tue, 16 Sep 2025 09:03:29 -0400 Subject: [PATCH] As per Srujani's email ,on sep-15, these are the updated programs. --- Batch/DTSBX417.cob | 20 +- Batch/DTSBX418.cob | 10 +- Batch/DTSBX421.cob | 6181 +++++++++++++++++++++++++------------------- Batch/DTSBX426.cob | 3072 +++++++++++----------- Batch/DTSBX430.cob | 8 +- Batch/DTSBX551.cob | 3118 ++++++++++++++++++++++ Batch/DTSBX626.cob | 423 +-- Batch/DTSBX629.cob | 1221 ++++----- 8 files changed, 8863 insertions(+), 5190 deletions(-) create mode 100644 Batch/DTSBX551.cob diff --git a/Batch/DTSBX417.cob b/Batch/DTSBX417.cob index b4506f3..9a070b9 100644 --- a/Batch/DTSBX417.cob +++ b/Batch/DTSBX417.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 05/23/19 +00001 IDENTIFICATION DIVISION. 09/06/25 00002 PROGRAM-ID. DTSBX417. DTSBX417 -00003 AUTHOR. NGC. LV077 +00003 AUTHOR. NGC. LV078 00004 DATE-WRITTEN. APRIL 2005. DTSBX417 00005 DATE-COMPILED. DTSBX417 00006 SKIP3 DTSBX417 @@ -147,7 +147,7 @@ 00147 05 SORT-DATA PIC X(512). DTSBX417 00148 DTSBX417 00149 WORKING-STORAGE SECTION. DTSBX417 -001495 77 PAN-VALET PICTURE X(24) VALUE '077DTSBX417 05/23/19'. DTSBX417 +001495 77 PAN-VALET PICTURE X(24) VALUE '078DTSBX417 09/06/25'. DTSBX417 00150 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX420 10/07/14'. DTSBX417 00151 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX420 10/07/14'. DTSBX417 00152 SKIP3 DTSBX417 @@ -1207,10 +1207,10 @@ 01206 MOVE +91 TO SORT-SEQ1 DTSBX417 01207 MOVE X120-REC TO SORT-DATA DTSBX417 01208 DTSBX417 -01209 WHEN WEB-IMP-TYPE-REL-88 DTSBX417 -01210 PERFORM P1200G-REL THRU P1200G-EXIT DTSBX417 -01211 MOVE +5 TO SORT-SEQ1 DTSBX417 -01212 MOVE X130-REC TO SORT-DATA DTSBX417 +01209 * WHEN WEB-IMP-TYPE-REL-88 CL*78 +01210 * PERFORM P1200G-REL THRU P1200G-EXIT CL*78 +01211 * MOVE +5 TO SORT-SEQ1 CL*78 +01212 * MOVE X130-REC TO SORT-DATA CL*78 01213 DTSBX417 01214 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX417 01215 * MOVE +6 TO SORT-SEQ1 DTSBX417 @@ -1459,9 +1459,9 @@ 01458 P1200F-EXIT. DTSBX417 01459 EXIT. DTSBX417 01460 DTSBX417 -01461 P1200G-REL. DTSBX417 -01462 P1200G-EXIT. DTSBX417 -01463 EXIT. DTSBX417 +01461 *P1200G-REL. CL*78 +01462 *P1200G-EXIT. CL*78 +01463 * EXIT. CL*78 01464 DTSBX417 01465 P1200H-RPT. DTSBX417 01466 * DISPLAY '01200H-RPT ' CL**9 diff --git a/Batch/DTSBX418.cob b/Batch/DTSBX418.cob index eefb077..7d6d779 100644 --- a/Batch/DTSBX418.cob +++ b/Batch/DTSBX418.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 04/03/15 +00001 IDENTIFICATION DIVISION. 08/27/25 00002 PROGRAM-ID. DTSBX418. DTSBX418 -00003 AUTHOR. NGC. LV051 +00003 AUTHOR. NGC. LV052 00004 DATE-WRITTEN. APRIL 2005. DTSBX418 00005 DATE-COMPILED. DTSBX418 00006 SKIP3 DTSBX418 @@ -142,7 +142,7 @@ 00142 05 SORT-DATA PIC X(512). DTSBX418 00143 DTSBX418 00144 WORKING-STORAGE SECTION. DTSBX418 -001445 77 PAN-VALET PICTURE X(24) VALUE '051DTSBX418 04/03/15'. DTSBX418 +001445 77 PAN-VALET PICTURE X(24) VALUE '052DTSBX418 08/27/25'. DTSBX418 00145 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX418 10/07/14'. CL*49 00146 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX418 10/07/14'. CL*49 00147 SKIP3 DTSBX418 @@ -566,8 +566,8 @@ 00565 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSBX418 00566 MOVE L005-DATE TO LX42-SYS-DATE. DTSBX418 00567 MOVE L005-TIME TO LX42-SYS-TIME. DTSBX418 -00568 * MOVE ZERO TO LX42-BATCH-NO DTSBX418 -00568 MOVE ZERO TO LX42-PSEUDO-BATCH-NO DTSBX418 +00568 * MOVE ZERO TO LX42-BATCH-NO CL*52 +00569 MOVE ZERO TO LX42-PSEUDO-BATCH-NO CL*52 00570 LX42-LAST-DETERM-EMP DTSBX418 00571 LX42-RPT-CNT DTSBX418 00572 LX42-RPT-REMIT-AMT DTSBX418 diff --git a/Batch/DTSBX421.cob b/Batch/DTSBX421.cob index 1765466..d2f59d1 100644 --- a/Batch/DTSBX421.cob +++ b/Batch/DTSBX421.cob @@ -1,10 +1,10 @@ -00001 IDENTIFICATION DIVISION. 10/07/14 +00001 IDENTIFICATION DIVISION. 02/12/25 00002 PROGRAM-ID. DTSBX421. DTSBX421 -00003 AUTHOR. NGC. LV011 +00003 AUTHOR. NGC. LV165 00004 DATE-WRITTEN. APRIL 2005. DTSBX421 00005 DATE-COMPILED. DTSBX421 00006 SKIP3 DTSBX421 -00007 ***** DTSBX421 +00007 **** CL*78 00008 * DTSBX421 00009 * NOTE: P1510-EDIT-ADDRESS IS COMMENTED OUT. DTSBX421 00010 * DTSBX421 @@ -21,2649 +21,3566 @@ 00021 * 04-05-2005 INITIAL DEVELOPMENT DTSBX421 00022 * REFERENCE RFP: WEB REGISTRATION DTSBX421 00023 * DTSBX421 -00024 * DTSBX421 -00025 ***** DTSBX421 -00026 SKIP3 DTSBX421 -00027 ENVIRONMENT DIVISION. DTSBX421 -00028 SKIP2 DTSBX421 -00029 INPUT-OUTPUT SECTION. DTSBX421 -00030 DTSBX421 -00031 FILE-CONTROL. DTSBX421 -00032 DTSBX421 -00033 SELECT TEMP-BTC-FILE ASSIGN TO X421BTC DTSBX421 -00034 FILE STATUS IS TEMP-BTC-STATUS. DTSBX421 -00035 DTSBX421 -00036 DATA DIVISION. DTSBX421 -00037 DTSBX421 -00038 FILE SECTION. DTSBX421 -00039 DTSBX421 -00040 FD TEMP-BTC-FILE DTSBX421 -00041 RECORDING MODE IS V DTSBX421 -00042 BLOCK CONTAINS 0 RECORDS. DTSBX421 -00043 DTSBX421 -00044 01 TEMP-BTC-REC. DTSBX421 -00045 ++INCLUDE DTSIRVAR DTSBX421 -00046 DTSBX421 -00047 01 TSKL-REC. DTSBX421 -00048 ++INCLUDE DTSITSKL DTSBX421 -00049 DTSBX421 -00050 WORKING-STORAGE SECTION. DTSBX421 -000505 77 PAN-VALET PICTURE X(24) VALUE '011DTSBX421 10/07/14'. DTSBX421 -00051 77 PAN-VALET PICTURE X(24) VALUE '032DTSBX421 10/07/14'. DTSBX421 -00052 SKIP3 DTSBX421 -00053 01 WRK-AREA. DTSBX421 -00054 05 W-ABEND-CD PIC S9(04) COMP VALUE 421. DTSBX421 -00055 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX421'.DTSBX421 +00024 * CL142 +00025 * 09-15-2018 MODIFY CODE TO VALIDATE FEIN BASED ON IRS RULES. CL142 +00026 * REFERENCE RFP: WEB REGISTRATION ZL1 CL142 +00027 * CL142 +00028 * CL152 +00029 * 11-29-2020 MODIFY CODE TO ADD RATE RECORD FOR 2021 CL152 +00030 * REFERENCE RFP: WEB REGISTRATION ZL1 CL152 +00031 * CL152 +00032 * DTSBX421 +00033 ***** DTSBX421 +00034 SKIP3 DTSBX421 +00035 ENVIRONMENT DIVISION. DTSBX421 +00036 CONFIGURATION SECTION. CL*99 +00037 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*99 +00038 SKIP2 DTSBX421 +00039 INPUT-OUTPUT SECTION. DTSBX421 +00040 DTSBX421 +00041 FILE-CONTROL. DTSBX421 +00042 DTSBX421 +00043 SELECT TEMP-BTC-FILE ASSIGN TO X421BTC DTSBX421 +00044 FILE STATUS IS TEMP-BTC-STATUS. DTSBX421 +00045 CL*87 +00046 SELECT REPT-PAID-FILE ASSIGN TO X421RPT1 CL*87 +00047 FILE STATUS IS REPT-STATUS. CL*87 +00048 CL*87 +00049 SELECT REPT-PEND-FILE ASSIGN TO X421RPT2 CL*87 +00050 FILE STATUS IS REPT-STATUS. CL*87 +00051 CL*87 +00052 DTSBX421 +00053 DATA DIVISION. DTSBX421 +00054 DTSBX421 +00055 FILE SECTION. DTSBX421 00056 DTSBX421 -00057 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX421 -00058 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX421 -00059 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX421 -00060 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX421 -00061 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX421 -00062 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX421 -00063 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX421 -00064 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX421 -00065 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX421 -00066 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX421 -00067 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX421 -00068 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX421 -00069 DTSBX421 -00070 05 BATCH-STATUS PIC X(02). DTSBX421 -00071 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX421 -00072 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX421 -00073 DTSBX421 -00074 05 TEMP-BTC-STATUS PIC X(02). DTSBX421 -00075 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX421 -00076 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX421 -00077 DTSBX421 -00078 05 WAGE-TEMP-STATUS PIC X(02). DTSBX421 -00079 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX421 -00080 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX421 -00081 DTSBX421 -00082 05 WAGE-OUT-STATUS PIC X(02). DTSBX421 -00083 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX421 -00084 DTSBX421 -00085 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX421 -00086 DTSBX421 -00087 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 -00088 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX421 -00089 88 W-ERROR-NO-88 VALUE 'N'. DTSBX421 +00057 FD TEMP-BTC-FILE DTSBX421 +00058 RECORDING MODE IS V DTSBX421 +00059 BLOCK CONTAINS 0 RECORDS. DTSBX421 +00060 DTSBX421 +00061 01 TEMP-BTC-REC. DTSBX421 +00062 ++INCLUDE DTSIRVAR DTSBX421 +00063 DTSBX421 +00064 01 TSKL-REC. DTSBX421 +00065 ++INCLUDE DTSITSKL DTSBX421 +00066 FD REPT-PAID-FILE CL*87 +00067 RECORDING MODE IS F CL*87 +00068 BLOCK CONTAINS 0 RECORDS CL*87 +00069 LABEL RECORDS ARE OMITTED. CL*87 +00070 CL*87 +00071 01 REPT-PAID-REC PIC X(133). CL*87 +00072 CL*87 +00073 CL*87 +00074 FD REPT-PEND-FILE CL*87 +00075 RECORDING MODE IS F CL*87 +00076 BLOCK CONTAINS 0 RECORDS CL*87 +00077 LABEL RECORDS ARE OMITTED. CL*87 +00078 CL*87 +00079 01 REPT-PEND-REC PIC X(133). CL*87 +00080 CL*87 +00081 CL*87 +00082 DTSBX421 +00083 WORKING-STORAGE SECTION. DTSBX421 +000835 77 PAN-VALET PICTURE X(24) VALUE '165DTSBX421 02/12/25'. DTSBX421 +00084 77 PAN-VALET PICTURE X(24) VALUE '011DTSBX421 10/07/14'. DTSBX421 +00085 77 PAN-VALET PICTURE X(24) VALUE '032DTSBX421 10/07/14'. DTSBX421 +00086 SKIP3 DTSBX421 +00087 01 WRK-AREA. DTSBX421 +00088 05 W-ABEND-CD PIC S9(04) COMP VALUE 421. DTSBX421 +00089 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX421'.DTSBX421 00090 DTSBX421 -00091 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 -00092 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX421 -00093 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX421 -00094 DTSBX421 -00095 05 W-RATE-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 -00096 88 W-RATE-ERROR-YES-88 VALUE 'Y'. DTSBX421 -00097 88 W-RATE-ERROR-NO-88 VALUE 'N'. DTSBX421 -00098 DTSBX421 -00099 05 W-DUP-RATE-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 -00100 88 W-DUP-RATE-YES-88 VALUE 'Y'. DTSBX421 -00101 88 W-DUP-RATE-NO-88 VALUE 'N'. DTSBX421 -00102 DTSBX421 -00103 05 W-EMP-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX421 -00104 88 W-EMP-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX421 -00105 88 W-EMP-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX421 -00106 DTSBX421 -00107 05 W-DUP-FEIN-IND PIC X(01) VALUE 'N'. DTSBX421 -00108 88 W-DUP-FEIN-YES-88 VALUE 'Y'. DTSBX421 -00109 88 W-DUP-FEIN-NO-88 VALUE 'N'. DTSBX421 -00110 DTSBX421 -00111 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX421 -00112 05 W-FEIN PIC 9(09) VALUE ZERO. DTSBX421 -00113 05 W-SOURCE-CD PIC X(02) VALUE SPACES. DTSBX421 -00114 05 W-CLASS PIC X(01) VALUE SPACES. DTSBX421 -00115 ** 05 W-FEIN-EMP-NO PIC 9(06) VALUE ZERO. DTSBX421 -00116 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX421 -00117 05 W-LIABLE-DATE PIC S9(09) COMP-3. DTSBX421 -00118 05 W-WAGES-PLANNED-DATE PIC S9(09) COMP-3. DTSBX421 -00119 05 W-INCORP-DATE PIC S9(09) COMP-3. DTSBX421 -00120 05 W-FIRST-500-QTR PIC S9(05) COMP-3. DTSBX421 -00121 05 W-LAST-RPT-DUE PIC S9(05) COMP-3. DTSBX421 -00122 05 W-RATE PIC S9V9(04) COMP-3. DTSBX421 -00123 05 W-FIELD-ZIP PIC X(10). DTSBX421 -00124 05 W-FIELD-STATE PIC X(02). DTSBX421 -00125 05 W-PRED-EMP-NO PIC 9(07) VALUE ZERO. DTSBX421 -00126 05 W-PRED-FEIN PIC 9(09) VALUE ZERO. DTSBX421 -00127 05 W-PRED-EFF-DATE PIC X(10). DTSBX421 -00128 05 W-PORTION-EXP-TRNSF-X PIC X(06). DTSBX421 -00129 05 W-PORTION-EXP-TRNSF-N REDEFINES DTSBX421 -00130 W-PORTION-EXP-TRNSF-X PIC 999.99. DTSBX421 -00131 05 W-WAGES-X PIC X(14). DTSBX421 -00132 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX421 -00133 PIC 9(11).99. DTSBX421 -00134 05 W-REMIT-X PIC X(12). DTSBX421 -00135 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX421 -00136 PIC 9(09).99. DTSBX421 -00137 05 W-COUNT-X PIC X(07). DTSBX421 -00138 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX421 -00139 PIC 9(07). DTSBX421 -00140 * 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBX421 -00141 * 05 WRK-REPORT-QTR PIC 9(05). DTSBX421 -00142 * 05 W-TOT-WAGE PIC S9(11)V99. DTSBX421 -00143 * 05 W-TAX-WAGE PIC S9(11)V99. DTSBX421 -00144 * 05 W-WRKR-TOT-WAGE PIC S9(11)V99. DTSBX421 -00145 * 05 W-WRKR-TAX-WAGE PIC S9(11)V99. DTSBX421 -00146 * 05 W-REMITTANCE PIC S9(09)V99. DTSBX421 -00147 * 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX421 -00148 * 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 -00149 * 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 -00150 * 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 -00151 * 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX421 -00152 * 05 W-SSN PIC S9(09) COMP-3. DTSBX421 -00153 * 05 W-EARNINGS-X PIC X(12). DTSBX421 -00154 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX421 -00155 * PIC 9(09).99. DTSBX421 -00156 * 05 W-EARNINGS PIC S9(09)V99. DTSBX421 -00157 * 05 W-NAME-EFF-DATE PIC X(10). DTSBX421 -00158 * 05 W-WORKER-NAME. DTSBX421 -00159 * 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX421 -00160 * 10 W-WRKR-MID-INIT PIC X(01). DTSBX421 -00161 * 10 W-WRKR-LAST-NAME PIC X(20). DTSBX421 -00162 DTSBX421 -00163 05 W-ENTITY-NAME PIC X(40). DTSBX421 -00164 05 W-TRADE-NAME PIC X(40). DTSBX421 -00165 DTSBX421 -00166 * 05 W-RPT-TYPE PIC X(02). DTSBX421 -00167 * 88 W-ORIG-88 VALUE 'OR'. DTSBX421 -00168 * 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX421 -00169 * 88 W-AUDIT-88 VALUE 'AU'. DTSBX421 -00170 * 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX421 -00171 * 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX421 -00172 * 88 W-ESTIM-88 VALUE 'ES'. DTSBX421 -00173 * 88 W-WITHDRW-88 VALUE 'WD'. DTSBX421 -00174 * 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX421 -00175 * 'FS' 'AC'. DTSBX421 -00176 * 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX421 -00177 * 'FS' 'AC' 'ES' DTSBX421 -00178 * 'WD'. DTSBX421 -00179 * DTSBX421 -00180 * 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX421 -00181 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX421 -00182 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX421 -00183 * 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX421 -00184 * DTSBX421 -00185 * 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX421 -00186 * 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX421 -00187 * DTSBX421 -00188 * 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX421 -00189 * DTSBX421 -00190 * 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX421 -00191 DTSBX421 -00192 05 ISUB1 PIC S9(04) COMP. DTSBX421 -00193 05 ISUB2 PIC S9(04) COMP. DTSBX421 -00194 05 ISUB3 PIC S9(04) COMP. DTSBX421 -00195 05 ISUB4 PIC S9(04) COMP. DTSBX421 -00196 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX421 -00197 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX421 -00198 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX421 -00199 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX421 -00200 VALUE +502. DTSBX421 -00201 05 W-INPUT-LINE PIC X(500). DTSBX421 -00202 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX421 -00203 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX421 -00204 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX421 -00205 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX421 -00206 05 W-CONV-LINE PIC X(32). DTSBX421 -00207 DTSBX421 -00208 05 W-MNTE-SUBJECT PIC X(40). DTSBX421 -00209 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX421 -00210 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX421 -00211 88 W-MNTE-KEY-WORD-88 VALUE DTSBX421 -00212 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX421 -00213 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX421 -00214 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX421 -00215 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX421 -00216 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX421 -00217 DTSBX421 -00218 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX421 -00219 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX421 -00220 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX421 -00221 DTSBX421 -00222 05 TSUB1 PIC S9(04) COMP. DTSBX421 -00223 05 TSUB2 PIC S9(04) COMP. DTSBX421 -00224 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX421 -00225 DTSBX421 -00226 05 W-MNTE-LINE PIC X(72). DTSBX421 -00227 DTSBX421 -00228 05 W-TEST-AMT PIC X(06) VALUE SPACES. DTSBX421 -00229 DTSBX421 -00230 05 W-VALUE PIC S9(7)V9(06) COMP-3. DTSBX421 -00231 05 W-DIGIT PIC 9(01). DTSBX421 -00232 05 W-DISP-AMT PIC ------9.9(06). DTSBX421 -00233 DTSBX421 -00234 05 RSUB PIC S9(04) COMP. DTSBX421 -00235 05 W-MULTIPLIER PIC S9(07)V9(07) COMP-3. DTSBX421 -00236 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX421 -00237 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX421 -00238 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX421 -00239 DTSBX421 -00240 05 SUB PIC S9(04) COMP. DTSBX421 -00241 05 W-RATE-AREA OCCURS 5 TIMES. DTSBX421 -00242 10 W-RATE-YEAR PIC S9(05) COMP-3. DTSBX421 -00243 10 W-RATE-FOUND-IND PIC X(01). DTSBX421 -00244 88 W-RATE-FOUND-YES-88 VALUE 'Y'. DTSBX421 -00245 88 W-RATE-FOUND-NO-88 VALUE 'N'. DTSBX421 -00246 DTSBX421 -00247 05 W-SLASH-DATE PIC X(10). DTSBX421 -00248 05 FILLER REDEFINES W-SLASH-DATE. DTSBX421 -00249 10 W-SLASH-DT-MM PIC X(02). DTSBX421 -00250 10 FILLER PIC X(01). DTSBX421 -00251 10 W-SLASH-DT-DD PIC X(02). DTSBX421 -00252 10 FILLER PIC X(01). DTSBX421 -00253 10 W-SLASH-DT-CCYY PIC X(04). DTSBX421 -00254 DTSBX421 -00255 05 W-SLASH-QTR PIC X(06). DTSBX421 -00256 05 FILLER REDEFINES W-SLASH-QTR. DTSBX421 -00257 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX421 -00258 10 FILLER PIC X(01). DTSBX421 -00259 10 W-SLASH-QTR-Q PIC X(01). DTSBX421 -00260 DTSBX421 -00261 05 WRK-PHONE PIC X(15) VALUE SPACES. DTSBX421 -00262 05 FILLER REDEFINES WRK-PHONE. DTSBX421 -00263 10 WRK-AREA-CD PIC X(03). DTSBX421 -00264 10 WRK-PREFIX PIC X(03). DTSBX421 -00265 10 WRK-SUFFIX PIC X(04). DTSBX421 -00266 10 WRK-EXT PIC X(05). DTSBX421 -00267 05 WRK-EXT-HYPHEN PIC X(01) VALUE SPACES. DTSBX421 -00268 05 WRK-PHONE-TEXT1 PIC X(72) VALUE SPACES. DTSBX421 -00269 05 WRK-PHONE-TEXT2 PIC X(72) VALUE SPACES. DTSBX421 -00270 DTSBX421 -00271 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00272 05 W-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00273 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00274 05 WRK-EMP-WAGE-CNT PIC 9(07) VALUE 0. DTSBX421 -00275 * PROFILE DTSBX421 -00276 05 W-X102-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00277 * DETERMINATION DTSBX421 -00278 05 W-X104-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00279 * NAME DTSBX421 -00280 05 W-X106-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00281 * RATE DTSBX421 -00282 05 W-X108-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00283 * ADDRESS DTSBX421 -00284 05 W-X110-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00285 * OPO DTSBX421 -00286 05 W-X120-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00287 * RELATIONSHIP DTSBX421 -00288 05 W-X130-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00289 * INDUSTRY DESCRIPTION DTSBX421 -00290 05 W-X132-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00291 * REPORT DTSBX421 -00292 05 W-X140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00293 DTSBX421 -00294 05 W-T002-PRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00295 05 W-T002-DETERM-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00296 05 W-T002-NAME-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00297 05 W-T002-RATE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00298 05 W-T002-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00299 05 W-T002-OPO-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00300 05 W-T002-REL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00301 05 W-T002-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00302 DTSBX421 -00303 05 W-T003-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00304 DTSBX421 -00305 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00306 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00307 05 W-X140-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00091 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX421 +00092 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX421 +00093 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX421 +00094 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX421 +00095 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX421 +00096 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX421 +00097 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX421 +00098 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX421 +00099 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX421 +00100 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX421 +00101 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX421 +00102 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX421 +00103 DTSBX421 +00104 CL*91 +00105 05 REPT-STATUS PIC X(02). CL*91 +00106 88 REPT-STATUS-EOF-88 VALUE '10'. CL*91 +00107 88 REPT-STATUS-OK-88 VALUE '00'. CL*91 +00108 CL*91 +00109 05 BATCH-STATUS PIC X(02). DTSBX421 +00110 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX421 +00111 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX421 +00112 DTSBX421 +00113 05 TEMP-BTC-STATUS PIC X(02). DTSBX421 +00114 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX421 +00115 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX421 +00116 DTSBX421 +00117 05 WAGE-TEMP-STATUS PIC X(02). DTSBX421 +00118 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX421 +00119 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX421 +00120 DTSBX421 +00121 05 WAGE-OUT-STATUS PIC X(02). DTSBX421 +00122 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX421 +00123 DTSBX421 +00124 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX421 +00125 DTSBX421 +00126 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 +00127 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX421 +00128 88 W-ERROR-NO-88 VALUE 'N'. DTSBX421 +00129 DTSBX421 +00130 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 +00131 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX421 +00132 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX421 +00133 DTSBX421 +00134 05 W-RATE-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 +00135 88 W-RATE-ERROR-YES-88 VALUE 'Y'. DTSBX421 +00136 88 W-RATE-ERROR-NO-88 VALUE 'N'. DTSBX421 +00137 DTSBX421 +00138 05 W-DUP-RATE-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 +00139 88 W-DUP-RATE-YES-88 VALUE 'Y'. DTSBX421 +00140 88 W-DUP-RATE-NO-88 VALUE 'N'. DTSBX421 +00141 DTSBX421 +00142 05 W-EMP-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX421 +00143 88 W-EMP-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX421 +00144 88 W-EMP-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX421 +00145 DTSBX421 +00146 05 W-DUP-FEIN-IND PIC X(01) VALUE 'N'. DTSBX421 +00147 88 W-DUP-FEIN-YES-88 VALUE 'Y'. DTSBX421 +00148 88 W-DUP-FEIN-NO-88 VALUE 'N'. DTSBX421 +00149 DTSBX421 +00150 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX421 +00151 05 W-FEIN PIC 9(09) VALUE ZERO. DTSBX421 +00152 05 W-SOURCE-CD PIC X(02) VALUE SPACES. DTSBX421 +00153 05 W-CLASS PIC X(01) VALUE SPACES. DTSBX421 +00154 ** 05 W-FEIN-EMP-NO PIC 9(06) VALUE ZERO. DTSBX421 +00155 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX421 +00156 05 W-LIABLE-DATE PIC S9(09) COMP-3. DTSBX421 +00157 05 W-WAGES-PLANNED-DATE PIC S9(09) COMP-3. DTSBX421 +00158 05 W-INCORP-DATE PIC S9(09) COMP-3. DTSBX421 +00159 05 W-FIRST-500-QTR PIC S9(05) COMP-3. DTSBX421 +00160 05 W-LAST-RPT-DUE PIC S9(05) COMP-3. DTSBX421 +00161 05 W-RATE PIC S9V9(04) COMP-3. DTSBX421 +00162 05 W-RATE-Z PIC X(6). CL130 +00163 05 W-RATE-X REDEFINES W-RATE-Z PIC 9.9999. CL130 +00164 05 W-FIELD-ZIP PIC X(10). DTSBX421 +00165 05 W-FIELD-STATE PIC X(02). DTSBX421 +00166 05 W-PRED-EMP-NO PIC 9(07) VALUE ZERO. DTSBX421 +00167 05 W-PRED-FEIN PIC 9(09) VALUE ZERO. DTSBX421 +00168 05 W-PRED-EFF-DATE PIC X(10). DTSBX421 +00169 05 W-PORTION-EXP-TRNSF-X PIC X(06). DTSBX421 +00170 05 W-PORTION-EXP-TRNSF-N REDEFINES DTSBX421 +00171 W-PORTION-EXP-TRNSF-X PIC 999.99. DTSBX421 +00172 05 W-WAGES-X PIC X(14). DTSBX421 +00173 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX421 +00174 PIC 9(11).99. DTSBX421 +00175 05 W-REMIT-X PIC X(12). DTSBX421 +00176 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX421 +00177 PIC 9(09).99. DTSBX421 +00178 05 W-COUNT-X PIC X(07). DTSBX421 +00179 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX421 +00180 PIC 9(07). DTSBX421 +00181 * 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBX421 +00182 * 05 WRK-REPORT-QTR PIC 9(05). DTSBX421 +00183 * 05 W-TOT-WAGE PIC S9(11)V99. DTSBX421 +00184 * 05 W-TAX-WAGE PIC S9(11)V99. DTSBX421 +00185 * 05 W-WRKR-TOT-WAGE PIC S9(11)V99. DTSBX421 +00186 * 05 W-WRKR-TAX-WAGE PIC S9(11)V99. DTSBX421 +00187 * 05 W-REMITTANCE PIC S9(09)V99. DTSBX421 +00188 * 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX421 +00189 * 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 +00190 * 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 +00191 * 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 +00192 * 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX421 +00193 * 05 W-SSN PIC S9(09) COMP-3. DTSBX421 +00194 05 W-RUN-DATE PIC 9(07) VALUE 0. CL121 +00195 05 Z-RUN-DATE REDEFINES W-RUN-DATE. CL122 +00196 10 Z-CC PIC 9(01). CL122 +00197 10 Z-YY PIC 9(02). CL122 +00198 10 Z-MM PIC 9(02). CL122 +00199 10 Z-DD PIC 9(02). CL122 +00200 ** 05 W-EARNINGS-X PIC X(12). CL122 +00201 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX421 +00202 * PIC 9(09).99. DTSBX421 +00203 * 05 W-EARNINGS PIC S9(09)V99. DTSBX421 +00204 * 05 W-NAME-EFF-DATE PIC X(10). DTSBX421 +00205 * 05 W-WORKER-NAME. DTSBX421 +00206 * 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX421 +00207 * 10 W-WRKR-MID-INIT PIC X(01). DTSBX421 +00208 * 10 W-WRKR-LAST-NAME PIC X(20). DTSBX421 +00209 DTSBX421 +00210 05 W-ENTITY-NAME PIC X(40). DTSBX421 +00211 05 W-TRADE-NAME PIC X(40). DTSBX421 +00212 05 W-X421-NAME PIC X(20) VALUE SPACES. CL164 +00213 DTSBX421 +00214 * 05 W-RPT-TYPE PIC X(02). DTSBX421 +00215 * 88 W-ORIG-88 VALUE 'OR'. DTSBX421 +00216 * 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX421 +00217 * 88 W-AUDIT-88 VALUE 'AU'. DTSBX421 +00218 * 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX421 +00219 * 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX421 +00220 * 88 W-ESTIM-88 VALUE 'ES'. DTSBX421 +00221 * 88 W-WITHDRW-88 VALUE 'WD'. DTSBX421 +00222 * 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX421 +00223 * 'FS' 'AC'. DTSBX421 +00224 * 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX421 +00225 * 'FS' 'AC' 'ES' DTSBX421 +00226 * 'WD'. DTSBX421 +00227 * DTSBX421 +00228 05 WRK-FEIN. CL136 +00229 10 WRK-FEIN-PREFIX PIC 9(02). CL137 +00230 88 WRK-FEIN-VALID-88 VALUE 01 02 03 04 05 06 10 11 12 CL136 +00231 13 14 16 21 22 23 25 30 32 CL136 +00232 34 35 36 37 38 50 51 52 53 CL136 +00233 54 55 56 57 58 59 60 61 65 CL136 +00234 67 15 24 40 44 94 95 80 90 CL136 +00235 20 26 27 45 46 47 81 82 83 CL136 +00236 33 39 41 42 43 46 48 62 63 CL136 +00237 64 66 68 71 72 73 74 75 76 CL136 +00238 77 82 83 84 85 86 87 88 91 CL136 +00239 92 93 98 99 31. CL140 +00240 CL136 +00241 10 WRK-FEIN-SUFFIX PIC 9(07). CL137 +00242 * 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX421 +00243 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX421 +00244 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX421 +00245 * 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX421 +00246 * DTSBX421 +00247 * 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX421 +00248 * 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX421 +00249 * DTSBX421 +00250 * 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX421 +00251 * DTSBX421 +00252 * 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX421 +00253 DTSBX421 +00254 05 ISUB1 PIC S9(04) COMP. DTSBX421 +00255 05 ISUB2 PIC S9(04) COMP. DTSBX421 +00256 05 ISUB3 PIC S9(04) COMP. DTSBX421 +00257 05 ISUB4 PIC S9(04) COMP. DTSBX421 +00258 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX421 +00259 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX421 +00260 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX421 +00261 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX421 +00262 VALUE +502. DTSBX421 +00263 05 W-INPUT-LINE PIC X(500). DTSBX421 +00264 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX421 +00265 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX421 +00266 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX421 +00267 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX421 +00268 05 W-CONV-LINE PIC X(32). DTSBX421 +00269 DTSBX421 +00270 05 W-MNTE-SUBJECT PIC X(40). DTSBX421 +00271 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX421 +00272 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX421 +00273 88 W-MNTE-KEY-WORD-88 VALUE DTSBX421 +00274 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX421 +00275 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX421 +00276 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX421 +00277 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX421 +00278 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX421 +00279 DTSBX421 +00280 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX421 +00281 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX421 +00282 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX421 +00283 DTSBX421 +00284 05 TSUB1 PIC S9(04) COMP. DTSBX421 +00285 05 TSUB2 PIC S9(04) COMP. DTSBX421 +00286 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX421 +00287 DTSBX421 +00288 05 W-MNTE-LINE PIC X(72). DTSBX421 +00289 DTSBX421 +00290 05 W-TEST-AMT PIC X(06) VALUE SPACES. DTSBX421 +00291 DTSBX421 +00292 05 W-VALUE PIC S9(7)V9(06) COMP-3. DTSBX421 +00293 05 W-DIGIT PIC 9(01). DTSBX421 +00294 05 W-DISP-AMT PIC ------9.9(06). DTSBX421 +00295 DTSBX421 +00296 05 RSUB PIC S9(04) COMP. DTSBX421 +00297 05 W-MULTIPLIER PIC S9(07)V9(07) COMP-3. DTSBX421 +00298 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX421 +00299 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX421 +00300 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX421 +00301 DTSBX421 +00302 05 SUB PIC S9(04) COMP. DTSBX421 +00303 05 W-RATE-AREA OCCURS 5 TIMES. DTSBX421 +00304 10 W-RATE-YEAR PIC S9(05) COMP-3. DTSBX421 +00305 10 W-RATE-FOUND-IND PIC X(01). DTSBX421 +00306 88 W-RATE-FOUND-YES-88 VALUE 'Y'. DTSBX421 +00307 88 W-RATE-FOUND-NO-88 VALUE 'N'. DTSBX421 00308 DTSBX421 -00309 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX421 -00310 05 W-X102-LENGTH PIC S9(04) COMP. DTSBX421 -00311 05 W-X104-LENGTH PIC S9(04) COMP. DTSBX421 -00312 05 W-X106-LENGTH PIC S9(04) COMP. DTSBX421 -00313 05 W-X108-LENGTH PIC S9(04) COMP. DTSBX421 -00314 05 W-X110-LENGTH PIC S9(04) COMP. DTSBX421 -00315 05 W-X120-LENGTH PIC S9(04) COMP. DTSBX421 -00316 05 W-X130-LENGTH PIC S9(04) COMP. DTSBX421 -00317 05 W-X132-LENGTH PIC S9(04) COMP. DTSBX421 -00318 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX421 -00319 DTSBX421 -00320 05 W-AMT-DISP1 PIC ----------9.99. DTSBX421 -00321 05 W-AMT-DISP2 PIC ----------9.99. DTSBX421 -00322 *RW1 DTSBX421 -00323 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 -00324 05 DISPLAY-CNT PIC Z(06)9. DTSBX421 -00325 DTSBX421 -00326 01 MESSAGE-AREA. DTSBX421 -00327 05 WRK-MESSAGE PIC X(80). DTSBX421 -00328 05 MSG1-INVALID-FEIN. DTSBX421 -00329 10 FILLER PIC X(08) DTSBX421 -00330 VALUE 'PROFILE:'. DTSBX421 -00331 10 FILLER PIC X(02) DTSBX421 -00332 VALUE SPACES. DTSBX421 -00333 10 FILLER PIC X(18) DTSBX421 -00334 VALUE 'NON-NUMERIC FEIN: '. DTSBX421 -00335 10 MSG1-FEIN PIC X(09). DTSBX421 -00336 05 MSG2-SOURCE-CODE. DTSBX421 -00337 10 FILLER PIC X(08) DTSBX421 -00338 VALUE 'PROFILE:'. DTSBX421 -00339 10 FILLER PIC X(27) DTSBX421 -00340 VALUE 'INVALID SOURCE CODE: '. DTSBX421 -00341 10 MSG2-SOURCE-CD PIC X(02). DTSBX421 -00342 05 MSG3-EMP-ON-FILE. DTSBX421 -00343 10 FILLER PIC X(08) DTSBX421 -00344 VALUE 'PROFILE:'. DTSBX421 -00345 10 FILLER PIC X(29) DTSBX421 -00346 VALUE 'EMPLOYER ACCT ALREADY ON FILE'. DTSBX421 -00347 05 MSG4-DUP-EMP. DTSBX421 -00348 10 FILLER PIC X(14) DTSBX421 -00349 VALUE 'PROFILE:'. DTSBX421 -00350 10 FILLER PIC X(22) DTSBX421 -00351 VALUE 'FEIN ALREADY ON FILE: '. DTSBX421 -00352 10 MSG4-FEIN PIC X(09). DTSBX421 -00353 05 MSG5-INVALID-LIAB-CD. DTSBX421 -00354 10 FILLER PIC X(08) DTSBX421 -00355 VALUE 'DETERM: '. DTSBX421 -00356 10 FILLER PIC X(24) DTSBX421 -00357 VALUE 'INVALID LIABILITY CODE: '. DTSBX421 -00358 10 MSG5-LIAB-CD PIC X(02). DTSBX421 -00359 05 MSG6-INVALID-ELIG-CD. DTSBX421 -00360 10 FILLER PIC X(08) DTSBX421 -00361 VALUE 'DETERM: '. DTSBX421 -00362 10 FILLER PIC X(26) DTSBX421 -00363 VALUE 'INVALID ELIGIBILITY CODE: '. DTSBX421 -00364 10 MSG6-ELIG-CD PIC X(02). DTSBX421 -00365 05 MSG7-INVALID-ORG-TYPE. DTSBX421 -00366 10 FILLER PIC X(08) DTSBX421 -00367 VALUE 'DETERM: '. DTSBX421 -00368 10 FILLER PIC X(27) DTSBX421 -00369 VALUE 'INVALID ORGANIZATION TYPE: '. DTSBX421 -00370 10 MSG7-ORG-TYPE PIC X(03). DTSBX421 -00371 05 MSG8-INVALID-INCORP-DATE. DTSBX421 -00372 10 FILLER PIC X(08) DTSBX421 -00373 VALUE 'DETERM: '. DTSBX421 -00374 10 FILLER PIC X(28) DTSBX421 -00375 VALUE 'INVALID INCORPORATION DATE: '. DTSBX421 -00376 10 MSG8-INCORP-DATE PIC X(10). DTSBX421 -00377 05 MSG9-INVALID-FILING-SCHED. DTSBX421 -00378 10 FILLER PIC X(08) DTSBX421 -00379 VALUE 'DETERM: '. DTSBX421 -00380 10 FILLER PIC X(25) DTSBX421 -00381 VALUE 'INVALID FILING SCHEDULE: '. DTSBX421 -00382 10 MSG9-ORG-TYPE PIC X(02). DTSBX421 -00383 10 FILLER PIC X(02) DTSBX421 -00384 VALUE SPACES. DTSBX421 -00385 10 MSG9-FILING-SCHED PIC X(01). DTSBX421 -00386 05 MSG10-INCONSISTENT-LIAB-CD. DTSBX421 -00387 10 FILLER PIC X(08) DTSBX421 -00388 VALUE 'DETERM: '. DTSBX421 -00389 10 FILLER PIC X(34) DTSBX421 -00390 VALUE 'INCONSISTENT ELIG AND LIAB CODES: '. DTSBX421 -00391 10 MSG10-ELIG-CD PIC X(02). DTSBX421 -00392 10 FILLER PIC X(02) DTSBX421 -00393 VALUE SPACES. DTSBX421 -00394 10 MSG10-LIAB-CD PIC X(02). DTSBX421 -00395 05 MSG11-WAGES-PAID-QTR. DTSBX421 -00396 10 FILLER PIC X(08) DTSBX421 -00397 VALUE 'DETERM: '. DTSBX421 -00398 10 FILLER PIC X(24) DTSBX421 -00399 VALUE 'INVALID WAGES PAID QTR: '. DTSBX421 -00400 10 MSG11-QTR PIC X(02). DTSBX421 -00401 05 MSG12-FIRST-WAGE-DATE. DTSBX421 -00402 10 FILLER PIC X(08) DTSBX421 -00403 VALUE 'DETERM: '. DTSBX421 -00404 10 FILLER PIC X(31) DTSBX421 -00405 VALUE 'INVALID FIRST WAGES PAID DATE: '. DTSBX421 -00406 10 MSG12-DATE PIC X(02). DTSBX421 -00407 DTSBX421 -00408 01 T002-REC. DTSBX421 -00409 ++INCLUDE DTSIT002 DTSBX421 -00410 DTSBX421 -00411 01 Y104-REC. DTSBX421 -00412 ++INCLUDE DTSIY104 DTSBX421 -00413 DTSBX421 -00414 01 Y106-REC. DTSBX421 -00415 ++INCLUDE DTSIY106 DTSBX421 -00416 DTSBX421 -00417 01 Y108-REC. DTSBX421 -00418 ++INCLUDE DTSIY108 DTSBX421 -00419 DTSBX421 -00420 01 Y130-REC. DTSBX421 -00421 ++INCLUDE DTSIY130 DTSBX421 -00422 DTSBX421 -00423 01 T003-REC. DTSBX421 -00424 ++INCLUDE DTSIT003 DTSBX421 -00425 DTSBX421 -00426 01 T027-REC. DTSBX421 -00427 ++INCLUDE DTSIT027 DTSBX421 -00428 DTSBX421 -00429 01 W001-REC. DTSBX421 -00430 ++INCLUDE DTSIW001 DTSBX421 -00431 DTSBX421 -00432 * PROFILE DTSBX421 -00433 01 X102-REC. DTSBX421 -00434 ++INCLUDE DTSIX102 DTSBX421 -00435 DTSBX421 -00436 * DETERMINATION DTSBX421 -00437 01 X104-REC. DTSBX421 -00438 ++INCLUDE DTSIX104 DTSBX421 -00439 DTSBX421 -00440 * NAME DTSBX421 -00441 01 X106-REC. DTSBX421 -00442 ++INCLUDE DTSIX106 DTSBX421 -00443 DTSBX421 -00444 * RATE DTSBX421 -00445 01 X108-REC. DTSBX421 -00446 ++INCLUDE DTSIX108 DTSBX421 -00447 DTSBX421 -00448 * ADDRESS DTSBX421 -00449 01 X110-REC. DTSBX421 -00450 ++INCLUDE DTSIX110 DTSBX421 -00451 DTSBX421 -00452 * OPO DTSBX421 -00453 01 X120-REC. DTSBX421 -00454 ++INCLUDE DTSIX120 DTSBX421 -00455 DTSBX421 -00456 * RELATIONSHIP DTSBX421 -00457 01 X130-REC. DTSBX421 -00458 ++INCLUDE DTSIX130 DTSBX421 -00459 DTSBX421 -00460 * INDUSTRY DESCRIPTION DTSBX421 -00461 *01 X132-REC. DTSBX421 -00462 ***INCLUDE DTSIX132 DTSBX421 -00463 DTSBX421 -00464 * REPORT DTSBX421 -00465 01 X140-REC. DTSBX421 -00466 ++INCLUDE DTSIX140 DTSBX421 -00467 DTSBX421 -00468 DTSBX421 -00469 DTSBX421 -00470 * ERRORS DTSBX421 -00471 *01 X907-REC. DTSBX421 -00472 ***INCLUDE DTSIX907 DTSBX421 -00473 DTSBX421 -00474 01 L001-LINK-AREA. DTSBX421 -00475 ++INCLUDE DTSIL001 DTSBX421 -00476 DTSBX421 -00477 01 L003-LINK-AREA. DTSBX421 -00478 ++INCLUDE DTSIL003 DTSBX421 -00479 DTSBX421 -00480 01 L004-LINK-AREA. DTSBX421 -00481 ++INCLUDE DTSIL004 DTSBX421 -00482 DTSBX421 -00483 01 L072-LINK-AREA. DTSBX421 -00484 ++INCLUDE DTSIL072 DTSBX421 -00485 DTSBX421 -00486 01 L052-LINK-AREA. DTSBX421 -00487 ++INCLUDE DTSIL052 DTSBX421 -00488 DTSBX421 -00489 01 L516-LINK-AREA. DTSBX421 -00490 ++INCLUDE DTSIL516 DTSBX421 -00491 DTSBX421 -00492 01 L600-LINK-AREA. DTSBX421 -00493 ++INCLUDE DTSIL600 DTSBX421 -00494 DTSBX421 -00495 01 L910-LINK-AREA. DTSBX421 -00496 ++INCLUDE DTSIL910 DTSBX421 -00497 01 MSKL-REC. DTSBX421 -00498 ++INCLUDE DTSIMSKL DTSBX421 -00499 DTSBX421 -00500 01 MHDR-REC. DTSBX421 -00501 ++INCLUDE DTSIMHDR DTSBX421 -00502 DTSBX421 -00503 01 MPRF-REC. DTSBX421 -00504 ++INCLUDE DTSIMPRF DTSBX421 -00505 DTSBX421 -00506 01 MSOL-REC. DTSBX421 -00507 ++INCLUDE DTSIMSOL DTSBX421 -00508 DTSBX421 -00509 01 MQTR-REC. DTSBX421 -00510 ++INCLUDE DTSIMQTR DTSBX421 -00511 DTSBX421 -00512 01 MOPO-REC. DTSBX421 -00513 ++INCLUDE DTSIMOPO DTSBX421 -00514 DTSBX421 -00515 01 MTAD-REC. DTSBX421 -00516 ++INCLUDE DTSIMTAD DTSBX421 -00517 DTSBX421 -00518 01 MNTE-REC. DTSBX421 -00519 ++INCLUDE DTSIMNTE DTSBX421 -00520 DTSBX421 -00521 01 L921-LINK-AREA. DTSBX421 -00522 ++INCLUDE DTSIL921 DTSBX421 -00523 SKIP3 DTSBX421 -00524 01 ISKL-REC. DTSBX421 -00525 ++INCLUDE DTSIISKL DTSBX421 -00526 SKIP3 DTSBX421 -00527 01 IEIN-REC. DTSBX421 -00528 ++INCLUDE DTSIIEIN DTSBX421 -00529 DTSBX421 -00530 01 L927-LINK-AREA. DTSBX421 -00531 ++INCLUDE DTSIL927 DTSBX421 -00532 DTSBX421 -00533 01 L931-LINK-AREA. DTSBX421 -00534 ++INCLUDE DTSIL931 DTSBX421 -00535 DTSBX421 -00536 01 FSKL-REC. DTSBX421 -00537 ++INCLUDE DTSIFSKL DTSBX421 -00538 DTSBX421 -00539 01 R140-REC. DTSBX421 -00540 ++INCLUDE DTSIR140 DTSBX421 -00541 DTSBX421 -00542 LINKAGE SECTION. DTSBX421 -00543 DTSBX421 -00544 01 LX42-LINK-AREA. DTSBX421 -00545 ++INCLUDE DTSILX42 DTSBX421 -00546 DTSBX421 -00547 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX421 -00548 DTSBX421 -00549 DTSBX421-MAIN. DTSBX421 -00550 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA DTSBX421 -00551 MOVE LX42-ERROR-IND TO W-ERROR-IND. DTSBX421 -00552 DTSBX421 -00553 IF W-ERROR-YES-88 DTSBX421 -00554 DISPLAY 'BX421 LX42 ERROR ' LX42-EMP-NO DTSBX421 -00555 ' ' LX42-ERROR-IND ' ' W-ERROR-IND DTSBX421 -00556 ELSE DTSBX421 -00557 DISPLAY 'BX421 NO ERROR ' W-ERROR-IND DTSBX421 -00558 END-IF. DTSBX421 -00559 DTSBX421 -00560 EVALUATE TRUE DTSBX421 -00561 WHEN LX42-INITIALIZE-88 DTSBX421 -00562 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX421 -00563 DTSBX421 -00564 WHEN LX42-NEW-EMPLOYER-88 DTSBX421 -00565 PERFORM P3000-NEW-EMP THRU P3000-EXIT DTSBX421 -00566 DTSBX421 -00567 WHEN LX42-PROCESS-88 DTSBX421 -00568 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX421 -00569 DTSBX421 -00570 WHEN LX42-TERMINATE-88 DTSBX421 -00571 PERFORM P3000-NEW-EMP THRU P3000-EXIT DTSBX421 -00572 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX421 -00573 DTSBX421 -00574 END-EVALUATE. DTSBX421 -00575 DTSBX421 -00576 IF LX42-PROCESS-88 DTSBX421 -00577 MOVE W-ERROR-IND TO LX42-ERROR-IND DTSBX421 -00578 END-IF. DTSBX421 -00579 DTSBX421 -00580 DTSBX421-MAIN-EXIT. DTSBX421 -00581 GOBACK. DTSBX421 -00582 DTSBX421 -00583 I0000-INITIATE. DTSBX421 -00584 *** SET W-ERROR-NO-88 TO TRUE. DTSBX421 -00585 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX421 -00586 DTSBX421 -00587 MOVE LENGTH OF X102-REC TO W-X102-LENGTH. DTSBX421 -00588 MOVE LENGTH OF X104-REC TO W-X104-LENGTH. DTSBX421 -00589 MOVE LENGTH OF X106-REC TO W-X106-LENGTH. DTSBX421 -00590 MOVE LENGTH OF X108-REC TO W-X108-LENGTH. DTSBX421 -00591 MOVE LENGTH OF X130-REC TO W-X130-LENGTH. DTSBX421 -00592 DTSBX421 -00593 *RW1 FOR VARIABLE REPORT FILE. DTSBX421 -00594 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX421 -00595 MOVE '140' TO R140-REC-TYPE. DTSBX421 -00596 DTSBX421 -00597 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX421 -00598 IF W-FATAL-ERROR-YES-88 DTSBX421 -00599 GO TO I0000-EXIT DTSBX421 -00600 END-IF. DTSBX421 -00601 DTSBX421 -00602 I0000-EXIT. DTSBX421 -00603 EXIT. DTSBX421 -00604 DTSBX421 -00605 I2000-OPEN-FILES. DTSBX421 -00606 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX421 -00607 IF W-FATAL-ERROR-YES-88 DTSBX421 -00608 DISPLAY 'CANNOT OPEN TEMP BTC FILE ' DTSBX421 -00609 TEMP-BTC-STATUS DTSBX421 -00610 GO TO I2000-EXIT DTSBX421 -00611 END-IF. DTSBX421 -00612 DTSBX421 -00613 I2000-EXIT. DTSBX421 -00614 EXIT. DTSBX421 -00615 DTSBX421 -00616 DTSBX421 -00617 P0000-PROCESS. DTSBX421 -00618 *& DTSBX421 -00619 DISPLAY SPACE. DTSBX421 -00620 * DISPLAY 'BX421 P0000 ' W-EMP-NO ' ' LX42-REC-TYPE. DTSBX421 -00621 *& DTSBX421 -00622 EVALUATE TRUE DTSBX421 -00623 WHEN LX42-REC-TYPE-PRF-88 DTSBX421 -00624 PERFORM P1100-PROFILE THRU P1100-EXIT DTSBX421 -00625 DTSBX421 -00626 WHEN LX42-REC-TYPE-DETERM-88 DTSBX421 -00627 PERFORM P1200-DETERM THRU P1200-EXIT DTSBX421 -00628 DTSBX421 -00629 WHEN LX42-REC-TYPE-NAME-88 DTSBX421 -00630 PERFORM P1300-NAME THRU P1300-EXIT DTSBX421 -00631 DTSBX421 -00632 WHEN LX42-REC-TYPE-RATE-88 DTSBX421 -00633 PERFORM P1400-RATE THRU P1400-EXIT DTSBX421 -00634 DTSBX421 -00635 ** WHEN LX42-REC-TYPE-REL-88 DTSBX421 -00636 ** PERFORM P1700-RELATION THRU P1700-EXIT DTSBX421 -00637 DTSBX421 -00638 END-EVALUATE. DTSBX421 -00639 DTSBX421 -00640 P0000-EXIT. DTSBX421 -00641 EXIT. DTSBX421 -00642 DTSBX421 -00643 P1100-PROFILE. DTSBX421 -00644 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 -00645 MOVE LX42-DATA-AREA TO X102-REC. DTSBX421 -00646 *& DTSBX421 -00647 DISPLAY SPACE. DTSBX421 -00648 DISPLAY 'PROFILE ' X102-EMP-NO. DTSBX421 -00649 ** DISPLAY X102-REC. DTSBX421 -00650 DTSBX421 -00651 DTSBX421 -00652 IF W-PREV-REC-NULL-88 DTSBX421 -00653 SET W-PREV-REC-PRF-88 TO TRUE DTSBX421 -00654 ADD +1 TO W-X102-CNT DTSBX421 -00655 PERFORM P1110-EDIT-PROFILE THRU P1110-EXIT DTSBX421 -00656 IF W-ERROR-NO-88 DTSBX421 -00657 PERFORM P1120-SAVE-PROFILE THRU P1120-EXIT DTSBX421 -00658 END-IF DTSBX421 -00659 ELSE DTSBX421 -00660 DISPLAY 'PROFILE RECORD FOUND FOLLOWING ' DTSBX421 -00661 W-PREV-REC-TYPE ' ' W-EMP-NO DTSBX421 -00662 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00663 END-IF. DTSBX421 -00664 DTSBX421 -00665 P1100-EXIT. DTSBX421 -00666 EXIT. DTSBX421 -00667 DTSBX421 -00668 P1110-EDIT-PROFILE. DTSBX421 -00669 PERFORM P1111-EDIT-DATA THRU P1111-EXIT. DTSBX421 -00670 IF W-ERROR-NO-88 DTSBX421 -00671 PERFORM P1112-CHECK-DATABASE THRU P1112-EXIT DTSBX421 -00672 END-IF. DTSBX421 -00673 DTSBX421 -00674 P1110-EXIT. DTSBX421 -00675 EXIT. DTSBX421 -00676 DTSBX421 -00677 P1111-EDIT-DATA. DTSBX421 -00678 IF X102-EMP-FEIN NOT NUMERIC DTSBX421 -00679 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00680 MOVE X102-EMP-FEIN TO MSG1-FEIN DTSBX421 -00681 MOVE MSG1-INVALID-FEIN TO R140-MESSAGE DTSBX421 -00682 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00683 ELSE DTSBX421 -00684 MOVE X102-EMP-FEIN TO W-FEIN DTSBX421 -00685 END-IF. DTSBX421 -00686 DTSBX421 -00687 IF NOT X102-SOURCE-CD-VALID-88 DTSBX421 -00688 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00689 MOVE X102-SOURCE-CD TO MSG2-SOURCE-CD DTSBX421 -00690 MOVE MSG2-SOURCE-CODE TO R140-MESSAGE DTSBX421 -00691 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00692 END-IF. DTSBX421 -00693 DTSBX421 -00694 IF NOT X102-CLASS-CD-VALID-88 DTSBX421 -00695 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00696 MOVE SPACES TO R140-MESSAGE DTSBX421 -00697 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -00698 STRING DTSBX421 -00699 'X102 INVALID EMP CLASS CD ' X102-EMP-CLASS DTSBX421 -00700 DELIMITED BY SIZE DTSBX421 -00701 INTO R140-MESSAGE DTSBX421 -00702 END-STRING DTSBX421 -00703 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -00704 END-IF. DTSBX421 -00705 DTSBX421 -00706 IF NOT X102-STATUS-CD-VALID-88 DTSBX421 -00707 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00708 MOVE SPACES TO R140-MESSAGE DTSBX421 -00709 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -00710 STRING DTSBX421 -00711 'X102 INVALID EMP STATUS CD ' X102-EMP-STATUS DTSBX421 -00712 DELIMITED BY SIZE DTSBX421 -00713 INTO R140-MESSAGE DTSBX421 -00714 END-STRING DTSBX421 -00715 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -00716 END-IF. DTSBX421 -00717 DTSBX421 -00718 IF NOT X102-ACTION-CD-VALID-88 DTSBX421 -00719 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00720 MOVE SPACES TO R140-MESSAGE DTSBX421 -00721 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -00722 STRING DTSBX421 -00723 'X102 INVALID ACTION CD ' X102-ACTION-CD DTSBX421 -00724 DELIMITED BY SIZE DTSBX421 -00725 INTO R140-MESSAGE DTSBX421 -00726 END-STRING DTSBX421 -00727 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -00728 END-IF. DTSBX421 -00729 DTSBX421 -00730 DTSBX421 -00731 P1111-EXIT. DTSBX421 -00732 EXIT. DTSBX421 -00733 DTSBX421 -00734 P1112-CHECK-DATABASE. DTSBX421 -00735 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX421 -00736 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX421 -00737 SET MPRF-PRF-88 TO TRUE. DTSBX421 -00738 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX421 -00739 DTSBX421 -00740 PERFORM S910-READ THRU S910-EXIT. DTSBX421 -00741 IF L910-NO-REC-88 DTSBX421 -00742 NEXT SENTENCE DTSBX421 -00743 ELSE DTSBX421 -00744 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00745 MOVE MSG3-EMP-ON-FILE TO R140-MESSAGE DTSBX421 -00746 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00747 GO TO P1112-EXIT DTSBX421 -00748 END-IF. DTSBX421 -00749 DTSBX421 -00750 ** MOVE ZERO TO W-FEIN-EMP-NO. DTSBX421 -00751 SET W-DUP-FEIN-NO-88 TO TRUE. DTSBX421 -00752 DTSBX421 -00753 MOVE LOW-VALUE TO IEIN-KEY-AREA DTSBX421 -00754 SET IEIN-EIN-88 TO TRUE DTSBX421 -00755 MOVE W-FEIN TO IEIN-FEIN DTSBX421 -00756 MOVE +0 TO IEIN-EMP-NO DTSBX421 -00757 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBX421 -00758 PERFORM S921-START-BROWSE THRU S921-EXIT DTSBX421 -00759 MOVE ISKL-REC TO IEIN-REC DTSBX421 -00760 PERFORM DTSBX421 -00761 UNTIL L921-NO-REC-88 DTSBX421 -00762 OR W-DUP-FEIN-YES-88 DTSBX421 -00763 IF IEIN-FEIN = W-FEIN DTSBX421 -00764 PERFORM P1112A-FIND-MPRF THRU P1112A-EXIT DTSBX421 -00765 PERFORM S921-READ-NEXT THRU S921-EXIT DTSBX421 -00766 MOVE ISKL-REC TO IEIN-REC DTSBX421 -00767 ** IF W-FEIN-EMP-NO = ZERO DTSBX421 -00768 * PERFORM S921-READ-NEXT THRU S921-EXIT DTSBX421 -00769 * MOVE ISKL-REC TO IEIN-REC DTSBX421 -00770 ** END-IF DTSBX421 -00771 ELSE DTSBX421 -00772 SET L921-NO-REC-88 TO TRUE DTSBX421 -00773 END-IF DTSBX421 -00774 END-PERFORM. DTSBX421 -00775 DTSBX421 -00776 * IF W-DUP-FEIN-YES-88 DTSBX421 -00777 * DISPLAY 'BX421 DUP FEIN ' W-EMP-NO ' ' W-FEIN DTSBX421 -00778 * ELSE DTSBX421 -00779 * DISPLAY 'BX421 FEIN OK ' W-EMP-NO ' ' W-FEIN DTSBX421 -00780 * END-IF. DTSBX421 -00781 P1112-EXIT. DTSBX421 -00782 EXIT. DTSBX421 +00309 05 W-SLASH-DATE PIC X(10). DTSBX421 +00310 05 FILLER REDEFINES W-SLASH-DATE. DTSBX421 +00311 10 W-SLASH-DT-MM PIC X(02). DTSBX421 +00312 10 FILLER PIC X(01). DTSBX421 +00313 10 W-SLASH-DT-DD PIC X(02). DTSBX421 +00314 10 FILLER PIC X(01). DTSBX421 +00315 10 W-SLASH-DT-CCYY PIC X(04). DTSBX421 +00316 DTSBX421 +00317 05 W-SLASH-QTR PIC X(06). DTSBX421 +00318 05 FILLER REDEFINES W-SLASH-QTR. DTSBX421 +00319 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX421 +00320 10 FILLER PIC X(01). DTSBX421 +00321 10 W-SLASH-QTR-Q PIC X(01). DTSBX421 +00322 DTSBX421 +00323 05 WRK-PHONE PIC X(15) VALUE SPACES. DTSBX421 +00324 05 FILLER REDEFINES WRK-PHONE. DTSBX421 +00325 10 WRK-AREA-CD PIC X(03). DTSBX421 +00326 10 WRK-PREFIX PIC X(03). DTSBX421 +00327 10 WRK-SUFFIX PIC X(04). DTSBX421 +00328 10 WRK-EXT PIC X(05). DTSBX421 +00329 05 WRK-EXT-HYPHEN PIC X(01) VALUE SPACES. DTSBX421 +00330 05 WRK-PHONE-TEXT1 PIC X(72) VALUE SPACES. DTSBX421 +00331 05 WRK-PHONE-TEXT2 PIC X(72) VALUE SPACES. DTSBX421 +00332 DTSBX421 +00333 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00334 05 W-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00335 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00336 05 WRK-EMP-WAGE-CNT PIC 9(07) VALUE 0. DTSBX421 +00337 * SAVED KEY-AREAS. CL*15 +00338 05 X102-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00339 05 X104-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00340 05 X106-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00341 05 X108-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00342 05 X110-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00343 05 X120-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00344 * PROFILE DTSBX421 +00345 05 W-X102-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00346 05 W-X102-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00347 05 W-X102-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00348 05 W-X102-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00349 05 W-X102-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00350 * DETERMINATION DTSBX421 +00351 05 W-X104-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00352 05 W-X104-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00353 05 W-X104-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00354 05 W-X104-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00355 05 W-X104-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00356 * NAME DTSBX421 +00357 05 W-X106-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00358 05 W-X106-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00359 05 W-X106-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00360 05 W-X106-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00361 05 W-X106-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00362 * RATE DTSBX421 +00363 05 W-X108-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00364 05 W-X108-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00365 05 W-X108-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00366 05 W-X108-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00367 05 W-X108-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00368 * ADDRESS DTSBX421 +00369 05 W-X110-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00370 05 W-X110-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00371 05 W-X110-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00372 05 W-X110-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00373 05 W-X110-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00374 * OPO DTSBX421 +00375 05 W-X120-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00376 05 W-X120-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00377 05 W-X120-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00378 05 W-X120-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00379 05 W-X120-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00380 * RELATIONSHIP DTSBX421 +00381 05 W-X130-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00382 * INDUSTRY DESCRIPTION DTSBX421 +00383 05 W-X132-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00384 * REPORT DTSBX421 +00385 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00386 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00387 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00388 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00389 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00390 DTSBX421 +00391 05 W-T002-PRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00392 05 W-T002-DETERM-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00393 05 W-T002-NAME-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00394 05 W-T002-RATE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00395 05 W-T002-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00396 05 W-T002-OPO-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00397 05 W-T002-REL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00398 05 W-T002-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00399 DTSBX421 +00400 05 W-T003-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00401 DTSBX421 +00402 05 TOT-DUTAS-ADD-CNT PIC S9(07) COMP-3 VALUE +0. CL*41 +00403 05 TOT-DUTAS-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*41 +00404 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00405 05 W-X140-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00406 DTSBX421 +00407 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX421 +00408 05 W-X102-LENGTH PIC S9(04) COMP. DTSBX421 +00409 05 W-X104-LENGTH PIC S9(04) COMP. DTSBX421 +00410 05 W-X106-LENGTH PIC S9(04) COMP. DTSBX421 +00411 05 W-X108-LENGTH PIC S9(04) COMP. DTSBX421 +00412 05 W-X110-LENGTH PIC S9(04) COMP. DTSBX421 +00413 05 W-X120-LENGTH PIC S9(04) COMP. DTSBX421 +00414 05 W-X130-LENGTH PIC S9(04) COMP. DTSBX421 +00415 05 W-X132-LENGTH PIC S9(04) COMP. DTSBX421 +00416 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX421 +00417 05 WS-X140-RED-CNT PIC 9(5) VALUE 0. CL106 +00418 05 WS-X140-ERR-CNT PIC 9(5) VALUE 0. CL106 +00419 05 WS-X140-PEN-CNT PIC 9(5) VALUE 0. CL107 +00420 DTSBX421 +00421 05 W-AMT-DISP1 PIC ----------9.99. DTSBX421 +00422 05 W-AMT-DISP2 PIC ----------9.99. DTSBX421 +00423 *RW1 DTSBX421 +00424 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 +00425 05 DISPLAY-CNT PIC Z(06)9. DTSBX421 +00426 DTSBX421 +00427 01 MESSAGE-AREA. DTSBX421 +00428 05 WRK-MESSAGE PIC X(80). DTSBX421 +00429 05 MSG1-INVALID-FEIN. DTSBX421 +00430 10 FILLER PIC X(08) DTSBX421 +00431 VALUE 'X102-:'. CL*20 +00432 10 FILLER PIC X(02) DTSBX421 +00433 VALUE SPACES. DTSBX421 +00434 10 FILLER PIC X(18) DTSBX421 +00435 VALUE 'NON-NUMERIC FEIN: '. DTSBX421 +00436 10 MSG1-FEIN PIC X(09). DTSBX421 +00437 05 MSG11-INVALID-FEIN. CL138 +00438 10 FILLER PIC X(08) CL138 +00439 VALUE 'X102-:'. CL138 +00440 10 FILLER PIC X(02) CL138 +00441 VALUE SPACES. CL138 +00442 10 FILLER PIC X(18) CL138 +00443 VALUE 'INVAL FEIN PREFX: '. CL138 +00444 10 MSG11-FEIN PIC X(09). CL138 +00445 05 MSG2-SOURCE-CODE. DTSBX421 +00446 10 FILLER PIC X(08) DTSBX421 +00447 VALUE 'X102-:'. CL*20 +00448 10 FILLER PIC X(27) DTSBX421 +00449 VALUE 'INVALID SOURCE CODE: '. DTSBX421 +00450 10 MSG2-SOURCE-CD PIC X(02). DTSBX421 +00451 05 MSG3-EMP-ON-FILE. DTSBX421 +00452 10 FILLER PIC X(08) DTSBX421 +00453 VALUE 'X102-:'. CL*20 +00454 10 FILLER PIC X(29) DTSBX421 +00455 VALUE 'EMPLOYER ACCT ALREADY ON FILE'. DTSBX421 +00456 05 MSG4-DUP-EMP. DTSBX421 +00457 10 FILLER PIC X(14) DTSBX421 +00458 VALUE 'X102-:'. CL*20 +00459 10 FILLER PIC X(22) DTSBX421 +00460 VALUE 'FEIN ALREADY ON FILE: '. DTSBX421 +00461 10 MSG4-FEIN PIC X(09). DTSBX421 +00462 05 MSG5-INVALID-LIAB-CD. DTSBX421 +00463 10 FILLER PIC X(08) DTSBX421 +00464 VALUE 'X104-: '. CL*20 +00465 10 FILLER PIC X(24) DTSBX421 +00466 VALUE 'INVALID LIABILITY CODE: '. DTSBX421 +00467 10 MSG5-LIAB-CD PIC X(02). DTSBX421 +00468 05 MSG6-INVALID-ELIG-CD. DTSBX421 +00469 10 FILLER PIC X(08) DTSBX421 +00470 VALUE 'X104-: '. CL*20 +00471 10 FILLER PIC X(26) DTSBX421 +00472 VALUE 'INVALID ELIGIBILITY CODE: '. DTSBX421 +00473 10 MSG6-ELIG-CD PIC X(02). DTSBX421 +00474 05 MSG7-INVALID-ORG-TYPE. DTSBX421 +00475 10 FILLER PIC X(08) DTSBX421 +00476 VALUE 'X104: '. CL*20 +00477 10 FILLER PIC X(27) DTSBX421 +00478 VALUE 'INVALID ORGANIZATION TYPE: '. DTSBX421 +00479 10 MSG7-ORG-TYPE PIC X(03). DTSBX421 +00480 05 MSG8-INVALID-INCORP-DATE. DTSBX421 +00481 10 FILLER PIC X(08) DTSBX421 +00482 VALUE 'X104: '. CL*20 +00483 10 FILLER PIC X(28) DTSBX421 +00484 VALUE 'INVALID INCORPORATION DATE: '. DTSBX421 +00485 10 MSG8-INCORP-DATE PIC X(10). DTSBX421 +00486 05 MSG9-INVALID-FILING-SCHED. DTSBX421 +00487 10 FILLER PIC X(08) DTSBX421 +00488 VALUE 'X104: '. CL*20 +00489 10 FILLER PIC X(25) DTSBX421 +00490 VALUE 'INVALID FILING SCHEDULE: '. DTSBX421 +00491 10 MSG9-ORG-TYPE PIC X(02). DTSBX421 +00492 10 FILLER PIC X(02) DTSBX421 +00493 VALUE SPACES. DTSBX421 +00494 10 MSG9-FILING-SCHED PIC X(01). DTSBX421 +00495 05 MSG10-INCONSISTENT-LIAB-CD. DTSBX421 +00496 10 FILLER PIC X(08) DTSBX421 +00497 VALUE 'X104-: '. CL*20 +00498 10 FILLER PIC X(34) DTSBX421 +00499 VALUE 'INCONSISTENT ELIG AND LIAB CODES: '. DTSBX421 +00500 10 MSG10-ELIG-CD PIC X(02). DTSBX421 +00501 10 FILLER PIC X(02) DTSBX421 +00502 VALUE SPACES. DTSBX421 +00503 10 MSG10-LIAB-CD PIC X(02). DTSBX421 +00504 05 MSG11-WAGES-PAID-QTR. DTSBX421 +00505 10 FILLER PIC X(08) DTSBX421 +00506 VALUE 'X104-: '. CL*20 +00507 10 FILLER PIC X(24) DTSBX421 +00508 VALUE 'INVALID WAGES PAID QTR: '. DTSBX421 +00509 10 MSG11-QTR PIC X(02). DTSBX421 +00510 05 MSG12-FIRST-WAGE-DATE. DTSBX421 +00511 10 FILLER PIC X(08) DTSBX421 +00512 VALUE 'X104-: '. CL*20 +00513 10 FILLER PIC X(31) DTSBX421 +00514 VALUE 'INVALID FIRST WAGES PAID DATE: '. DTSBX421 +00515 10 MSG12-DATE PIC X(02). DTSBX421 +00516 01 HEADER-1. CL*87 +00517 05 FILLER PIC X(01) VALUE SPACES. CL*87 +00518 05 FILLER PIC X(49) VALUE 'X421R'. CL113 +00519 05 FILLER PIC X(60) VALUE CL*87 +00520 'DISTRICT OF COLUMBIA'. CL*87 +00521 05 FILLER PIC X(06) VALUE 'DATE:'. CL*87 +00522 05 HDR1-DATE. CL122 +00523 10 W-MM PIC X(02). CL122 +00524 10 FILLER PIC X(01) VALUE '/'. CL122 +00525 10 W-DD PIC X(02). CL122 +00526 10 FILLER PIC X(01) VALUE '/'. CL122 +00527 10 W-YY PIC X(02). CL122 +00528 CL122 +00529 01 HEADER-2. CL*87 +00530 05 FILLER PIC X(54) VALUE SPACES. CL*87 +00531 05 FILLER PIC X(56) VALUE CL*87 +00532 'TAX DIVISION'. CL*87 +00533 * 05 FILLER PIC X(06) VALUE 'TIME:'. CL113 +00534 * 05 HDR2-LRCM-SYS-TIME PIC X(08). CL113 +00535 01 HEADER-3. CL*87 +00536 05 FILLER PIC X(01) VALUE SPACES. CL*87 +00537 05 FILLER PIC X(38) VALUE CL*87 +00538 'ROUTE TO: TAX STATUS STAFF'. CL*93 +00539 05 HDR3-LITERAL PIC X(43) VALUE CL*87 +00540 ' ESSP DAILY REGISTRATIONS TO DUTAS '. CL*93 +00541 05 FILLER PIC X(28) VALUE SPACES. CL*87 +00542 * 05 FILLER PIC X(06) VALUE 'PAGE:'. CL113 +00543 * 05 HDR3-PAGE PIC ZZ,ZZ9. CL113 +00544 CL*87 +00545 01 HEADER-31. CL*87 +00546 05 FILLER PIC X(01) VALUE SPACES. CL*87 +00547 05 FILLER PIC X(38) VALUE CL*87 +00548 'ROUTE TO: TAX ACCOUNTING STAFF'. CL*87 +00549 05 HDR3-LITERAL PIC X(43) VALUE CL*87 +00550 ' ESSP DAILY RPTS-PAYMTS-WAGES IN ERROR '. CL*87 +00551 05 FILLER PIC X(28) VALUE SPACES. CL*87 +00552 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*87 +00553 05 HDR31-PAGE PIC ZZ,ZZ9. CL*87 +00554 CL*87 +00555 01 HEADER-4. CL*87 +00556 05 FILLER PIC X(01) VALUE SPACES. CL*87 +00557 05 FILLER PIC X(132) VALUE SPACES. CL*87 +00558 01 HEADER-42. CL*87 +00559 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00560 05 FILLER PIC X(34) VALUE CL*87 +00561 ' '. CL*87 +00562 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00563 05 FILLER PIC X(25) VALUE CL*87 +00564 ' '. CL*87 +00565 05 FILLER PIC X(03) VALUE SPACES. CL*87 +00566 05 FILLER PIC X(43) VALUE CL*87 +00567 ' ESSP-CALC TPA/EMPL DIFF'. CL*87 +00568 05 FILLER PIC X(30) VALUE CL*87 +00569 ' EMPLOYEES '. CL*87 +00570 01 HEADER-43. CL113 +00571 05 FILLER PIC X(02) VALUE SPACES. CL113 +00572 05 FILLER PIC X(36) VALUE CL116 +00573 '--------X102--------+---------------'. CL117 +00574 05 FILLER PIC X(26) VALUE CL117 +00575 'X104----------------------'. CL117 +00576 05 FILLER PIC X(38) VALUE CL116 +00577 '+-------X106----------+----X108-------'. CL116 +00578 05 HDR5-NAME PIC X(31) VALUE CL116 +00579 '+-X421 REGISTRATION STATUS-+'. CL116 +00580 01 HEADER-5. CL*87 +00581 05 FILLER PIC X(02) VALUE SPACES. CL*98 +00582 05 FILLER PIC X(35) VALUE CL*98 +00583 'EMP NO, FEIN, CLAS,ORG,LIAB,'. CL160 +00584 05 FILLER PIC X(26) VALUE CL105 +00585 'ELIG,ANN,FILE, 1ST PAID, '. CL160 +00586 05 FILLER PIC X(01) VALUE SPACES. CL104 +00587 05 FILLER PIC X(36) VALUE CL107 +00588 'PRIMARY NAME, RATE, YEAR, '. CL160 +00589 05 FILLER PIC X(02) VALUE SPACES. CL105 +00590 05 HDR5-NAME PIC X(28) VALUE CL*87 +00591 '------MESSAGES------------'. CL*99 +00592 01 HEADER-6. CL*87 +00593 05 FILLER PIC X(01) VALUE SPACES. CL*87 +00594 05 FILLER PIC X(132) VALUE SPACES. CL*87 +00595 01 DETAIL-LINE-1. CL*87 +00596 15 FILLER PIC X(02) VALUE SPACES. CL*87 +00597 15 X421-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*87 +00598 15 FILLER PIC X(01) VALUE ','. CL158 +00599 15 FILLER PIC X(01) VALUE SPACES. CL158 +00600 15 X421-FEIN PIC 9(09) VALUE ZEROS. CL*87 +00601 15 FILLER PIC X(01) VALUE ','. CL158 +00602 15 FILLER PIC X(01) VALUE SPACES. CL158 +00603 15 X421-CLASS PIC X(01). CL*87 +00604 15 FILLER PIC X(01) VALUE ','. CL158 +00605 15 FILLER PIC X(03) VALUE SPACES. CL158 +00606 15 X421-ORG-TYPE PIC X(04). CL*94 +00607 15 FILLER PIC X(01) VALUE ','. CL158 +00608 15 X421-LIAB-CD PIC X(02). CL*89 +00609 15 FILLER PIC X(01) VALUE ','. CL158 +00610 15 FILLER PIC X(02) VALUE SPACES. CL158 +00611 15 X421-ELIG-CD PIC X(03). CL*89 +00612 15 FILLER PIC X(01) VALUE ','. CL158 +00613 15 FILLER PIC X(01) VALUE SPACES. CL158 +00614 15 X421-HHOLD PIC X(01). CL101 +00615 15 FILLER PIC X(01) VALUE ','. CL158 +00616 15 FILLER PIC X(03) VALUE SPACES. CL158 +00617 15 X421-FILING PIC X(03). CL*89 +00618 15 FILLER PIC X(01) VALUE ','. CL158 +00619 15 FILLER PIC X(01) VALUE SPACES. CL158 +00620 15 X421-PAID PIC X(10). CL102 +00621 15 FILLER PIC X(01) VALUE ','. CL158 +00622 15 FILLER PIC X(01) VALUE SPACES. CL158 +00623 15 X421-NAME PIC X(20). CL*89 +00624 15 FILLER PIC X(01) VALUE ','. CL158 +00625 15 FILLER PIC X(01) VALUE SPACES. CL158 +00626 15 X421-RATE PIC 9.9BBB. CL104 +00627 15 FILLER PIC X(01) VALUE ','. CL158 +00628 15 FILLER PIC X(01) VALUE SPACES. CL158 +00629 15 X421-RATYR PIC X(06). CL104 +00630 15 FILLER PIC X(01) VALUE ','. CL158 +00631 15 FILLER PIC X(01) VALUE SPACES. CL158 +00632 15 X421-MESSAGE PIC X(30). CL100 +00633 CL*89 +00634 01 DETAIL-PEND-1. CL*87 +00635 15 FILLER PIC X(02) VALUE SPACES. CL*87 +00636 15 P421-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*87 +00637 15 FILLER PIC X(02) VALUE SPACES. CL*87 +00638 15 P421-NAME-CHECK PIC X(04) VALUE SPACES. CL*87 +00639 15 FILLER PIC X(02) VALUE SPACES. CL*87 +00640 15 P421-QTR PIC X(06). CL*87 +00641 15 FILLER PIC X(02) VALUE SPACES. CL*87 +00642 15 P421-RCVD-DATE PIC X(10). CL*87 +00643 15 FILLER PIC X(01) VALUE SPACES. CL*87 +00644 15 P421-TOT-WAGE PIC --------9.99. CL*87 +00645 15 FILLER PIC X(01) VALUE SPACES. CL*87 +00646 15 P421-EXC-WAGE PIC --------9.99. CL*87 +00647 15 FILLER PIC X(01) VALUE SPACES. CL*87 +00648 15 P421-TAX-WAGE PIC --------9.99. CL*87 +00649 15 FILLER PIC X(01) VALUE SPACES. CL*87 +00650 15 FILLER PIC X(01) VALUE SPACES. CL*87 +00651 15 P421-X140-REMIT PIC --------9.99. CL*87 +00652 15 FILLER PIC X(01) VALUE SPACES. CL*87 +00653 15 P421-X145-REMIT PIC --------9.99. CL*87 +00654 15 FILLER PIC X(02) VALUE SPACES. CL*87 +00655 15 P421-MESSAGE PIC X(30). CL*87 +00656 CL*87 +00657 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*87 +00658 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL*87 +00659 CL*87 +00660 01 FOOTING-LINE-3. CL*87 +00661 05 FILLER PIC X(25) VALUE SPACES. CL*87 +00662 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL*87 +00663 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00664 05 FILLER PIC X(45) VALUE CL*87 +00665 'TOTAL PAYMENT RELEASED TO DUTAS '. CL*87 +00666 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00667 01 FOOTING-LINE-4. CL*87 +00668 05 FILLER PIC X(25) VALUE SPACES. CL*87 +00669 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL*87 +00670 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00671 05 FILLER PIC X(34) VALUE CL*87 +00672 ' # OF PAYMENTS HAD ERRORS '. CL*87 +00673 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00674 CL*87 +00675 01 FOOTING-LINE-5. CL*87 +00676 05 FILLER PIC X(25) VALUE SPACES. CL*87 +00677 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL*87 +00678 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00679 05 FILLER PIC X(40) VALUE CL*87 +00680 ' # OF ZERO PAYMENTS DISCARDED '. CL*87 +00681 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00682 01 FOOTING-LINE-51. CL107 +00683 05 FILLER PIC X(25) VALUE SPACES. CL107 +00684 05 WS-X102-PEN-CNT PIC ZZ,ZZ9. CL107 +00685 05 FILLER PIC X(02) VALUE SPACES. CL107 +00686 05 FILLER PIC X(40) VALUE CL107 +00687 '# OF REGISTRATIONS RECEIVED FROM ESSP'. CL110 +00688 05 FILLER PIC X(32) VALUE SPACES. CL107 +00689 CL107 +00690 01 FOOTING-LINE-6. CL*87 +00691 05 FILLER PIC X(25) VALUE SPACES. CL*87 +00692 05 WS-X102-RED-CNT PIC ZZ,ZZ9. CL106 +00693 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00694 05 FILLER PIC X(45) VALUE CL*87 +00695 '# OF REGISTRATIONS DUTAS PASSED '. CL110 +00696 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00697 01 FOOTING-LINE-7. CL*87 +00698 05 FILLER PIC X(25) VALUE SPACES. CL*87 +00699 05 WS-X102-ERR-CNT PIC ZZ,ZZ9. CL106 +00700 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00701 05 FILLER PIC X(40) VALUE CL108 +00702 '# OF REGISTRATIONS DUTAS FAILED'. CL108 +00703 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00704 01 FOOTING-LINE-8. CL*87 +00705 05 FILLER PIC X(25) VALUE SPACES. CL*87 +00706 05 W-X140-PEN-CNT PIC ZZ,ZZ9. CL108 +00707 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00708 05 FILLER PIC X(40) VALUE CL*87 +00709 ' # OF REPORTS DUTAS CANNOT PROCESS '. CL*87 +00710 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00711 CL*87 +00712 01 FOOTING-LINE-9. CL*87 +00713 05 FILLER PIC X(24) VALUE SPACES. CL*87 +00714 05 WS-X144-RED-CNT PIC ZZZ,ZZ9. CL*87 +00715 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00716 05 FILLER PIC X(45) VALUE CL*87 +00717 'TOTAL WAGES RELEASED TO DUTAS '. CL*87 +00718 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00719 01 FOOTING-LINE-10. CL*87 +00720 05 FILLER PIC X(24) VALUE SPACES. CL*87 +00721 05 WS-X144-ERR-CNT PIC ZZZ,ZZ9. CL*87 +00722 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00723 05 FILLER PIC X(34) VALUE CL*87 +00724 ' # OF WAGES HAD ERRORS '. CL*87 +00725 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00726 CL*87 +00727 01 FOOTING-LINE-11. CL*87 +00728 05 FILLER PIC X(24) VALUE SPACES. CL*87 +00729 05 WS-X144-PEN-CNT PIC ZZZ,ZZ9. CL*87 +00730 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00731 05 FILLER PIC X(40) VALUE CL*87 +00732 ' # OF WAGES DUTAS CANNOT PROCESS '. CL*87 +00733 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00734 01 FOOTING-LINE-12. CL*87 +00735 05 FILLER PIC X(19) VALUE SPACES. CL*87 +00736 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL*87 +00737 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00738 05 FILLER PIC X(45) VALUE CL*87 +00739 ' TOTAL PAYMENTS APPLIED TO DUTAS'. CL*87 +00740 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00741 CL*87 +00742 01 FOOTING-LINE-15. CL*87 +00743 05 FILLER PIC X(19) VALUE SPACES. CL*87 +00744 05 WS-TOT-CREDIT PIC $$$$$$$$9.99. CL*87 +00745 05 FILLER PIC X(02) VALUE SPACES. CL*87 +00746 05 FILLER PIC X(45) VALUE CL*87 +00747 ' TOTAL CREDITS APPLIED TO DUTAS'. CL*87 +00748 05 FILLER PIC X(32) VALUE SPACES. CL*87 +00749 01 FOOTING-LINE-13. CL*87 +00750 05 FILLER PIC X(25) VALUE SPACES. CL*87 +00751 05 FILLER PIC X(67) VALUE CL*87 +00752 '*** END ESSP/DUTAS REGISTRATION PROCESSING ***'. CL105 +00753 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL*87 +00754 CL*87 +00755 DTSBX421 +00756 01 T002-REC. DTSBX421 +00757 ++INCLUDE DTSIT002 DTSBX421 +00758 DTSBX421 +00759 01 Y104-REC. DTSBX421 +00760 ++INCLUDE DTSIY104 DTSBX421 +00761 DTSBX421 +00762 01 Y106-REC. DTSBX421 +00763 ++INCLUDE DTSIY106 DTSBX421 +00764 DTSBX421 +00765 01 Y108-REC. DTSBX421 +00766 ++INCLUDE DTSIY108 DTSBX421 +00767 DTSBX421 +00768 01 Y130-REC. DTSBX421 +00769 ++INCLUDE DTSIY130 DTSBX421 +00770 DTSBX421 +00771 01 T003-REC. DTSBX421 +00772 ++INCLUDE DTSIT003 DTSBX421 +00773 DTSBX421 +00774 01 T027-REC. DTSBX421 +00775 ++INCLUDE DTSIT027 DTSBX421 +00776 DTSBX421 +00777 01 W001-REC. DTSBX421 +00778 ++INCLUDE DTSIW001 DTSBX421 +00779 DTSBX421 +00780 * PROFILE DTSBX421 +00781 01 X102-REC. DTSBX421 +00782 ++INCLUDE DTSIX102 DTSBX421 00783 DTSBX421 -00784 P1112A-FIND-MPRF. DTSBX421 -00785 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX421 -00786 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBX421 -00787 SET MSKL-PRF-88 TO TRUE. DTSBX421 -00788 DTSBX421 -00789 PERFORM S910-READ THRU S910-EXIT. DTSBX421 -00790 IF L910-NO-REC-88 DTSBX421 -00791 NEXT SENTENCE DTSBX421 -00792 ELSE DTSBX421 -00793 MOVE MSKL-REC TO MPRF-REC DTSBX421 -00794 ** MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DTSBX421 -00795 IF MPRF-STATUS-ACT-88 DTSBX421 -00796 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00797 SET W-DUP-FEIN-YES-88 TO TRUE DTSBX421 -00798 MOVE W-FEIN TO MSG4-FEIN DTSBX421 -00799 MOVE MSG4-DUP-EMP TO R140-MESSAGE DTSBX421 -00800 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00801 END-IF DTSBX421 -00802 END-IF. DTSBX421 +00784 * DETERMINATION DTSBX421 +00785 01 X104-REC. DTSBX421 +00786 ++INCLUDE DTSIX104 DTSBX421 +00787 DTSBX421 +00788 * NAME DTSBX421 +00789 01 X106-REC. DTSBX421 +00790 ++INCLUDE DTSIX106 DTSBX421 +00791 DTSBX421 +00792 * RATE DTSBX421 +00793 01 X108-REC. DTSBX421 +00794 ++INCLUDE DTSIX108 DTSBX421 +00795 DTSBX421 +00796 * ADDRESS DTSBX421 +00797 01 X110-REC. DTSBX421 +00798 ++INCLUDE DTSIX110 DTSBX421 +00799 DTSBX421 +00800 * OPO DTSBX421 +00801 01 X120-REC. DTSBX421 +00802 ++INCLUDE DTSIX120 DTSBX421 00803 DTSBX421 -00804 P1112A-EXIT. DTSBX421 -00805 EXIT. DTSBX421 -00806 DTSBX421 -00807 P1120-SAVE-PROFILE. DTSBX421 -00808 MOVE X102-EMP-FEIN TO W-FEIN. DTSBX421 -00809 MOVE '17' TO W-SOURCE-CD. DTSBX421 -00810 DTSBX421 -00811 P1120-EXIT. DTSBX421 -00812 EXIT. DTSBX421 -00813 DTSBX421 -00814 P1200-DETERM. DTSBX421 -00815 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 -00816 MOVE LX42-DATA-AREA TO X104-REC. DTSBX421 +00804 * RELATIONSHIP DTSBX421 +00805 01 X130-REC. DTSBX421 +00806 ++INCLUDE DTSIX130 DTSBX421 +00807 DTSBX421 +00808 * INDUSTRY DESCRIPTION DTSBX421 +00809 *01 X132-REC. DTSBX421 +00810 ***INCLUDE DTSIX132 DTSBX421 +00811 DTSBX421 +00812 * REPORT DTSBX421 +00813 01 X140-REC. DTSBX421 +00814 ++INCLUDE DTSIX140 DTSBX421 +00815 DTSBX421 +00816 DTSBX421 00817 DTSBX421 -00818 DISPLAY 'DETERMINATION ' X104-EMP-NO. DTSBX421 -00819 * DISPLAY X104-REC. DTSBX421 -00820 DTSBX421 +00818 * ERRORS DTSBX421 +00819 *01 X907-REC. DTSBX421 +00820 ***INCLUDE DTSIX907 DTSBX421 00821 DTSBX421 -00822 IF W-PREV-REC-PRF-88 DTSBX421 -00823 OR W-PREV-REC-NAME-88 DTSBX421 -00824 SET W-PREV-REC-DETERM-88 TO TRUE DTSBX421 -00825 ADD +1 TO W-X104-CNT DTSBX421 -00826 PERFORM P1210-EDIT-DETERM THRU P1210-EXIT DTSBX421 -00827 IF W-ERROR-NO-88 DTSBX421 -00828 PERFORM P1230-RATE-YEARS THRU P1230-EXIT DTSBX421 -00829 END-IF DTSBX421 -00830 ELSE DTSBX421 -00831 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00832 MOVE SPACES TO R140-MESSAGE DTSBX421 -00833 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -00834 STRING DTSBX421 -00835 'X104 DUP REC ' W-PREV-REC-TYPE ' ' W-EMP-NO DTSBX421 -00836 DELIMITED BY SIZE DTSBX421 -00837 INTO R140-MESSAGE DTSBX421 -00838 END-STRING DTSBX421 -00839 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -00840 END-IF. DTSBX421 -00841 DTSBX421 +00822 01 L001-LINK-AREA. DTSBX421 +00823 ++INCLUDE DTSIL001 DTSBX421 +00824 DTSBX421 +00825 01 L003-LINK-AREA. DTSBX421 +00826 ++INCLUDE DTSIL003 DTSBX421 +00827 DTSBX421 +00828 01 L004-LINK-AREA. DTSBX421 +00829 ++INCLUDE DTSIL004 DTSBX421 +00830 DTSBX421 +00831 01 L009-LINK-AREA. CL*74 +00832 ++INCLUDE DTSIL009 CL*74 +00833 CL*74 +00834 01 L072-LINK-AREA. DTSBX421 +00835 ++INCLUDE DTSIL072 DTSBX421 +00836 DTSBX421 +00837 01 L052-LINK-AREA. DTSBX421 +00838 ++INCLUDE DTSIL052 DTSBX421 +00839 DTSBX421 +00840 01 L516-LINK-AREA. DTSBX421 +00841 ++INCLUDE DTSIL516 DTSBX421 00842 DTSBX421 -00843 P1200-EXIT. DTSBX421 -00844 EXIT. DTSBX421 +00843 01 L600-LINK-AREA. DTSBX421 +00844 ++INCLUDE DTSIL600 DTSBX421 00845 DTSBX421 -00846 P1210-EDIT-DETERM. DTSBX421 -00847 IF NOT X104-LIAB-VALID-88 DTSBX421 -00848 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00849 MOVE X104-LIAB-CD TO MSG5-LIAB-CD DTSBX421 -00850 MOVE MSG5-INVALID-LIAB-CD TO R140-MESSAGE DTSBX421 -00851 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00852 END-IF. DTSBX421 +00846 01 L910-LINK-AREA. DTSBX421 +00847 ++INCLUDE DTSIL910 DTSBX421 +00848 01 MSKL-REC. DTSBX421 +00849 ++INCLUDE DTSIMSKL DTSBX421 +00850 DTSBX421 +00851 01 MHDR-REC. DTSBX421 +00852 ++INCLUDE DTSIMHDR DTSBX421 00853 DTSBX421 -00854 IF NOT X104-ELIG-VALID-88 DTSBX421 -00855 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00856 MOVE X104-ELIG-CD TO MSG6-ELIG-CD DTSBX421 -00857 MOVE MSG6-INVALID-ELIG-CD TO R140-MESSAGE DTSBX421 -00858 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00859 END-IF. DTSBX421 -00860 DTSBX421 -00861 IF X104-NAICS-CD NOT NUMERIC DTSBX421 -00862 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 -00863 * MOVE SPACES TO R140-MESSAGE DTSBX421 -00864 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -00865 * STRING DTSBX421 -00866 * 'DETERM NON-NUMERIC NAICS ' X104-NAICS-CD DTSBX421 -00867 * DELIMITED BY SIZE DTSBX421 -00868 * INTO R140-MESSAGE DTSBX421 -00869 * END-STRING DTSBX421 -00870 * DISPLAY R140-MESSAGE DTSBX421 -00871 *** PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -00872 MOVE 999999 TO X104-NAICS-CD DTSBX421 -00873 END-IF. DTSBX421 -00874 DTSBX421 -00875 IF NOT X104-ORG-TYPE-VALID-88 DTSBX421 -00876 IF X104-LIAB-NOT-LIABLE-88 DTSBX421 -00877 MOVE 'UNK' TO X104-ORG-TYPE DTSBX421 -00878 ELSE DTSBX421 -00879 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00880 MOVE X104-ORG-TYPE TO MSG7-ORG-TYPE DTSBX421 -00881 MOVE MSG7-INVALID-ORG-TYPE TO R140-MESSAGE DTSBX421 -00882 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00883 END-IF DTSBX421 -00884 END-IF. DTSBX421 -00885 DTSBX421 -00886 IF X104-ORG-CORPORATION-88 DTSBX421 -00887 MOVE X104-INCORP-DATE TO W-SLASH-DATE DTSBX421 -00888 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 -00889 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 -00890 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 -00891 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 -00892 IF NOT L001-VALID-DATE DTSBX421 -00893 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00894 MOVE X104-INCORP-DATE TO MSG8-INCORP-DATE DTSBX421 -00895 MOVE MSG8-INVALID-INCORP-DATE TO R140-MESSAGE DTSBX421 -00896 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00897 ELSE DTSBX421 -00898 MOVE L001-FED-8-DATE-9 TO W-INCORP-DATE DTSBX421 -00899 END-IF DTSBX421 -00900 END-IF. DTSBX421 -00901 DTSBX421 -00902 DTSBX421 -00903 EVALUATE TRUE DTSBX421 -00904 WHEN X104-ELIG-NOT-SUBJECT-88 DTSBX421 -00905 IF NOT X104-LIAB-NOT-LIABLE-88 DTSBX421 -00906 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 -00907 END-IF DTSBX421 -00908 DTSBX421 -00909 WHEN X104-ELIG-RATED-88 DTSBX421 -00910 IF NOT X104-LIAB-RATED-88 DTSBX421 -00911 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 -00912 END-IF DTSBX421 +00854 01 MPRF-REC. DTSBX421 +00855 ++INCLUDE DTSIMPRF DTSBX421 +00856 DTSBX421 +00857 01 MSOL-REC. DTSBX421 +00858 ++INCLUDE DTSIMSOL DTSBX421 +00859 DTSBX421 +00860 01 MQTR-REC. DTSBX421 +00861 ++INCLUDE DTSIMQTR DTSBX421 +00862 DTSBX421 +00863 01 MOPO-REC. DTSBX421 +00864 ++INCLUDE DTSIMOPO DTSBX421 +00865 DTSBX421 +00866 01 MTAD-REC. DTSBX421 +00867 ++INCLUDE DTSIMTAD DTSBX421 +00868 DTSBX421 +00869 01 MNTE-REC. DTSBX421 +00870 ++INCLUDE DTSIMNTE DTSBX421 +00871 DTSBX421 +00872 01 L921-LINK-AREA. DTSBX421 +00873 ++INCLUDE DTSIL921 DTSBX421 +00874 SKIP3 DTSBX421 +00875 01 ISKL-REC. DTSBX421 +00876 ++INCLUDE DTSIISKL DTSBX421 +00877 SKIP3 DTSBX421 +00878 01 IEIN-REC. DTSBX421 +00879 ++INCLUDE DTSIIEIN DTSBX421 +00880 DTSBX421 +00881 01 L927-LINK-AREA. DTSBX421 +00882 ++INCLUDE DTSIL927 DTSBX421 +00883 DTSBX421 +00884 01 L931-LINK-AREA. DTSBX421 +00885 ++INCLUDE DTSIL931 DTSBX421 +00886 DTSBX421 +00887 01 FSKL-REC. DTSBX421 +00888 ++INCLUDE DTSIFSKL DTSBX421 +00889 DTSBX421 +00890 01 R140-REC. DTSBX421 +00891 ++INCLUDE DTSIR140 DTSBX421 +00892 DTSBX421 +00893 LINKAGE SECTION. DTSBX421 +00894 DTSBX421 +00895 01 LX42-LINK-AREA. DTSBX421 +00896 ++INCLUDE DTSILX42 CL*50 +00897 DTSBX421 +00898 PROCEDURE DIVISION USING LX42-LINK-AREA. CL148 +00899 DTSBX421 +00900 DTSBX421-MAIN. DTSBX421 +00901 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA DTSBX421 +00902 *** CL123 +00903 *** SET RATE FOR NEW YEAR BEFORE RATE RUN CL123 +00904 *** CL123 +00905 MOVE 2021 TO LX42-LAST-RATE-YEAR CL152 +00906 MOVE 1.9000 TO W-RATE-X CL152 +00907 MOVE LX42-ERROR-IND TO W-ERROR-IND. CL*10 +00908 MOVE LX42-CURR-RUN-DATE TO W-RUN-DATE. CL118 +00909 DISPLAY 'RDATE ' W-RUN-DATE. CL118 +00910 MOVE Z-YY TO W-YY. CL122 +00911 MOVE Z-MM TO W-MM. CL122 +00912 MOVE Z-DD TO W-DD. CL122 00913 DTSBX421 -00914 WHEN X104-ELIG-SELF-INS-88 DTSBX421 -00915 IF NOT X104-LIAB-SELF-INS-88 DTSBX421 -00916 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 -00917 END-IF DTSBX421 -00918 DTSBX421 -00919 WHEN X104-ELIG-UCX-88 DTSBX421 -00920 OR X104-ELIG-UCFE-88 DTSBX421 -00921 OR X104-ELIG-INTERSTATE-88 DTSBX421 -00922 OR X104-ELIG-DC-GOV-88 DTSBX421 -00923 IF NOT X104-LIAB-NOT-LIABLE-88 DTSBX421 -00924 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 -00925 END-IF DTSBX421 -00926 END-EVALUATE. DTSBX421 +00914 IF W-ERROR-YES-88 DTSBX421 +00915 DISPLAY 'BX421 LX42 EMP REC HAS ERROR ' LX42-EMP-NO CL*13 +00916 ' ' LX42-ERROR-IND ' ' W-ERROR-IND DTSBX421 +00917 ELSE DTSBX421 +00918 DISPLAY 'BX421 EMP REC HAS NO ERROR ' W-ERROR-IND CL*13 +00919 END-IF. DTSBX421 +00920 DTSBX421 +00921 EVALUATE TRUE DTSBX421 +00922 WHEN LX42-INITIALIZE-88 DTSBX421 +00923 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX421 +00924 DTSBX421 +00925 WHEN LX42-NEW-EMPLOYER-88 DTSBX421 +00926 PERFORM P3000-NEW-EMP THRU P3000-EXIT DTSBX421 00927 DTSBX421 -00928 IF X104-LIAB-NO-DETERM-88 DTSBX421 -00929 OR X104-LIAB-NOT-LIABLE-88 DTSBX421 -00930 MOVE SPACE TO X104-HOUSEHOLD-FILING DTSBX421 -00931 ELSE DTSBX421 -00932 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 -00933 IF X104-HH-ANNUAL-88 DTSBX421 -00934 OR X104-HH-QUARTERLY-88 DTSBX421 -00935 NEXT SENTENCE DTSBX421 -00936 ELSE DTSBX421 -00937 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00938 STRING DTSBX421 -00939 'X104 INVALID DOMESTIC FILING ' X104-HOUSEHOLD-FILING DTSBX421 -00940 DELIMITED BY SIZE DTSBX421 -00941 INTO R140-MESSAGE DTSBX421 -00942 END-STRING DTSBX421 -00943 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -00944 END-IF DTSBX421 -00945 ELSE DTSBX421 -00946 MOVE SPACE TO X104-HOUSEHOLD-FILING DTSBX421 -00947 END-IF DTSBX421 -00948 END-IF. DTSBX421 -00949 DTSBX421 -00950 IF X104-LIAB-RATED-88 DTSBX421 -00951 OR X104-LIAB-SELF-INS-88 DTSBX421 -00952 PERFORM P1212-WAGES-PAID THRU P1212-EXIT DTSBX421 -00953 ELSE DTSBX421 -00954 PERFORM P1213-NO-WAGES THRU P1213-EXIT DTSBX421 -00955 END-IF. DTSBX421 -00956 DTSBX421 -00957 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 -00958 OR X104-LIAB-NO-DETERM-88 DTSBX421 -00959 OR X104-LIAB-NOT-LIABLE-88 DTSBX421 -00960 NEXT SENTENCE DTSBX421 -00961 ELSE DTSBX421 -00962 PERFORM P1217-PRED-SUCC THRU P1217-EXIT DTSBX421 -00963 END-IF. DTSBX421 -00964 DTSBX421 -00965 P1210-EXIT. DTSBX421 -00966 EXIT. DTSBX421 -00967 DTSBX421 -00968 P1211-INCONSIST-ELIG-LIAB. DTSBX421 -00969 SET W-ERROR-YES-88 TO TRUE. DTSBX421 -00970 MOVE X104-ELIG-CD TO MSG10-ELIG-CD. DTSBX421 -00971 MOVE X104-LIAB-CD TO MSG10-LIAB-CD. DTSBX421 -00972 MOVE MSG10-INCONSISTENT-LIAB-CD TO R140-MESSAGE. DTSBX421 -00973 PERFORM S2000-WRITE-RPT THRU S2000-EXIT. DTSBX421 -00974 DTSBX421 -00975 P1211-EXIT. DTSBX421 -00976 EXIT. DTSBX421 -00977 DTSBX421 -00978 P1212-WAGES-PAID. DTSBX421 -00979 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 -00980 PERFORM P1212A-HOUSEHOLD THRU P1212A-EXIT DTSBX421 -00981 ELSE DTSBX421 -00982 PERFORM P1212B-REGULAR THRU P1212B-EXIT DTSBX421 -00983 END-IF. DTSBX421 -00984 DTSBX421 -00985 P1212-EXIT. DTSBX421 -00986 EXIT. DTSBX421 -00987 DTSBX421 -00988 P1212A-HOUSEHOLD. DTSBX421 -00989 MOVE X104-FIRST-500-QTR TO W-SLASH-QTR. DTSBX421 -00990 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX421 -00991 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX421 -00992 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX421 -00993 IF NOT L004-VALID-QTR DTSBX421 -00994 SET W-ERROR-YES-88 TO TRUE DTSBX421 -00995 MOVE X104-FIRST-500-QTR TO MSG11-QTR DTSBX421 -00996 MOVE MSG11-WAGES-PAID-QTR TO R140-MESSAGE DTSBX421 -00997 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -00998 ELSE DTSBX421 -00999 MOVE L004-QTR-START-DATE TO W-LIABLE-DATE DTSBX421 -01000 MOVE L004-QTR-5-9 TO W-FIRST-500-QTR DTSBX421 -01001 END-IF. DTSBX421 -01002 DTSBX421 -01003 P1212A-EXIT. DTSBX421 -01004 EXIT. DTSBX421 -01005 DTSBX421 -01006 P1212B-REGULAR. DTSBX421 -01007 MOVE X104-FIRST-WAGE-DT TO W-SLASH-DATE DTSBX421 -01008 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 -01009 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 -01010 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 -01011 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 -01012 IF NOT L001-VALID-DATE DTSBX421 -01013 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01014 MOVE X104-FIRST-WAGE-DT TO MSG12-DATE DTSBX421 -01015 MOVE MSG12-FIRST-WAGE-DATE TO R140-MESSAGE DTSBX421 -01016 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 -01017 ELSE DTSBX421 -01018 MOVE L001-FED-8-DATE-9 TO W-LIABLE-DATE DTSBX421 -01019 END-IF. DTSBX421 -01020 DTSBX421 -01021 P1212B-EXIT. DTSBX421 -01022 EXIT. DTSBX421 +00928 WHEN LX42-PROCESS-88 DTSBX421 +00929 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX421 +00930 DTSBX421 +00931 WHEN LX42-TERMINATE-88 DTSBX421 +00932 PERFORM P3000-NEW-EMP THRU P3000-EXIT DTSBX421 +00933 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX421 +00934 DTSBX421 +00935 END-EVALUATE. DTSBX421 +00936 DTSBX421 +00937 IF LX42-PROCESS-88 DTSBX421 +00938 MOVE W-ERROR-IND TO LX42-ERROR-IND DTSBX421 +00939 END-IF. DTSBX421 +00940 DTSBX421 +00941 DTSBX421-MAIN-EXIT. DTSBX421 +00942 GOBACK. DTSBX421 +00943 DTSBX421 +00944 I0000-INITIATE. DTSBX421 +00945 *** SET W-ERROR-NO-88 TO TRUE. DTSBX421 +00946 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX421 +00947 DTSBX421 +00948 MOVE LENGTH OF X102-REC TO W-X102-LENGTH. DTSBX421 +00949 MOVE LENGTH OF X104-REC TO W-X104-LENGTH. DTSBX421 +00950 MOVE LENGTH OF X106-REC TO W-X106-LENGTH. DTSBX421 +00951 MOVE LENGTH OF X108-REC TO W-X108-LENGTH. DTSBX421 +00952 MOVE LENGTH OF X130-REC TO W-X130-LENGTH. DTSBX421 +00953 DTSBX421 +00954 *RW1 FOR VARIABLE REPORT FILE. DTSBX421 +00955 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX421 +00956 MOVE '140' TO R140-REC-TYPE. DTSBX421 +00957 DTSBX421 +00958 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX421 +00959 IF W-FATAL-ERROR-YES-88 DTSBX421 +00960 GO TO I0000-EXIT DTSBX421 +00961 END-IF. DTSBX421 +00962 DTSBX421 +00963 I0000-EXIT. DTSBX421 +00964 EXIT. DTSBX421 +00965 DTSBX421 +00966 I2000-OPEN-FILES. DTSBX421 +00967 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX421 +00968 IF W-FATAL-ERROR-YES-88 DTSBX421 +00969 DISPLAY 'CANNOT OPEN TEMP BTC FILE ' DTSBX421 +00970 TEMP-BTC-STATUS DTSBX421 +00971 GO TO I2000-EXIT DTSBX421 +00972 END-IF. DTSBX421 +00973 OPEN OUTPUT REPT-PEND-FILE. CL*87 +00974 IF REPT-STATUS-OK-88 CL*87 +00975 NEXT SENTENCE CL*87 +00976 ELSE CL*87 +00977 DISPLAY 'X421-CANNOT OPEN REPORT PENDING FILE ' CL*92 +00978 REPT-STATUS CL*87 +00979 PERFORM S999-ABEND THRU S999-EXIT CL*87 +00980 END-IF. CL*87 +00981 CL*87 +00982 OPEN OUTPUT REPT-PAID-FILE. CL*87 +00983 IF REPT-STATUS-OK-88 CL*87 +00984 NEXT SENTENCE CL*87 +00985 ELSE CL*87 +00986 DISPLAY 'X421-CANNOT OPEN REPORT PAID FILE ' CL*92 +00987 REPT-STATUS CL*87 +00988 PERFORM S999-ABEND THRU S999-EXIT CL*87 +00989 END-IF. CL*87 +00990 WRITE REPT-PAID-REC FROM HEADER-1 AFTER ADVANCING TOP-OF-PAGE CL*99 +00991 WRITE REPT-PAID-REC FROM HEADER-2 AFTER ADVANCING 1 CL*99 +00992 WRITE REPT-PAID-REC FROM HEADER-3 AFTER ADVANCING 1 CL*99 +00993 WRITE REPT-PAID-REC FROM HEADER-6 AFTER ADVANCING 1. CL100 +00994 WRITE REPT-PAID-REC FROM HEADER-43 AFTER ADVANCING 1. CL113 +00995 WRITE REPT-PAID-REC FROM HEADER-5 AFTER ADVANCING 1. CL113 +00996 CL*99 +00997 I2000-EXIT. DTSBX421 +00998 EXIT. DTSBX421 +00999 DTSBX421 +01000 DTSBX421 +01001 P0000-PROCESS. DTSBX421 +01002 *& DTSBX421 +01003 DISPLAY SPACE. DTSBX421 +01004 * DISPLAY 'BX421 P0000 ' W-EMP-NO ' ' LX42-REC-TYPE. DTSBX421 +01005 *& DTSBX421 +01006 EVALUATE TRUE DTSBX421 +01007 WHEN LX42-REC-TYPE-PRF-88 DTSBX421 +01008 PERFORM P1100-PROFILE THRU P1100-EXIT DTSBX421 +01009 DTSBX421 +01010 WHEN LX42-REC-TYPE-DETERM-88 DTSBX421 +01011 PERFORM P1200-DETERM THRU P1200-EXIT DTSBX421 +01012 DTSBX421 +01013 WHEN LX42-REC-TYPE-NAME-88 DTSBX421 +01014 PERFORM P1300-NAME THRU P1300-EXIT DTSBX421 +01015 DTSBX421 +01016 WHEN LX42-REC-TYPE-RATE-88 DTSBX421 +01017 PERFORM P1400-RATE THRU P1400-EXIT DTSBX421 +01018 DTSBX421 +01019 ** WHEN LX42-REC-TYPE-REL-88 DTSBX421 +01020 ** PERFORM P1700-RELATION THRU P1700-EXIT DTSBX421 +01021 DTSBX421 +01022 END-EVALUATE. DTSBX421 01023 DTSBX421 -01024 P1213-NO-WAGES. DTSBX421 -01025 MOVE SPACES TO X104-FIRST-500-QTR DTSBX421 -01026 X104-FIRST-WAGE-DT. DTSBX421 -01027 DTSBX421 -01028 *** IF X104-FIRST-500-QTR > SPACES DTSBX421 -01029 * OR X104-FIRST-WAGE-DT > SPACES DTSBX421 -01030 * SET W-ERROR-YES-88 TO TRUE DTSBX421 -01031 * MOVE SPACES TO R140-MESSAGE DTSBX421 -01032 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01033 * STRING DTSBX421 -01034 * 'DETERM WAGE DATES NOT NULL ' DTSBX421 -01035 * X104-FIRST-WAGE-DT ' ' X104-FIRST-500-QTR DTSBX421 -01036 * DELIMITED BY SIZE DTSBX421 -01037 * INTO R140-MESSAGE DTSBX421 -01038 * END-STRING DTSBX421 -01039 * DISPLAY R140-MESSAGE DTSBX421 -01040 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01041 *** END-IF. DTSBX421 -01042 DTSBX421 -01043 P1213-EXIT. DTSBX421 -01044 EXIT. DTSBX421 -01045 DTSBX421 -01046 P1217-PRED-SUCC. DTSBX421 -01047 IF X104-ACQUIRE-IND = SPACES DTSBX421 -01048 SET X104-ACQUIRE-NO-88 TO TRUE DTSBX421 -01049 ELSE DTSBX421 -01050 IF (X104-ACQUIRE-IND NOT = 'Y' AND 'N') DTSBX421 -01051 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01052 MOVE SPACES TO R140-MESSAGE DTSBX421 -01053 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01054 STRING DTSBX421 -01055 'DETERM INVALID ACQUIRE IND ' DTSBX421 -01056 X104-ACQUIRE-IND DTSBX421 -01057 DELIMITED BY SIZE DTSBX421 -01058 INTO R140-MESSAGE DTSBX421 -01059 END-STRING DTSBX421 -01060 ** DISPLAY R140-MESSAGE DTSBX421 -01061 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01062 END-IF DTSBX421 -01063 END-IF. DTSBX421 -01064 DTSBX421 -01065 IF X104-MERGER-SPLIT-IND = SPACES DTSBX421 -01066 SET X104-MERGE-SPLIT-NO-88 TO TRUE DTSBX421 -01067 ELSE DTSBX421 -01068 IF (X104-MERGER-SPLIT-IND NOT = 'Y' AND 'N') DTSBX421 -01069 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01070 MOVE SPACES TO R140-MESSAGE DTSBX421 -01071 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01072 STRING DTSBX421 -01073 'DETERM INVALID MERGER-SPLIT IND ' DTSBX421 -01074 X104-MERGER-SPLIT-IND DTSBX421 -01075 DELIMITED BY SIZE DTSBX421 -01076 INTO R140-MESSAGE DTSBX421 -01077 END-STRING DTSBX421 -01078 ** DISPLAY R140-MESSAGE DTSBX421 -01079 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01080 END-IF DTSBX421 -01081 END-IF. DTSBX421 -01082 DTSBX421 -01083 IF X104-REORG-IND = SPACES DTSBX421 -01084 SET X104-REORG-NO-88 TO TRUE DTSBX421 +01024 P0000-EXIT. DTSBX421 +01025 EXIT. DTSBX421 +01026 DTSBX421 +01027 P1100-PROFILE. DTSBX421 +01028 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 +01029 MOVE LX42-DATA-AREA TO X102-REC. DTSBX421 +01030 *& DTSBX421 +01031 ADD +1 TO WS-X140-PEN-CNT CL107 +01032 DISPLAY SPACE. DTSBX421 +01033 DISPLAY 'BX421- NEW EMPLOYER PROFILE ' X102-EMP-NO. CL*13 +01034 DISPLAY ' X102-KEY ' X102-EMP-NO. CL*18 +01035 DISPLAY 'LX102-KEY ' LX42-X102-KEY-AREA. CL*14 +01036 *& CL*17 +01037 IF LX42-REC-TYPE-PRF-88 CL*14 +01038 IF LX42-X102-KEY-AREA = X102-EMP-NO CL*17 +01039 ADD +1 TO W-X102-DUP-CNT CL*38 +01040 DISPLAY 'X102 DUPLICATE PROFILE RECORD ' W-EMP-NO CL*19 +01041 ' ERR IND ' W-ERROR-IND CL*19 +01042 MOVE '999999' TO LX42-X102-EMP-NO CL*14 +01043 SET W-ERROR-YES-88 TO TRUE CL*14 +01044 MOVE SPACES TO R140-MESSAGE CL*14 +01045 MOVE W-EMP-NO TO R140-EMP-NO CL*14 +01046 STRING CL*14 +01047 'X102 DUPLICATE PROFILE RECORD ---- RECORDS SKIPED ' CL*14 +01048 X102-EMP-CLASS CL*14 +01049 DELIMITED BY SIZE CL*14 +01050 INTO R140-MESSAGE CL*14 +01051 END-STRING CL*14 +01052 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*14 +01053 GO TO P1100-EXIT CL*14 +01054 ELSE CL*14 +01055 MOVE X102-EMP-NO TO LX42-X102-KEY-AREA CL*17 +01056 END-IF CL*14 +01057 END-IF. CL*14 +01058 CL*14 +01059 DTSBX421 +01060 MOVE X102-EMP-NO TO LX42-X102-EMP-NO. CL**2 +01061 DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. CL*11 +01062 IF W-PREV-REC-NULL-88 DTSBX421 +01063 SET W-PREV-REC-PRF-88 TO TRUE DTSBX421 +01064 ADD +1 TO W-X102-PRO-CNT CL*38 +01065 PERFORM P1110-EDIT-PROFILE THRU P1110-EXIT DTSBX421 +01066 IF W-ERROR-NO-88 DTSBX421 +01067 DISPLAY 'X102 PROFILE REC PASS EDITS ' W-EMP-NO CL*20 +01068 PERFORM P1120-SAVE-PROFILE THRU P1120-EXIT DTSBX421 +01069 ADD +1 TO W-X102-SAV-CNT CL*38 +01070 MOVE SPACES TO LX42-X102-EMP-NO CL*56 +01071 ELSE CL**6 +01072 MOVE '999999' TO LX42-X102-EMP-NO CL**6 +01073 ADD +1 TO W-X102-ERR-CNT CL*38 +01074 * SET W-ERROR-YES-88 TO TRUE CL*20 +01075 * MOVE SPACES TO R140-MESSAGE CL*20 +01076 * MOVE W-EMP-NO TO R140-EMP-NO CL*20 +01077 * STRING CL*20 +01078 * 'X102 PROFILE REC HAS ERRORS - ALL RECORDS SKIPED ' CL*20 +01079 * X102-EMP-CLASS CL*20 +01080 * DELIMITED BY SIZE CL*20 +01081 * INTO R140-MESSAGE CL*20 +01082 * END-STRING CL*20 +01083 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*20 +01084 END-IF DTSBX421 01085 ELSE DTSBX421 -01086 IF (X104-REORG-IND NOT = 'Y' AND 'N') DTSBX421 -01087 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01088 MOVE SPACES TO R140-MESSAGE DTSBX421 -01089 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01090 STRING DTSBX421 -01091 'DETERM INVALID REORG IND ' DTSBX421 -01092 X104-REORG-IND DTSBX421 -01093 DELIMITED BY SIZE DTSBX421 -01094 INTO R140-MESSAGE DTSBX421 -01095 END-STRING DTSBX421 -01096 ** DISPLAY R140-MESSAGE DTSBX421 -01097 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01098 END-IF DTSBX421 -01099 END-IF. DTSBX421 +01086 MOVE '999999' TO LX42-X102-EMP-NO CL**2 +01087 SET W-ERROR-YES-88 TO TRUE CL**2 +01088 MOVE SPACES TO R140-MESSAGE CL**2 +01089 MOVE W-EMP-NO TO R140-EMP-NO CL**2 +01090 STRING CL**2 +01091 'X102 PROFILE REC HAS DUPLICATE -- RECORDS SKIPED ' CL*17 +01092 X102-EMP-CLASS CL**2 +01093 DELIMITED BY SIZE CL**2 +01094 INTO R140-MESSAGE CL**2 +01095 END-STRING CL**2 +01096 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL**2 +01097 DTSBX421 +01098 P1100-EXIT. DTSBX421 +01099 EXIT. DTSBX421 01100 DTSBX421 -01101 IF X104-COMMON-OWN-IND = SPACES DTSBX421 -01102 SET X104-COMMON-OWN-NO-88 TO TRUE DTSBX421 -01103 ELSE DTSBX421 -01104 IF (X104-COMMON-OWN-IND NOT = 'Y' AND 'N') DTSBX421 -01105 MOVE SPACES TO R140-MESSAGE DTSBX421 -01106 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01107 STRING DTSBX421 -01108 'DETERM INVALID COMMON OWN IND ' DTSBX421 -01109 X104-COMMON-OWN-IND DTSBX421 -01110 DELIMITED BY SIZE DTSBX421 -01111 INTO R140-MESSAGE DTSBX421 -01112 END-STRING DTSBX421 -01113 ** DISPLAY R140-MESSAGE DTSBX421 -01114 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01115 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01116 END-IF DTSBX421 -01117 END-IF. DTSBX421 -01118 DTSBX421 -01119 IF X104-SALE-TRANSFER-IND = SPACES DTSBX421 -01120 SET X104-SALE-TRANSFER-NO-88 TO TRUE DTSBX421 -01121 ELSE DTSBX421 -01122 IF (X104-SALE-TRANSFER-IND NOT = 'Y' AND 'N') DTSBX421 -01123 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01124 MOVE SPACES TO R140-MESSAGE DTSBX421 -01125 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01126 STRING DTSBX421 -01127 'DETERM INVALID SALE-TRANS IND ' DTSBX421 -01128 X104-SALE-TRANSFER-IND DTSBX421 -01129 DELIMITED BY SIZE DTSBX421 -01130 INTO R140-MESSAGE DTSBX421 -01131 END-STRING DTSBX421 -01132 ** DISPLAY R140-MESSAGE DTSBX421 -01133 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01134 END-IF DTSBX421 -01135 END-IF. DTSBX421 -01136 DTSBX421 -01137 P1217-EXIT. DTSBX421 -01138 EXIT. DTSBX421 -01139 DTSBX421 -01140 P1230-RATE-YEARS. DTSBX421 -01141 IF W-LIABLE-DATE > ZERO DTSBX421 -01142 MOVE W-LIABLE-DATE TO L001-FED-8-DATE-9 DTSBX421 -01143 PERFORM DTSBX421 -01144 VARYING SUB FROM +1 BY +1 DTSBX421 -01145 UNTIL L001-FED-8-YR > LX42-LAST-RATE-YEAR DTSBX421 -01146 MOVE L001-FED-8-YR TO W-RATE-YEAR (SUB) DTSBX421 -01147 ADD 1 TO L001-FED-8-YR DTSBX421 -01148 END-PERFORM DTSBX421 -01149 END-IF. DTSBX421 -01150 DTSBX421 -01151 P1230-EXIT. DTSBX421 -01152 EXIT. DTSBX421 -01153 DTSBX421 -01154 P1300-NAME. DTSBX421 -01155 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 -01156 MOVE LX42-DATA-AREA TO X106-REC. DTSBX421 -01157 DTSBX421 -01158 * DISPLAY 'NAME ' DTSBX421 -01159 * DISPLAY X106-REC. DTSBX421 -01160 DTSBX421 -01161 DTSBX421 -01162 ** IF W-PREV-REC-DETERM-88 DTSBX421 -01163 IF W-PREV-REC-PRF-88 DTSBX421 -01164 OR W-PREV-REC-NAME-88 DTSBX421 -01165 * DISPLAY 'GOOD PREV REC ' DTSBX421 -01166 SET W-PREV-REC-NAME-88 TO TRUE DTSBX421 -01167 ADD +1 TO W-X106-CNT DTSBX421 -01168 PERFORM P1310-EDIT-NAME THRU P1310-EXIT DTSBX421 -01169 IF W-ERROR-NO-88 DTSBX421 -01170 * DISPLAY 'GOOD P1310 EDIT NAME ' DTSBX421 -01171 PERFORM P1320-SAVE-NAME THRU P1320-EXIT DTSBX421 -01172 END-IF DTSBX421 -01173 ELSE DTSBX421 -01174 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01175 MOVE SPACES TO R140-MESSAGE DTSBX421 -01176 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01177 STRING DTSBX421 -01178 'X106 - NAME RECORD NOT IN SYNC - DUP REC ' DTSBX421 -01179 DELIMITED BY SIZE DTSBX421 -01180 INTO R140-MESSAGE DTSBX421 -01181 END-STRING DTSBX421 -01182 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01183 END-IF. DTSBX421 -01184 DTSBX421 -01185 P1300-EXIT. DTSBX421 -01186 EXIT. DTSBX421 -01187 DTSBX421 -01188 P1310-EDIT-NAME. DTSBX421 -01189 IF X106-EMP-NAME > SPACES DTSBX421 -01190 NEXT SENTENCE DTSBX421 -01191 ELSE DTSBX421 -01192 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01193 MOVE SPACES TO R140-MESSAGE DTSBX421 -01194 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01195 STRING DTSBX421 -01196 'X106 - EMP NAME IS BLANK ' DTSBX421 -01197 DELIMITED BY SIZE DTSBX421 -01198 INTO R140-MESSAGE DTSBX421 -01199 END-STRING DTSBX421 -01200 ** DISPLAY R140-MESSAGE DTSBX421 -01201 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01202 END-IF. DTSBX421 -01203 DTSBX421 -01204 P1310-EXIT. DTSBX421 -01205 EXIT. DTSBX421 -01206 DTSBX421 -01207 P1320-SAVE-NAME. DTSBX421 -01208 * DISPLAY 'P1320-SAVE-NAME ' DTSBX421 -01209 IF X106-NAME-TYPE-ENTITY-88 DTSBX421 -01210 MOVE X106-EMP-NAME TO W-ENTITY-NAME DTSBX421 -01211 ELSE DTSBX421 -01212 IF X106-NAME-TYPE-TRADE-88 DTSBX421 -01213 IF W-TRADE-NAME = SPACES DTSBX421 -01214 MOVE X106-EMP-NAME TO W-TRADE-NAME DTSBX421 -01215 ELSE DTSBX421 -01216 PERFORM P1321-ALT-NAME THRU P1321-EXIT DTSBX421 -01217 END-IF DTSBX421 -01218 END-IF DTSBX421 -01219 END-IF. DTSBX421 -01220 DTSBX421 -01221 P1320-EXIT. DTSBX421 -01222 EXIT. DTSBX421 -01223 DTSBX421 -01224 P1321-ALT-NAME. DTSBX421 -01225 * DISPLAY 'P1321-ALT-NAME' DTSBX421 -01226 MOVE LOW-VALUES TO T002-REC. DTSBX421 -01227 DTSBX421 -01228 SET T002-LENGTH-EMP-NAME-88 TO TRUE. DTSBX421 -01229 MOVE '002' TO T002-REC-TYPE. DTSBX421 -01230 MOVE X106-EMP-NO TO T002-EMP-NO. DTSBX421 -01231 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 -01232 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 -01233 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 -01234 DTSBX421 -01235 DTSBX421 -01236 MOVE X106-NAME-TYPE TO Y106-EMP-NAME-TYPE. DTSBX421 -01237 MOVE X106-EMP-NAME TO Y106-EMP-NAME. DTSBX421 -01238 DTSBX421 -01239 MOVE Y106-REC TO T002-DATA-AREA. DTSBX421 -01240 SET T002-EMP-NAME-88 TO TRUE. DTSBX421 -01241 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 -01242 DTSBX421 -01243 P1321-EXIT. DTSBX421 -01244 EXIT. DTSBX421 -01245 DTSBX421 -01246 P1400-RATE. DTSBX421 -01247 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 -01248 MOVE LX42-DATA-AREA TO X108-REC. DTSBX421 -01249 *& DTSBX421 -01250 DISPLAY 'RATE ' W-EMP-NO ' ' X108-RATE-YEAR DTSBX421 -01251 ' ' X108-RATE. DTSBX421 -01252 *& DTSBX421 -01253 DTSBX421 -01254 ** IF W-PREV-REC-NAME-88 DTSBX421 -01255 IF W-PREV-REC-DETERM-88 DTSBX421 -01256 OR W-PREV-REC-RATE-88 DTSBX421 -01257 SET W-PREV-REC-RATE-88 TO TRUE DTSBX421 -01258 ADD +1 TO W-X108-CNT DTSBX421 -01259 PERFORM P1410-EDIT-RATE THRU P1410-EXIT DTSBX421 -01260 IF W-ERROR-NO-88 DTSBX421 -01261 IF W-DUP-RATE-NO-88 DTSBX421 -01262 PERFORM P1420-SAVE-RATE THRU P1420-EXIT DTSBX421 -01263 END-IF DTSBX421 -01264 END-IF DTSBX421 -01265 ELSE DTSBX421 -01266 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01267 MOVE SPACES TO R140-MESSAGE DTSBX421 -01268 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01269 STRING DTSBX421 -01270 'X108 - RATE RECORD OUT OF SYNC - DUP REC ' DTSBX421 -01271 DELIMITED BY SIZE DTSBX421 -01272 INTO R140-MESSAGE DTSBX421 -01273 END-STRING DTSBX421 -01274 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01275 END-IF. DTSBX421 -01276 DTSBX421 -01277 P1400-EXIT. DTSBX421 -01278 EXIT. DTSBX421 -01279 DTSBX421 -01280 P1410-EDIT-RATE. DTSBX421 -01281 SET W-RATE-ERROR-NO-88 TO TRUE. DTSBX421 -01282 SET W-DUP-RATE-NO-88 TO TRUE. DTSBX421 -01283 DTSBX421 -01284 IF X104-STAFF-REVIEW-YES-88 DTSBX421 -01285 DISPLAY ' STAFF NEED REVIEW ------- ' W-EMP-NO DTSBX421 -01286 GO TO P1410-EXIT DTSBX421 -01287 END-IF. DTSBX421 -01288 DTSBX421 -01289 IF NOT X104-LIAB-RATED-88 DTSBX421 -01290 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01291 MOVE SPACES TO R140-MESSAGE DTSBX421 -01292 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01293 STRING DTSBX421 -01294 'X108 EMPLOYER IS NOT RATED ' DTSBX421 -01295 DELIMITED BY SIZE DTSBX421 -01296 INTO R140-MESSAGE DTSBX421 -01297 END-STRING DTSBX421 -01298 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01299 GO TO P1410-EXIT DTSBX421 -01300 END-IF. DTSBX421 -01301 DTSBX421 -01302 MOVE X108-RATE-YEAR (1:4) TO L004-QTR-5-YR. DTSBX421 -01303 MOVE 1 TO L004-QTR-5-Q. DTSBX421 -01304 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX421 -01305 IF NOT L004-VALID-QTR DTSBX421 -01306 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01307 MOVE SPACES TO R140-MESSAGE DTSBX421 -01308 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01309 STRING DTSBX421 -01310 'X108 INVALID RATE YEAR ' DTSBX421 -01311 L004-QTR-5-X DTSBX421 -01312 DELIMITED BY SIZE DTSBX421 -01313 INTO R140-MESSAGE DTSBX421 -01314 END-STRING DTSBX421 -01315 ** DISPLAY R140-MESSAGE DTSBX421 -01316 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01317 ELSE DTSBX421 -01318 PERFORM P1411-ADD-TO-TBL THRU P1411-EXIT DTSBX421 -01319 END-IF. DTSBX421 -01320 DTSBX421 -01321 * IF W-DUP-RATE-YES-88 DTSBX421 -01322 ** DISPLAY 'RATE: DUP IGNORED ' DTSBX421 -01323 ** W-EMP-NO ' ' X108-RATE-YEAR DTSBX421 -01324 * GO TO P1410-EXIT DTSBX421 -01325 * END-IF. DTSBX421 -01326 DTSBX421 -01327 PERFORM P1415-FORMAT-RATE THRU P1415-EXIT. DTSBX421 -01328 IF W-ERROR-YES-88 DTSBX421 -01329 GO TO P1410-EXIT DTSBX421 -01330 END-IF. DTSBX421 -01331 DTSBX421 -01332 MOVE L004-QTR-5-9 TO L052-EFF-YRQ. DTSBX421 -01333 MOVE W-RATE TO L052-UI-RATE DTSBX421 -01334 PERFORM S052-UI-RATE-EDIT THRU S052-EXIT DTSBX421 -01335 IF L052-NOT-VALID DTSBX421 -01336 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01337 MOVE SPACES TO R140-MESSAGE DTSBX421 -01338 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01339 STRING DTSBX421 -01340 'X108 INVALID TAX RATE (BU052) ' DTSBX421 -01341 X108-RATE ' ' X108-RATE-YEAR DTSBX421 -01342 DELIMITED BY SIZE DTSBX421 -01343 INTO R140-MESSAGE DTSBX421 -01344 END-STRING DTSBX421 -01345 ** DISPLAY R140-MESSAGE DTSBX421 -01346 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01347 END-IF. DTSBX421 -01348 * DISPLAY 'X108-REC' X108-REC. DTSBX421 -01349 P1410-EXIT. DTSBX421 -01350 EXIT. DTSBX421 -01351 DTSBX421 -01352 P1411-ADD-TO-TBL. DTSBX421 -01353 PERFORM DTSBX421 -01354 VARYING SUB FROM +1 BY +1 DTSBX421 -01355 UNTIL SUB > +5 DTSBX421 -01356 IF W-RATE-YEAR (SUB) = L004-QTR-5-YR DTSBX421 -01357 IF W-RATE-FOUND-YES-88 (SUB) DTSBX421 -01358 SET W-DUP-RATE-YES-88 TO TRUE DTSBX421 -01359 ELSE DTSBX421 -01360 SET W-RATE-FOUND-YES-88 (SUB) TO TRUE DTSBX421 -01361 END-IF DTSBX421 -01362 END-IF DTSBX421 -01363 END-PERFORM. DTSBX421 -01364 DTSBX421 -01365 P1411-EXIT. DTSBX421 -01366 EXIT. DTSBX421 -01367 DTSBX421 -01368 P1415-FORMAT-RATE. DTSBX421 -01369 MOVE X108-RATE TO W-TEST-AMT. DTSBX421 -01370 DTSBX421 -01371 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX421 -01372 MOVE +1 TO W-MULTIPLIER. DTSBX421 -01373 MOVE +0 TO W-VALUE. DTSBX421 -01374 DTSBX421 -01375 ** DISPLAY 'INTEGER'. DTSBX421 -01376 PERFORM DTSBX421 -01377 VARYING RSUB FROM +6 BY -1 DTSBX421 -01378 UNTIL RSUB < +1 DTSBX421 -01379 IF W-TEST-AMT (RSUB:1) = '.' DTSBX421 -01380 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX421 -01381 ** DISPLAY 'DECIMAL ' RSUB DTSBX421 -01382 ELSE DTSBX421 -01383 IF W-DECIMAL-FOUND-YES-88 DTSBX421 -01384 PERFORM P1415A-INTEGER THRU P1415A-EXIT DTSBX421 -01385 END-IF DTSBX421 -01386 END-IF DTSBX421 -01387 END-PERFORM. DTSBX421 -01388 DTSBX421 -01389 IF W-DECIMAL-FOUND-NO-88 DTSBX421 -01390 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01391 MOVE SPACES TO R140-MESSAGE DTSBX421 -01392 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01393 STRING DTSBX421 -01394 'X108 INVALID RATE NO DEC POINT ' DTSBX421 -01395 X108-RATE ' ' X108-RATE-YEAR DTSBX421 -01396 DELIMITED BY SIZE DTSBX421 -01397 INTO R140-MESSAGE DTSBX421 -01398 END-STRING DTSBX421 -01399 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01400 SET W-ERROR-YES-88 TO TRUE DTSBX421 -01401 GO TO P1415-EXIT DTSBX421 -01402 END-IF. DTSBX421 -01403 DTSBX421 -01404 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX421 -01405 MOVE +0.1 TO W-MULTIPLIER. DTSBX421 -01406 DTSBX421 -01407 PERFORM DTSBX421 -01408 VARYING RSUB FROM +1 BY +1 DTSBX421 -01409 UNTIL RSUB > +6 DTSBX421 -01410 IF W-TEST-AMT (RSUB:1) = '.' DTSBX421 -01411 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX421 -01412 ** DISPLAY 'DECIMAL ' RSUB DTSBX421 -01413 ELSE DTSBX421 -01414 IF W-DECIMAL-FOUND-YES-88 DTSBX421 -01415 PERFORM P1415B-FRACTION THRU P1415B-EXIT DTSBX421 -01416 END-IF DTSBX421 -01417 END-IF DTSBX421 -01418 END-PERFORM. DTSBX421 -01419 DTSBX421 -01420 COMPUTE W-RATE = (W-VALUE / 100). DTSBX421 -01421 DTSBX421 -01422 P1415-EXIT. DTSBX421 -01423 EXIT. DTSBX421 -01424 DTSBX421 -01425 P1415A-INTEGER. DTSBX421 -01426 MOVE W-TEST-AMT(RSUB:1) TO W-DIGIT. DTSBX421 -01427 COMPUTE W-VALUE = W-VALUE + DTSBX421 -01428 (W-DIGIT * W-MULTIPLIER). DTSBX421 -01429 ** MOVE W-VALUE TO W-DISP-AMT. DTSBX421 -01430 ** DISPLAY W-DISP-AMT ' ' W-MULTIPLIER. DTSBX421 -01431 COMPUTE W-MULTIPLIER = DTSBX421 -01432 (W-MULTIPLIER * +10). DTSBX421 -01433 DTSBX421 -01434 P1415A-EXIT. DTSBX421 -01435 EXIT. DTSBX421 -01436 DTSBX421 -01437 P1415B-FRACTION. DTSBX421 -01438 MOVE W-TEST-AMT(RSUB:1) TO W-DIGIT. DTSBX421 -01439 COMPUTE W-VALUE = W-VALUE + DTSBX421 -01440 (W-DIGIT * W-MULTIPLIER). DTSBX421 -01441 ** MOVE W-VALUE TO W-DISP-AMT. DTSBX421 -01442 ** DISPLAY W-DISP-AMT ' ' W-MULTIPLIER. DTSBX421 -01443 COMPUTE W-MULTIPLIER = DTSBX421 -01444 (W-MULTIPLIER / +10). DTSBX421 -01445 DTSBX421 -01446 P1415B-EXIT. DTSBX421 -01447 EXIT. DTSBX421 -01448 DTSBX421 -01449 P1420-SAVE-RATE. DTSBX421 -01450 DISPLAY 'P1420-SAVE-RATE' DTSBX421 -01451 MOVE LOW-VALUES TO T002-REC. DTSBX421 -01452 DTSBX421 -01453 SET T002-LENGTH-RATE-88 TO TRUE. DTSBX421 -01454 MOVE '002' TO T002-REC-TYPE. DTSBX421 -01455 MOVE X108-EMP-NO TO T002-EMP-NO. DTSBX421 -01456 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 -01457 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 -01458 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 -01459 DTSBX421 -01460 DTSBX421 -01461 MOVE L052-EFF-YRQ TO Y108-RATE-EFF-YRQ. DTSBX421 -01462 MOVE L052-UI-RATE TO Y108-UI-RATE. DTSBX421 +01101 P1110-EDIT-PROFILE. DTSBX421 +01102 PERFORM P1111-EDIT-DATA THRU P1111-EXIT. DTSBX421 +01103 IF W-ERROR-NO-88 DTSBX421 +01104 PERFORM P1112-CHECK-DATABASE THRU P1112-EXIT DTSBX421 +01105 END-IF. DTSBX421 +01106 DTSBX421 +01107 P1110-EXIT. DTSBX421 +01108 EXIT. DTSBX421 +01109 DTSBX421 +01110 P1111-EDIT-DATA. DTSBX421 +01111 DISPLAY 'FEIN: ' X102-EMP-FEIN CL146 +01112 IF X102-EMP-FEIN NOT NUMERIC CL146 +01113 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01114 MOVE X102-EMP-FEIN TO MSG1-FEIN DTSBX421 +01115 MOVE MSG1-INVALID-FEIN TO R140-MESSAGE DTSBX421 +01116 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01117 ELSE DTSBX421 +01118 * PERFORM P1199-EDIT-FEIN THRU P1199-EXIT CL141 +01119 * IF W-ERROR-YES-88 CL141 +01120 * MOVE X102-EMP-FEIN TO MSG11-FEIN W-FEIN CL141 +01121 * MOVE MSG11-INVALID-FEIN TO R140-MESSAGE CL141 +01122 * PERFORM S2000-WRITE-RPT THRU S2000-EXIT CL141 +01123 * ELSE CL141 +01124 MOVE X102-EMP-FEIN TO W-FEIN CL136 +01125 * END-IF CL141 +01126 END-IF. CL136 +01127 DTSBX421 +01128 IF NOT X102-SOURCE-CD-VALID-88 DTSBX421 +01129 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01130 MOVE X102-SOURCE-CD TO MSG2-SOURCE-CD DTSBX421 +01131 MOVE MSG2-SOURCE-CODE TO R140-MESSAGE DTSBX421 +01132 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01133 END-IF. DTSBX421 +01134 DTSBX421 +01135 IF NOT X102-CLASS-CD-VALID-88 DTSBX421 +01136 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01137 MOVE SPACES TO R140-MESSAGE DTSBX421 +01138 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01139 STRING DTSBX421 +01140 'X421 INVALID EMP CLASS CD ' X102-EMP-CLASS CL**2 +01141 DELIMITED BY SIZE DTSBX421 +01142 INTO R140-MESSAGE DTSBX421 +01143 END-STRING DTSBX421 +01144 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01145 END-IF. DTSBX421 +01146 DTSBX421 +01147 IF NOT X102-STATUS-CD-VALID-88 DTSBX421 +01148 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01149 MOVE SPACES TO R140-MESSAGE DTSBX421 +01150 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01151 STRING DTSBX421 +01152 'X421 INVALID EMP STATUS CD ' X102-EMP-STATUS CL**2 +01153 DELIMITED BY SIZE DTSBX421 +01154 INTO R140-MESSAGE DTSBX421 +01155 END-STRING DTSBX421 +01156 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01157 END-IF. DTSBX421 +01158 DTSBX421 +01159 IF NOT X102-ACTION-CD-VALID-88 DTSBX421 +01160 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01161 MOVE SPACES TO R140-MESSAGE DTSBX421 +01162 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01163 STRING DTSBX421 +01164 'X421 INVALID ACTION CD ' X102-ACTION-CD CL**2 +01165 DELIMITED BY SIZE DTSBX421 +01166 INTO R140-MESSAGE DTSBX421 +01167 END-STRING DTSBX421 +01168 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01169 END-IF. DTSBX421 +01170 DTSBX421 +01171 DTSBX421 +01172 P1111-EXIT. DTSBX421 +01173 EXIT. DTSBX421 +01174 DTSBX421 +01175 P1112-CHECK-DATABASE. DTSBX421 +01176 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX421 +01177 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX421 +01178 SET MPRF-PRF-88 TO TRUE. DTSBX421 +01179 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX421 +01180 DTSBX421 +01181 PERFORM S910-READ THRU S910-EXIT. DTSBX421 +01182 IF L910-NO-REC-88 DTSBX421 +01183 NEXT SENTENCE DTSBX421 +01184 ELSE DTSBX421 +01185 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01186 MOVE MSG3-EMP-ON-FILE TO R140-MESSAGE DTSBX421 +01187 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01188 MOVE '999999' TO LX42-X102-EMP-NO CL112 +01189 GO TO P1112-EXIT DTSBX421 +01190 END-IF. DTSBX421 +01191 DTSBX421 +01192 ** MOVE ZERO TO W-FEIN-EMP-NO. DTSBX421 +01193 SET W-DUP-FEIN-NO-88 TO TRUE. DTSBX421 +01194 DTSBX421 +01195 MOVE LOW-VALUE TO IEIN-KEY-AREA DTSBX421 +01196 SET IEIN-EIN-88 TO TRUE DTSBX421 +01197 MOVE W-FEIN TO IEIN-FEIN DTSBX421 +01198 MOVE +0 TO IEIN-EMP-NO DTSBX421 +01199 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBX421 +01200 PERFORM S921-START-BROWSE THRU S921-EXIT DTSBX421 +01201 MOVE ISKL-REC TO IEIN-REC DTSBX421 +01202 PERFORM DTSBX421 +01203 UNTIL L921-NO-REC-88 DTSBX421 +01204 OR W-DUP-FEIN-YES-88 DTSBX421 +01205 IF IEIN-FEIN = W-FEIN DTSBX421 +01206 PERFORM P1112A-FIND-MPRF THRU P1112A-EXIT DTSBX421 +01207 PERFORM S921-READ-NEXT THRU S921-EXIT DTSBX421 +01208 MOVE ISKL-REC TO IEIN-REC DTSBX421 +01209 ** IF W-FEIN-EMP-NO = ZERO DTSBX421 +01210 * PERFORM S921-READ-NEXT THRU S921-EXIT DTSBX421 +01211 * MOVE ISKL-REC TO IEIN-REC DTSBX421 +01212 ** END-IF DTSBX421 +01213 ELSE DTSBX421 +01214 SET L921-NO-REC-88 TO TRUE DTSBX421 +01215 END-IF DTSBX421 +01216 END-PERFORM. DTSBX421 +01217 DTSBX421 +01218 * IF W-DUP-FEIN-YES-88 DTSBX421 +01219 * DISPLAY 'BX421 DUP FEIN ' W-EMP-NO ' ' W-FEIN DTSBX421 +01220 * ELSE DTSBX421 +01221 * DISPLAY 'BX421 FEIN OK ' W-EMP-NO ' ' W-FEIN DTSBX421 +01222 * END-IF. DTSBX421 +01223 P1112-EXIT. DTSBX421 +01224 EXIT. DTSBX421 +01225 DTSBX421 +01226 P1112A-FIND-MPRF. DTSBX421 +01227 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX421 +01228 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBX421 +01229 SET MSKL-PRF-88 TO TRUE. DTSBX421 +01230 DTSBX421 +01231 PERFORM S910-READ THRU S910-EXIT. DTSBX421 +01232 IF L910-NO-REC-88 DTSBX421 +01233 NEXT SENTENCE DTSBX421 +01234 ELSE DTSBX421 +01235 MOVE MSKL-REC TO MPRF-REC DTSBX421 +01236 ** MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DTSBX421 +01237 IF MPRF-STATUS-ACT-88 DTSBX421 +01238 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01239 SET W-DUP-FEIN-YES-88 TO TRUE DTSBX421 +01240 MOVE W-FEIN TO MSG4-FEIN DTSBX421 +01241 MOVE MSG4-DUP-EMP TO R140-MESSAGE DTSBX421 +01242 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01243 MOVE '999999' TO LX42-X102-EMP-NO CL112 +01244 END-IF DTSBX421 +01245 END-IF. DTSBX421 +01246 DTSBX421 +01247 P1112A-EXIT. DTSBX421 +01248 EXIT. DTSBX421 +01249 DTSBX421 +01250 P1120-SAVE-PROFILE. DTSBX421 +01251 MOVE X102-EMP-FEIN TO W-FEIN X421-FEIN CL*90 +01252 MOVE '17' TO W-SOURCE-CD. DTSBX421 +01253 P1120-EXIT. DTSBX421 +01254 EXIT. CL136 +01255 P1199-EDIT-FEIN. CL136 +01256 MOVE X102-EMP-FEIN TO WRK-FEIN CL136 +01257 IF WRK-FEIN-VALID-88 CL136 +01258 NEXT SENTENCE CL136 +01259 ELSE CL136 +01260 SET W-ERROR-YES-88 TO TRUE CL136 +01261 END-IF. CL136 +01262 P1199-EXIT. CL136 +01263 EXIT. CL136 +01264 DTSBX421 +01265 P1200-DETERM. DTSBX421 +01266 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 +01267 MOVE LX42-DATA-AREA TO X104-REC. DTSBX421 +01268 DISPLAY 'X104- DETERMINATION ' X104-EMP-NO. CL*80 +01269 CL*21 +01270 ADD +1 TO W-X104-RED-CNT. CL*38 +01271 IF LX42-REC-TYPE-DETERM-88 CL*54 +01272 IF LX42-X104-KEY-AREA = X104-EMP-NO CL*54 +01273 ADD +1 TO W-X104-DUP-CNT CL*54 +01274 DISPLAY 'X104 DUPLICATE PROFILE RECORD ' W-EMP-NO CL*54 +01275 ' ERR IND ' W-ERROR-IND CL*54 +01276 MOVE '999999' TO LX42-X104-EMP-NO CL*54 +01277 SET W-ERROR-YES-88 TO TRUE CL*54 +01278 MOVE SPACES TO R140-MESSAGE CL*54 +01279 MOVE W-EMP-NO TO R140-EMP-NO CL*54 +01280 STRING CL*54 +01281 'X104 DUPLICATE DETERM RECORD ---- RECORDS SKIPED ' CL*54 +01282 DELIMITED BY SIZE CL*54 +01283 INTO R140-MESSAGE CL*54 +01284 END-STRING CL*54 +01285 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54 +01286 GO TO P1200-EXIT CL*54 +01287 ELSE CL*54 +01288 MOVE X104-EMP-NO TO LX42-X104-KEY-AREA CL*54 +01289 END-IF CL*54 +01290 END-IF. CL*54 +01291 DTSBX421 +01292 DTSBX421 +01293 MOVE X104-EMP-NO TO LX42-X104-EMP-NO CL**3 +01294 MOVE X104-EMP-NO TO W-EMP-NO. CL*49 +01295 CL**4 +01296 * PERFORM P1112-CHECK-DATABASE THRU P1112-EXIT CL*54 +01297 * GO TO P1200-EXIT. CL*54 +01298 CL*49 +01299 IF LX42-X102-EMP-NO = '999999' OR CL*54 +01300 LX42-X102-EMP-NO = '888888' OR CL*58 +01301 W-PREV-REC-NULL-88 CL*54 +01302 SET W-ERROR-YES-88 TO TRUE CL*54 +01303 MOVE SPACES TO R140-MESSAGE CL*54 +01304 ADD +1 TO W-X104-ERR-CNT CL*54 +01305 MOVE W-EMP-NO TO R140-EMP-NO CL*54 +01306 STRING CL*54 +01307 'X104 NO PROFILE OR PROFILE RECORD IN ERROR ' W-EMP-NO CL*54 +01308 DELIMITED BY SIZE CL*54 +01309 INTO R140-MESSAGE CL*54 +01310 END-STRING CL*54 +01311 MOVE '999999' TO LX42-X104-EMP-NO CL*54 +01312 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54 +01313 GO TO P1200-EXIT. CL*54 +01314 CL**2 +01315 IF W-PREV-REC-PRF-88 CL*54 +01316 SET W-PREV-REC-DETERM-88 TO TRUE DTSBX421 +01317 ADD +1 TO W-X104-PRO-CNT CL*38 +01318 PERFORM P1210-EDIT-DETERM THRU P1210-EXIT DTSBX421 +01319 IF W-ERROR-NO-88 DTSBX421 +01320 ADD +1 TO W-X104-SAV-CNT CL*44 +01321 DISPLAY ' X104 -DETEMINATION REC PASS EDITS OK' CL*30 +01322 PERFORM P1230-RATE-YEARS THRU P1230-EXIT DTSBX421 +01323 MOVE SPACES TO LX42-X104-EMP-NO CL*56 +01324 ELSE CL**2 +01325 MOVE '999999' TO LX42-X104-EMP-NO CL**2 +01326 END-IF CL*55 +01327 ELSE CL*54 +01328 SET W-ERROR-YES-88 TO TRUE CL*54 +01329 MOVE SPACES TO R140-MESSAGE CL*54 +01330 MOVE W-EMP-NO TO R140-EMP-NO CL*54 +01331 ADD +1 TO W-X104-DUP-CNT CL*54 +01332 STRING CL*54 +01333 'X104 DUPLICATE DETERMINATION RECORD ' CL*54 +01334 W-PREV-REC-TYPE ' ' W-EMP-NO CL*54 +01335 DELIMITED BY SIZE CL*54 +01336 INTO R140-MESSAGE CL*54 +01337 END-STRING CL*54 +01338 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54 +01339 END-IF. CL*54 +01340 DTSBX421 +01341 DTSBX421 +01342 P1200-EXIT. DTSBX421 +01343 EXIT. DTSBX421 +01344 DTSBX421 +01345 P1210-EDIT-DETERM. DTSBX421 +01346 IF NOT X104-LIAB-VALID-88 DTSBX421 +01347 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01348 MOVE X104-LIAB-CD TO MSG5-LIAB-CD DTSBX421 +01349 MOVE MSG5-INVALID-LIAB-CD TO R140-MESSAGE DTSBX421 +01350 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01351 ELSE CL**2 +01352 MOVE X104-LIAB-CD TO LX42-X104-LIAB-CD CL**2 +01353 END-IF. DTSBX421 +01354 DTSBX421 +01355 IF X104-LIAB-NOT-LIABLE-88 CL*60 +01356 SET W-ERROR-YES-88 TO TRUE CL*77 +01357 MOVE X104-LIAB-CD TO MSG5-LIAB-CD CL*77 +01358 MOVE MSG5-INVALID-LIAB-CD TO R140-MESSAGE CL*77 +01359 PERFORM S2000-WRITE-RPT THRU S2000-EXIT CL*77 +01360 END-IF. CL*82 +01361 CL*82 +01362 * ELSE CL*82 +01363 * MOVE SPACES TO LX42-X108-EMP-NO. CL*82 +01364 IF X104-LIAB-SELF-INS-88 CL*84 +01365 MOVE SPACES TO LX42-X108-EMP-NO. CL*84 +01366 CL*59 +01367 IF NOT X104-ELIG-VALID-88 DTSBX421 +01368 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01369 MOVE X104-ELIG-CD TO MSG6-ELIG-CD DTSBX421 +01370 MOVE MSG6-INVALID-ELIG-CD TO R140-MESSAGE DTSBX421 +01371 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01372 END-IF. DTSBX421 +01373 DTSBX421 +01374 IF X104-NAICS-CD NOT NUMERIC DTSBX421 +01375 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 +01376 * MOVE SPACES TO R140-MESSAGE DTSBX421 +01377 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01378 * STRING DTSBX421 +01379 * 'DETERM NON-NUMERIC NAICS ' X104-NAICS-CD DTSBX421 +01380 * DELIMITED BY SIZE DTSBX421 +01381 * INTO R140-MESSAGE DTSBX421 +01382 * END-STRING DTSBX421 +01383 * DISPLAY R140-MESSAGE DTSBX421 +01384 *** PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01385 MOVE 999999 TO X104-NAICS-CD DTSBX421 +01386 END-IF. DTSBX421 +01387 IF NOT X104-ORG-TYPE-VALID-88 DTSBX421 +01388 IF X104-LIAB-NOT-LIABLE-88 DTSBX421 +01389 MOVE 'UNK' TO X104-ORG-TYPE DTSBX421 +01390 ELSE DTSBX421 +01391 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01392 MOVE X104-ORG-TYPE TO MSG7-ORG-TYPE DTSBX421 +01393 MOVE MSG7-INVALID-ORG-TYPE TO R140-MESSAGE DTSBX421 +01394 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01395 END-IF DTSBX421 +01396 END-IF. DTSBX421 +01397 * IF X104-ORG-CORPORATION-88 CL151 +01398 * DISPLAY 'X104 ORG: ' X104-ORG-TYPE CL151 +01399 * DISPLAY 'X104DATE: ' X104-INCORP-DATE CL151 +01400 * MOVE X104-INCORP-DATE TO W-SLASH-DATE CL151 +01401 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL151 +01402 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL151 +01403 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL151 +01404 * PERFORM S001-FROM-FED-8 THRU S001-EXIT CL151 +01405 * IF NOT L001-VALID-DATE CL151 +01406 * SET W-ERROR-YES-88 TO TRUE CL151 +01407 * MOVE X104-INCORP-DATE TO MSG8-INCORP-DATE CL151 +01408 * MOVE MSG8-INVALID-INCORP-DATE TO R140-MESSAGE CL151 +01409 * PERFORM S2000-WRITE-RPT THRU S2000-EXIT CL151 +01410 * ELSE CL151 +01411 * DISPLAY 'X104FEDE: ' L001-FED-8-DATE-9 CL151 +01412 * MOVE L001-FED-8-DATE-9 TO W-INCORP-DATE CL151 +01413 * END-IF CL151 +01414 * END-IF. CL151 +01415 DTSBX421 +01416 DTSBX421 +01417 EVALUATE TRUE DTSBX421 +01418 WHEN X104-ELIG-NOT-SUBJECT-88 DTSBX421 +01419 IF NOT X104-LIAB-NOT-LIABLE-88 DTSBX421 +01420 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 +01421 END-IF DTSBX421 +01422 DTSBX421 +01423 WHEN X104-ELIG-RATED-88 DTSBX421 +01424 IF NOT X104-LIAB-RATED-88 DTSBX421 +01425 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 +01426 END-IF DTSBX421 +01427 DTSBX421 +01428 WHEN X104-ELIG-SELF-INS-88 DTSBX421 +01429 IF NOT X104-LIAB-SELF-INS-88 DTSBX421 +01430 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 +01431 END-IF DTSBX421 +01432 DTSBX421 +01433 WHEN X104-ELIG-UCX-88 DTSBX421 +01434 OR X104-ELIG-UCFE-88 DTSBX421 +01435 OR X104-ELIG-INTERSTATE-88 DTSBX421 +01436 OR X104-ELIG-DC-GOV-88 DTSBX421 +01437 IF NOT X104-LIAB-NOT-LIABLE-88 DTSBX421 +01438 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 +01439 END-IF DTSBX421 +01440 END-EVALUATE. DTSBX421 +01441 DTSBX421 +01442 IF X104-LIAB-NO-DETERM-88 DTSBX421 +01443 OR X104-LIAB-NOT-LIABLE-88 DTSBX421 +01444 MOVE SPACE TO X104-HOUSEHOLD-FILING DTSBX421 +01445 ELSE DTSBX421 +01446 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 +01447 IF X104-HH-ANNUAL-88 DTSBX421 +01448 OR X104-HH-QUARTERLY-88 DTSBX421 +01449 NEXT SENTENCE DTSBX421 +01450 ELSE DTSBX421 +01451 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01452 STRING DTSBX421 +01453 'X104 INVALID DOMESTIC FILING ' X104-HOUSEHOLD-FILING DTSBX421 +01454 DELIMITED BY SIZE DTSBX421 +01455 INTO R140-MESSAGE DTSBX421 +01456 END-STRING DTSBX421 +01457 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01458 END-IF DTSBX421 +01459 ELSE DTSBX421 +01460 MOVE SPACE TO X104-HOUSEHOLD-FILING DTSBX421 +01461 END-IF DTSBX421 +01462 END-IF. DTSBX421 01463 DTSBX421 -01464 MOVE Y108-REC TO T002-DATA-AREA. DTSBX421 -01465 SET T002-EMP-RATE-88 TO TRUE. DTSBX421 -01466 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 -01467 DTSBX421 -01468 *& DTSBX421 -01469 * DISPLAY 'BX421 RATE ' X108-EMP-NO ' ' X108-RATE-YEAR DTSBX421 -01470 * ' ' X108-RATE. DTSBX421 -01471 *& DTSBX421 -01472 P1420-EXIT. DTSBX421 -01473 EXIT. DTSBX421 -01474 DTSBX421 -01475 * DTSBX421 -01476 *P1700-RELATION. DTSBX421 -01477 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 -01478 * INITIALIZE X130-REC. DTSBX421 -01479 * MOVE +16 TO W-LAST-FIELD. DTSBX421 -01480 * MOVE +40 TO W-LAST-FIELD-LEN. DTSBX421 -01481 * PERFORM S2000-PARSE-INPUT THRU S2000-EXIT. DTSBX421 -01482 *& DTSBX421 -01483 * DISPLAY 'RELATIONSHIP'. DTSBX421 -01484 ** DISPLAY X130-REC. DTSBX421 -01485 *& DTSBX421 -01486 * DTSBX421 -01487 * IF W-PREV-REC-OPO-88 DTSBX421 -01488 * OR W-PREV-REC-REL-88 DTSBX421 -01489 * SET W-PREV-REC-REL-88 TO TRUE DTSBX421 -01490 * ADD +1 TO W-X130-CNT DTSBX421 -01491 * PERFORM P1710-EDIT-RELATION THRU P1710-EXIT DTSBX421 -01492 * IF W-ERROR-NO-88 DTSBX421 -01493 * PERFORM P1720-SAVE-REL THRU P1720-EXIT DTSBX421 -01494 * END-IF DTSBX421 -01495 * ELSE DTSBX421 -01496 * DISPLAY 'REL RECORD FOUND FOLLOWING ' DTSBX421 -01497 * W-PREV-REC-TYPE ' ' W-EMP-NO DTSBX421 -01498 * SET W-ERROR-YES-88 TO TRUE DTSBX421 -01499 * END-IF. DTSBX421 -01500 * DTSBX421 -01501 *P1700-EXIT. DTSBX421 -01502 * EXIT. DTSBX421 -01503 * DTSBX421 -01504 *P1710-EDIT-RELATION. DTSBX421 -01505 * IF X130-PRED-FEIN NOT NUMERIC DTSBX421 -01506 * DISPLAY 'REL: NON-NUMERIC FEIN ' X130-PRED-FEIN DTSBX421 -01507 * ' ' W-EMP-NO DTSBX421 -01508 * SET W-ERROR-YES-88 TO TRUE DTSBX421 -01509 *RW1 DTSBX421 -01510 * MOVE SPACES TO R140-MESSAGE DTSBX421 -01511 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01512 * STRING DTSBX421 -01513 * 'RELATION NON-NUMERIC FEIN ' X130-PRED-FEIN DTSBX421 -01514 * DELIMITED BY SIZE DTSBX421 -01515 * INTO R140-MESSAGE DTSBX421 -01516 * END-STRING DTSBX421 -01517 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01518 *RW2 DTSBX421 -01519 * ELSE DTSBX421 -01520 * MOVE X130-PRED-FEIN TO W-PRED-FEIN DTSBX421 -01521 * END-IF. DTSBX421 -01522 * DTSBX421 -01523 *** DISPLAY 'REL: EMP ' X130-PRED-EMP-NO. DTSBX421 -01524 * IF X130-PRED-EMP-NO NOT NUMERIC DTSBX421 -01525 * DISPLAY 'REL: NON-NUMERIC PRED EMP ' DTSBX421 -01526 * X130-PRED-EMP-NO ' ' W-EMP-NO DTSBX421 -01527 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 -01528 *RW1 DTSBX421 -01529 * MOVE SPACES TO R140-MESSAGE DTSBX421 -01530 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01531 * STRING DTSBX421 -01532 * 'RELATION NON-NUMERIC PRED EMP ' X130-PRED-EMP-NO DTSBX421 -01533 * DELIMITED BY SIZE DTSBX421 -01534 * INTO R140-MESSAGE DTSBX421 -01535 * END-STRING DTSBX421 -01536 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01537 * MOVE ZERO TO W-PRED-EMP-NO DTSBX421 -01538 *RW2 DTSBX421 -01539 * ELSE DTSBX421 -01540 * MOVE X130-PRED-EMP-NO TO W-PRED-EMP-NO DTSBX421 -01541 * END-IF. DTSBX421 -01542 * DTSBX421 -01543 * IF NOT X130-REL-VALID-88 DTSBX421 -01544 * DISPLAY 'REL: INVALID RELATIONSHIP CODE ' DTSBX421 -01545 * X130-RELATIONSHIP-CD ' ' W-EMP-NO DTSBX421 -01546 * SET W-ERROR-YES-88 TO TRUE DTSBX421 -01547 * END-IF. DTSBX421 -01548 * DTSBX421 -01549 * MOVE X130-EFF-DATE TO W-SLASH-DATE DTSBX421 -01550 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 -01551 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 -01552 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 -01553 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 -01554 * IF NOT L001-VALID-DATE DTSBX421 -01555 * DISPLAY 'REL: INVALID EFFECTIVE DATE ' DTSBX421 -01556 * W-EMP-NO ' ' X130-EFF-DATE DTSBX421 -01557 * SET W-ERROR-YES-88 TO TRUE DTSBX421 -01558 *RW1 DTSBX421 -01559 * MOVE SPACES TO R140-MESSAGE DTSBX421 -01560 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01561 * STRING DTSBX421 -01562 * 'RELATION INVALID EFFECTIVE DATE ' X130-EFF-DATE DTSBX421 -01563 * DELIMITED BY SIZE DTSBX421 -01564 * INTO R140-MESSAGE DTSBX421 -01565 * END-STRING DTSBX421 -01566 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01567 *RW2 DTSBX421 -01568 * ELSE DTSBX421 -01569 * MOVE L001-SLASH-8-DATE TO W-PRED-EFF-DATE DTSBX421 -01570 * END-IF. DTSBX421 -01571 * DTSBX421 -01572 * PERFORM DTSBX421 -01573 * VARYING RSUB FROM +1 BY +1 DTSBX421 -01574 * UNTIL RSUB > +6 DTSBX421 -01575 * IF RSUB = +4 DTSBX421 -01576 * IF X130-PORTION-EXP-TRNSF (RSUB:1) = '.' DTSBX421 -01577 * NEXT SENTENCE DTSBX421 -01578 * ELSE DTSBX421 -01579 * DISPLAY 'NON-NUMERIC PERCENT ' DTSBX421 -01580 * X130-PORTION-EXP-TRNSF DTSBX421 -01581 * SET W-ERROR-YES-88 TO TRUE DTSBX421 -01582 *RW1 DTSBX421 -01583 * MOVE SPACES TO R140-MESSAGE DTSBX421 -01584 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01585 * STRING DTSBX421 -01586 * 'RELATION NON-NUMERIC PERCENT ' DTSBX421 -01587 * X130-PORTION-EXP-TRNSF DTSBX421 -01588 * DELIMITED BY SIZE DTSBX421 -01589 * INTO R140-MESSAGE DTSBX421 -01590 * END-STRING DTSBX421 -01591 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01592 *RW2 DTSBX421 -01593 * END-IF DTSBX421 -01594 * ELSE DTSBX421 -01595 * IF X130-PORTION-EXP-TRNSF (RSUB:1) >= '0' DTSBX421 -01596 * OR X130-PORTION-EXP-TRNSF (RSUB:1) <= '9' DTSBX421 -01597 * NEXT SENTENCE DTSBX421 -01598 * ELSE DTSBX421 -01599 * DISPLAY 'NON-NUMERIC PERCENT ' DTSBX421 -01600 * X130-PORTION-EXP-TRNSF DTSBX421 -01601 * SET W-ERROR-YES-88 TO TRUE DTSBX421 -01602 *RW1 DTSBX421 -01603 * MOVE SPACES TO R140-MESSAGE DTSBX421 -01604 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01605 * STRING DTSBX421 -01606 * 'RELATION NON-NUMERIC PERCENT ' DTSBX421 -01607 * X130-PORTION-EXP-TRNSF DTSBX421 -01608 * DELIMITED BY SIZE DTSBX421 -01609 * INTO R140-MESSAGE DTSBX421 -01610 * END-STRING DTSBX421 -01611 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01612 *RW2 DTSBX421 -01613 * END-IF DTSBX421 -01614 * END-IF DTSBX421 -01615 * END-PERFORM. DTSBX421 -01616 * DTSBX421 -01617 * MOVE X130-PORTION-EXP-TRNSF TO W-PORTION-EXP-TRNSF-X. DTSBX421 -01618 * DTSBX421 -01619 * IF W-PRED-EMP-NO > ZERO DTSBX421 -01620 * MOVE LOW-VALUE TO MPRF-KEY-AREA DTSBX421 -01621 * MOVE X130-PRED-EMP-NO TO MPRF-EMP-NO DTSBX421 -01622 * SET MPRF-PRF-88 TO TRUE DTSBX421 -01623 * MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBX421 -01624 * PERFORM S910-READ THRU S910-EXIT DTSBX421 -01625 * IF L910-NO-REC-88 DTSBX421 -01626 * DISPLAY 'PREDECESSOR DOES NOT EXIST ' DTSBX421 -01627 * X130-PRED-EMP-NO ' ' W-EMP-NO DTSBX421 -01628 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 -01629 *RW1 DTSBX421 -01630 * MOVE SPACES TO R140-MESSAGE DTSBX421 -01631 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -01632 * STRING DTSBX421 -01633 * 'RELATION PREDECESSOR DOES NOT EXIST ' DTSBX421 -01634 * X130-PRED-EMP-NO DTSBX421 -01635 * DELIMITED BY SIZE DTSBX421 -01636 * INTO R140-MESSAGE DTSBX421 -01637 * END-STRING DTSBX421 -01638 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -01639 *RW2 DTSBX421 -01640 * END-IF DTSBX421 -01641 * END-IF. DTSBX421 -01642 * DTSBX421 -01643 *P1710-EXIT. DTSBX421 -01644 * EXIT. DTSBX421 -01645 * DTSBX421 -01646 *P1720-SAVE-REL. DTSBX421 -01647 * PERFORM S3000-INIT-T003 THRU S3000-EXIT. DTSBX421 -01648 * DTSBX421 -01649 * SET W-MNTE-RELATIONSHIP-88 TO TRUE DTSBX421 -01650 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 -01651 * DTSBX421 -01652 * PERFORM P1721-MOVE-TEXT THRU P1721-EXIT. DTSBX421 -01653 * DTSBX421 -01654 * MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 -01655 * DTSBX421 -01656 * PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 -01657 * DTSBX421 -01658 *& DTSBX421 -01659 * DISPLAY 'MNTE ' W-EMP-NO. DTSBX421 -01660 * PERFORM DTSBX421 -01661 * VARYING SUB FROM +1 BY +1 DTSBX421 -01662 * UNTIL SUB > MNTE-TEXT-CNT DTSBX421 -01663 * DISPLAY MNTE-TEXT (SUB) DTSBX421 -01664 * END-PERFORM. DTSBX421 -01665 *& DTSBX421 -01666 *********************************************** DTSBX421 -01667 * MOVE LOW-VALUES TO T002-REC. DTSBX421 -01668 * DTSBX421 -01669 * SET T002-LENGTH-REL-88 TO TRUE. DTSBX421 -01670 * MOVE '002' TO T002-REC-TYPE. DTSBX421 -01671 * MOVE W-EMP-NO TO T002-EMP-NO. DTSBX421 -01672 * MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 -01673 * MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 -01674 * MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 -01675 * DTSBX421 -01676 * SET T002-EMP-REL-88 TO TRUE. DTSBX421 -01677 * DTSBX421 -01678 * MOVE W-PRED-EMP-NO TO T002-PRED-EMP-NO. DTSBX421 -01679 * MOVE W-PRED-FEIN TO T002-PRED-FEIN. DTSBX421 -01680 * MOVE X130-RELATIONSHIP-CD TO T002-RELATIONSHIP-CD. DTSBX421 -01681 * COMPUTE T002-PORTION-EXP-TRNSF = DTSBX421 -01682 * (W-PORTION-EXP-TRNSF / 100). DTSBX421 -01683 * MOVE W-PRED-EFF-DATE TO T002-REL-EFF-DATE. DTSBX421 -01684 * MOVE X130-SOURCE TO T002-REL-SOURCE. DTSBX421 -01685 * MOVE X130-ENTITY-NAME TO T002-REL-NAME. DTSBX421 -01686 * DTSBX421 -01687 * MOVE X130-ATTENTION TO T002-REL-ATTN. DTSBX421 -01688 * MOVE X130-STREET-1 TO T002-REL-DELV1. DTSBX421 -01689 * MOVE X130-STREET-2 TO T002-REL-DELV2. DTSBX421 -01690 * MOVE X130-CITY TO T002-REL-CITY. DTSBX421 -01691 * MOVE X130-STATE TO T002-REL-STATE. DTSBX421 -01692 * MOVE X130-ZIP TO T002-REL-ZIP. DTSBX421 -01693 * MOVE X130-PHONE TO T002-REL-VOICE. DTSBX421 -01694 * MOVE X130-FAX TO T002-REL-FAX. DTSBX421 -01695 * MOVE X130-EMAIL TO T002-REL-EMAIL. DTSBX421 -01696 * DTSBX421 -01697 * PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 -01698 * DTSBX421 -01699 *P1720-EXIT. DTSBX421 -01700 * EXIT. DTSBX421 -01701 * DTSBX421 -01702 *P1721-MOVE-TEXT. DTSBX421 -01703 * IF X104-LIAB-RATED-88 DTSBX421 -01704 * MOVE 'R' TO W-CLASS DTSBX421 -01705 * ELSE DTSBX421 -01706 * IF X104-LIAB-SELF-INS-88 DTSBX421 -01707 * MOVE 'S' TO W-CLASS DTSBX421 -01708 * ELSE DTSBX421 -01709 * MOVE 'U' TO W-CLASS DTSBX421 -01710 * END-IF DTSBX421 -01711 * END-IF. DTSBX421 -01712 * DTSBX421 -01713 * MOVE +1 TO MNTE-TEXT-CNT. DTSBX421 -01714 * MOVE 'SUCCESSOR LIABILITY INFO: ' DTSBX421 -01715 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 -01716 * DTSBX421 -01717 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01718 * STRING 'CLASS: ' W-CLASS DTSBX421 -01719 * ' LIABILITY CODE: ' X104-LIAB-CD DTSBX421 -01720 * ' LIABILITY DATE: ' X104-FIRST-WAGE-DT DTSBX421 -01721 * DELIMITED BY SIZE DTSBX421 -01722 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01723 * END-STRING. DTSBX421 -01724 * DTSBX421 -01725 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01726 * MOVE SPACES DTSBX421 -01727 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 -01728 * DTSBX421 -01729 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01730 * MOVE 'PREDECESSOR INFO:' DTSBX421 -01731 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 -01732 * DTSBX421 -01733 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01734 * STRING 'NAME: ' X130-ENTITY-NAME DTSBX421 -01735 * DELIMITED BY SIZE DTSBX421 -01736 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01737 * END-STRING. DTSBX421 -01738 * DTSBX421 -01739 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01740 * STRING 'ACCOUNT ' W-PRED-EMP-NO DTSBX421 -01741 * ' FEIN ' W-PRED-FEIN DTSBX421 -01742 * ' RELATIONSHIP CODE: ' X130-RELATIONSHIP-CD DTSBX421 -01743 * DELIMITED BY SIZE DTSBX421 -01744 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01745 * END-STRING. DTSBX421 -01746 * DTSBX421 -01747 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01748 * STRING 'EXP TRANSFERRED: ' DTSBX421 -01749 * W-PORTION-EXP-TRNSF-X DTSBX421 -01750 * ' EFF DATE: ' DTSBX421 -01751 * W-PRED-EFF-DATE DTSBX421 -01752 * DELIMITED BY SIZE DTSBX421 -01753 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01754 * END-STRING. DTSBX421 -01755 * DTSBX421 -01756 *** ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01757 ** STRING 'TRANSFER EFFECTIVE DATE: ' DTSBX421 -01758 ** W-PRED-EFF-DATE DTSBX421 -01759 ** DELIMITED BY SIZE DTSBX421 -01760 ** INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01761 ** END-STRING. DTSBX421 -01762 ** DTSBX421 -01763 ** IF X130-ATTENTION > SPACES DTSBX421 -01764 ** ADD +1 TO MNTE-TEXT-CNT DTSBX421 -01765 ** MOVE X130-ATTENTION DTSBX421 -01766 ** TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01767 *** END-IF. DTSBX421 -01768 * DTSBX421 -01769 * IF X130-STREET-1 > SPACES DTSBX421 -01770 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 -01771 * MOVE X130-STREET-1 DTSBX421 -01772 * TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01773 * END-IF. DTSBX421 -01774 * DTSBX421 -01775 * IF X130-STREET-2 > SPACES DTSBX421 -01776 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 -01777 * MOVE X130-STREET-2 DTSBX421 -01778 * TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01779 * END-IF. DTSBX421 -01780 * DTSBX421 -01781 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 -01782 * STRING X130-CITY ', ' DTSBX421 -01783 * X130-STATE ' ' DTSBX421 -01784 * X130-ZIP DTSBX421 -01785 * DELIMITED BY SIZE DTSBX421 -01786 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01787 * END-STRING. DTSBX421 -01788 * DTSBX421 -01789 * MOVE SPACES TO WRK-PHONE DTSBX421 -01790 * WRK-PHONE-TEXT1 DTSBX421 -01791 * WRK-PHONE-TEXT2. DTSBX421 -01792 * IF X130-PHONE > SPACES DTSBX421 -01793 * MOVE X130-PHONE TO WRK-PHONE DTSBX421 -01794 * IF WRK-EXT > SPACES DTSBX421 -01795 * MOVE '-' TO WRK-EXT-HYPHEN DTSBX421 -01796 * ELSE DTSBX421 -01797 * MOVE ' ' TO WRK-EXT-HYPHEN DTSBX421 -01798 * END-IF DTSBX421 -01799 * STRING DTSBX421 -01800 * 'PHONE ' WRK-AREA-CD '-' DTSBX421 -01801 * WRK-PREFIX '-' DTSBX421 -01802 * WRK-SUFFIX DTSBX421 -01803 * WRK-EXT-HYPHEN DTSBX421 -01804 * WRK-EXT DTSBX421 -01805 * DELIMITED BY SIZE DTSBX421 -01806 * INTO WRK-PHONE-TEXT1 DTSBX421 -01807 * END-STRING DTSBX421 -01808 * END-IF. DTSBX421 -01809 * DTSBX421 -01810 * IF X130-FAX > SPACES DTSBX421 -01811 * MOVE X130-FAX TO WRK-PHONE DTSBX421 -01812 * STRING DTSBX421 -01813 * 'FAX ' WRK-AREA-CD '-' DTSBX421 -01814 * WRK-PREFIX '-' DTSBX421 -01815 * WRK-SUFFIX DTSBX421 -01816 * DELIMITED BY SIZE DTSBX421 -01817 * INTO WRK-PHONE-TEXT2 DTSBX421 -01818 * END-STRING DTSBX421 -01819 * END-IF. DTSBX421 -01820 * DTSBX421 -01821 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01822 * STRING WRK-PHONE-TEXT1 ' ' DTSBX421 -01823 * WRK-PHONE-TEXT2 DTSBX421 -01824 * DELIMITED BY SIZE DTSBX421 -01825 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01826 * END-STRING. DTSBX421 -01827 * DTSBX421 -01828 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -01829 * MOVE X130-EMAIL DTSBX421 -01830 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 -01831 * DTSBX421 -01832 *P1721-EXIT. DTSBX421 -01833 * EXIT. DTSBX421 -01834 * DTSBX421 -01835 *P1800-IND-DESC. DTSBX421 -01836 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 -01837 * INITIALIZE X132-REC. DTSBX421 -01838 * MOVE +4 TO W-LAST-FIELD. DTSBX421 -01839 * MOVE +500 TO W-LAST-FIELD-LEN. DTSBX421 -01840 * PERFORM S2000-PARSE-INPUT THRU S2000-EXIT. DTSBX421 -01841 *& DTSBX421 -01842 * DISPLAY 'INDUSTRY DESCRIPTION'. DTSBX421 -01843 *& DTSBX421 -01844 * DTSBX421 -01845 * SET W-PREV-REC-IND-88 TO TRUE. DTSBX421 -01846 * ADD +1 TO W-X132-CNT. DTSBX421 -01847 * PERFORM P1820-SAVE-IND THRU P1820-EXIT. DTSBX421 -01848 * DTSBX421 -01849 *P1800-EXIT. DTSBX421 -01850 * EXIT. DTSBX421 -01851 * DTSBX421 -01852 *P1820-SAVE-IND. DTSBX421 -01853 * MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBX421 -01854 * MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBX421 -01855 * SET MNTE-NTE-88 TO TRUE. DTSBX421 -01856 * MOVE +0 TO MNTE-PURGE-DATE. DTSBX421 -01857 * SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX421 -01858 * DTSBX421 -01859 * MOVE LX42-SYS-DATE TO MNTE-ESTB-DATE DTSBX421 -01860 * MNTE-CHNG-DATE. DTSBX421 -01861 * MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBX421 -01862 * MNTE-DATA-ESTB-ABSTIME DTSBX421 -01863 * MNTE-CHNG-ABSTIME. DTSBX421 -01864 * MOVE 'WEB REG ' TO MNTE-ESTB-OP-ID DTSBX421 -01865 * MNTE-CHNG-OP-ID. DTSBX421 -01866 * MOVE +0 TO MNTE-TEXT-CNT. DTSBX421 -01867 * MOVE SPACES TO MNTE-TEXT-AREA. DTSBX421 -01868 * DTSBX421 -01869 * IF X132-SOURCE-KEY-WORD-88 DTSBX421 -01870 * SET W-MNTE-KEY-WORD-88 TO TRUE DTSBX421 -01871 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 -01872 * ELSE DTSBX421 -01873 * SET W-MNTE-DATA-ENTRY-88 TO TRUE DTSBX421 -01874 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 -01875 * END-IF. DTSBX421 -01876 * DTSBX421 -01877 * PERFORM P1821-MOVE-TEXT THRU P1821-EXIT. DTSBX421 -01878 * DTSBX421 -01879 * MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBX421 -01880 * MOVE '003' TO T003-REC-TYPE. DTSBX421 -01881 * MOVE W-EMP-NO TO T003-EMP-NO. DTSBX421 -01882 * MOVE 'WEB REG ' TO T003-ORIGIN. DTSBX421 -01883 * MOVE LX42-SYS-DATE TO T003-SYS-DATE. DTSBX421 -01884 * MOVE LX42-SYS-TIME TO T003-SYS-TIME. DTSBX421 -01885 * SET T003-ADD-MNTE-88 TO TRUE. DTSBX421 -01886 * MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 -01887 * DTSBX421 -01888 * PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 -01889 * DTSBX421 -01890 *P1820-EXIT. DTSBX421 -01891 * EXIT. DTSBX421 -01892 * DTSBX421 -01893 *P1821-MOVE-TEXT. DTSBX421 -01894 * SET W-MNTE-COMPLETE-NO-88 TO TRUE. DTSBX421 -01895 * MOVE SPACES TO W-MNTE-LINE. DTSBX421 -01896 * MOVE +0 TO W-LAST-SPACE DTSBX421 -01897 * TSUB1 DTSBX421 -01898 * TSUB2. DTSBX421 -01899 * DTSBX421 -01900 * PERFORM DTSBX421 -01901 * UNTIL W-MNTE-COMPLETE-YES-88 DTSBX421 -01902 * ADD +1 TO TSUB1 DTSBX421 -01903 * IF TSUB1 <= +500 DTSBX421 -01904 * PERFORM P1821A-MOVE-DATA THRU P1821A-EXIT DTSBX421 -01905 * ELSE DTSBX421 -01906 * SET W-MNTE-COMPLETE-YES-88 TO TRUE DTSBX421 -01907 * END-IF DTSBX421 -01908 * END-PERFORM. DTSBX421 -01909 * DTSBX421 -01910 *P1821-EXIT. DTSBX421 -01911 * EXIT. DTSBX421 -01912 * DTSBX421 -01913 *P1821A-MOVE-DATA. DTSBX421 -01914 * IF TSUB2 < +72 DTSBX421 -01915 * ADD +1 TO TSUB2 DTSBX421 -01916 * MOVE X132-IND-DESC (TSUB1:1) DTSBX421 -01917 * TO W-MNTE-LINE (TSUB2:1) DTSBX421 -01918 * IF X132-IND-DESC (TSUB1:1) = SPACE DTSBX421 -01919 * MOVE TSUB2 TO W-LAST-SPACE DTSBX421 -01920 * END-IF DTSBX421 -01921 * ELSE DTSBX421 -01922 * PERFORM P1821B-RESET THRU P1821B-EXIT DTSBX421 -01923 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 -01924 * MOVE W-MNTE-LINE TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -01925 * MOVE SPACES TO W-MNTE-LINE DTSBX421 -01926 * MOVE +0 TO W-LAST-SPACE DTSBX421 -01927 * TSUB2 DTSBX421 -01928 * END-IF. DTSBX421 -01929 * DTSBX421 -01930 *** DISPLAY 'A ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX421 -01931 *P1821A-EXIT. DTSBX421 -01932 * EXIT. DTSBX421 -01933 * DTSBX421 -01934 *P1821B-RESET. DTSBX421 -01935 *** DISPLAY 'B1 ' W-LAST-SPACE ' ' TSUB1 ' ' TSUB2. DTSBX421 -01936 ************* DTSBX421 -01937 * EXIT IF THE LAST LETTER MOVED IS A SPACE, OR IF THE CURRENT DTSBX421 -01938 * LINE DOES NOT CONTAIN ANY SPACES. DTSBX421 -01939 ************* DTSBX421 -01940 * IF W-MNTE-LINE (72:1) = SPACE DTSBX421 -01941 * SUBTRACT +1 FROM TSUB1 DTSBX421 -01942 * GO TO P1821B-EXIT DTSBX421 -01943 * END-IF. DTSBX421 -01944 * DTSBX421 -01945 * IF W-LAST-SPACE = ZERO DTSBX421 -01946 * GO TO P1821B-EXIT DTSBX421 -01947 * END-IF. DTSBX421 -01948 * DTSBX421 -01949 ************* DTSBX421 -01950 * REPLACE THE LAST LETTERS WRITTEN (OCCURRING IN THE MIDDLE OF DTSBX421 -01951 * A WORD) WITH SPACES. DTSBX421 -01952 ************* DTSBX421 -01953 * PERFORM DTSBX421 -01954 * VARYING TSUB2 FROM W-LAST-SPACE BY +1 DTSBX421 -01955 * UNTIL TSUB2 > +72 DTSBX421 -01956 * MOVE SPACE TO W-MNTE-LINE (TSUB2:1) DTSBX421 -01957 * END-PERFORM. DTSBX421 -01958 * DTSBX421 -01959 ************* DTSBX421 -01960 * RESET TSUB1 TO POINT TO THE FIRST LETTER OF THE INCOMPLETED DTSBX421 -01961 * WORD. DTSBX421 -01962 ************* DTSBX421 -01963 * COMPUTE TSUB1 = TSUB1 - (73 - W-LAST-SPACE). DTSBX421 -01964 * DTSBX421 -01965 *** DISPLAY 'B2 ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX421 -01966 *P1821B-EXIT. DTSBX421 -01967 * EXIT. DTSBX421 -01968 DTSBX421 -01969 P3000-NEW-EMP. DTSBX421 -01970 DTSBX421 -01971 DISPLAY 'BX421 P3000 OLD ' W-EMP-NO ' NEW ' LX42-EMP-NO. DTSBX421 -01972 DISPLAY 'W-ERROR-IND ' W-ERROR-IND DTSBX421 -01973 IF W-EMP-IN-PROGRESS-YES-88 DTSBX421 -01974 SET W-EMP-IN-PROGRESS-NO-88 TO TRUE DTSBX421 -01975 IF W-ERROR-NO-88 DTSBX421 -01976 PERFORM P3100-CHK-COMPLETION THRU P3100-EXIT DTSBX421 -01977 IF W-ERROR-NO-88 DTSBX421 -01978 DISPLAY 'NANCY NO ERROR' W-EMP-NO DTSBX421 -01979 PERFORM P3200-DETERM THRU P3200-EXIT DTSBX421 -01980 PERFORM P3300-COPY-TO-BTC THRU P3300-EXIT DTSBX421 -01981 END-IF DTSBX421 -01982 ELSE DTSBX421 -01983 DISPLAY 'BX421 DETERMINATION NOT WRITTEN ' W-EMP-NO DTSBX421 -01984 END-IF DTSBX421 -01985 END-IF. DTSBX421 -01986 PERFORM P3400-INIT-NEW-EMP THRU P3400-EXIT. DTSBX421 -01987 DTSBX421 -01988 DTSBX421 -01989 P3000-EXIT. DTSBX421 -01990 EXIT. DTSBX421 -01991 DTSBX421 -01992 P3100-CHK-COMPLETION. DTSBX421 -01993 DISPLAY 'P3100-CHK-COMPLETION ' DTSBX421 -01994 *** DO NOT CHECK RATES IF PREDECESSORS EXIST DTSBX421 -01995 IF X104-STAFF-REVIEW-YES-88 DTSBX421 -01996 OR W-ERROR-YES-88 DTSBX421 -01997 NEXT SENTENCE DTSBX421 -01998 ELSE DTSBX421 -01999 IF X104-LIAB-RATED-88 DTSBX421 -02000 PERFORM P3111-CHECK-RATES THRU P3111-EXIT DTSBX421 -02001 END-IF DTSBX421 -02002 END-IF. DTSBX421 -02003 ** DISPLAY 'W-ENTITY-NAME' W-ENTITY-NAME DTSBX421 -02004 IF W-ENTITY-NAME = SPACES DTSBX421 -02005 ** DISPLAY 'NO ENITITY NAME' DTSBX421 -02006 SET W-ERROR-YES-88 TO TRUE DTSBX421 -02007 MOVE SPACES TO R140-MESSAGE DTSBX421 -02008 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -02009 STRING DTSBX421 -02010 'ENTITY NO ENTITY NAME FOUND ' DTSBX421 -02011 W-EMP-NO DTSBX421 -02012 DELIMITED BY SIZE DTSBX421 -02013 INTO R140-MESSAGE DTSBX421 -02014 END-STRING DTSBX421 -02015 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -02016 END-IF. DTSBX421 -02017 DTSBX421 -02018 IF W-ERROR-YES-88 DTSBX421 -02019 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT DTSBX421 -02020 IF W-FATAL-ERROR-NO-88 DTSBX421 -02021 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT DTSBX421 -02022 GO TO P3100-EXIT DTSBX421 -02023 ELSE DTSBX421 -02024 GO TO P3100-EXIT DTSBX421 -02025 END-IF DTSBX421 -02026 END-IF. DTSBX421 -02027 ** DISPLAY 'P3100 - 2 ' W-EMP-NO ' ' W-ERROR-IND. DTSBX421 -02028 P3100-EXIT. DTSBX421 -02029 EXIT. DTSBX421 -02030 DTSBX421 -02031 P3111-CHECK-RATES. DTSBX421 -02032 DISPLAY 'P3111-CHECK-RATES ' DTSBX421 -02033 SET W-RATE-ERROR-NO-88 TO TRUE. DTSBX421 -02034 PERFORM DTSBX421 -02035 VARYING SUB FROM +1 BY +1 DTSBX421 -02036 UNTIL SUB > +5 DTSBX421 -02037 IF W-RATE-YEAR (SUB) > ZERO DTSBX421 -02038 IF W-RATE-FOUND-NO-88 (SUB) DTSBX421 -02039 SET W-RATE-ERROR-YES-88 TO TRUE DTSBX421 -02040 SET W-ERROR-YES-88 TO TRUE DTSBX421 -02041 END-IF DTSBX421 -02042 END-IF DTSBX421 -02043 END-PERFORM. DTSBX421 -02044 DTSBX421 -02045 IF W-RATE-ERROR-YES-88 DTSBX421 -02046 MOVE SPACES TO R140-MESSAGE DTSBX421 -02047 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -02048 STRING DTSBX421 -02049 'RATE SOME RATES MISSING ' DTSBX421 -02050 W-EMP-NO DTSBX421 -02051 DELIMITED BY SIZE DTSBX421 -02052 INTO R140-MESSAGE DTSBX421 -02053 END-STRING DTSBX421 -02054 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -02055 ** PERFORM DTSBX421 -02056 * VARYING SUB FROM +1 BY +1 DTSBX421 -02057 * UNTIL SUB > +5 DTSBX421 -02058 * IF W-RATE-YEAR (SUB) > ZERO DTSBX421 -02059 * DISPLAY W-RATE-YEAR (SUB) ' ' DTSBX421 -02060 * W-RATE-FOUND-IND (SUB) DTSBX421 -02061 * END-IF DTSBX421 -02062 ** END-PERFORM DTSBX421 -02063 END-IF. DTSBX421 -02064 DTSBX421 -02065 P3111-EXIT. DTSBX421 -02066 EXIT. DTSBX421 -02067 DTSBX421 -02068 P3200-DETERM. DTSBX421 -02069 DISPLAY 'P3200-DETERM' DTSBX421 -02070 DISPLAY 'BX421 P32 DETERM ' W-EMP-NO ' ' W-ENTITY-NAME. DTSBX421 -02071 DTSBX421 -02072 MOVE LOW-VALUES TO T002-REC. DTSBX421 -02073 DTSBX421 -02074 SET T002-LENGTH-DETERM-88 TO TRUE. DTSBX421 -02075 MOVE '002' TO T002-REC-TYPE. DTSBX421 -02076 MOVE W-EMP-NO TO T002-EMP-NO. DTSBX421 -02077 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 -02078 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 -02079 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 -02080 DTSBX421 -02081 DTSBX421 -02082 MOVE W-FEIN TO Y104-FEIN. DTSBX421 -02083 MOVE X104-STAFF-REVIEW-IND TO Y104-STAFF-REVIEW-IND. DTSBX421 -02084 MOVE W-ENTITY-NAME TO Y104-ENTITY-NAME. DTSBX421 -02085 MOVE W-TRADE-NAME TO Y104-TRADE-NAME. DTSBX421 -02086 MOVE W-SOURCE-CD TO Y104-SOURCE-CD. DTSBX421 -02087 MOVE X104-LIAB-CD TO Y104-LIAB-CD. DTSBX421 -02088 MOVE X104-ELIG-CD TO Y104-ELIG-CD. DTSBX421 -02089 MOVE X104-NAICS-CD TO Y104-NAICS. DTSBX421 -02090 MOVE SPACES TO Y104-OWN-CD. DTSBX421 -02091 MOVE X104-ORG-TYPE TO Y104-ORG-TYPE. DTSBX421 -02092 MOVE X104-HOUSEHOLD-FILING TO Y104-HOUSEHOLD-FILING. DTSBX421 -02093 MOVE X104-INCORP-STATE TO Y104-CORP-STATE. DTSBX421 -02094 MOVE W-INCORP-DATE TO Y104-CORP-DATE. DTSBX421 -02095 MOVE W-LIABLE-DATE TO Y104-FIRST-WAGE-DT. DTSBX421 -02096 MOVE W-FIRST-500-QTR TO Y104-FIRST-500-QTR. DTSBX421 -02097 MOVE ZERO TO Y104-LAST-WAGE-DT. DTSBX421 -02098 MOVE X104-ACQUIRE-IND TO Y104-ACQUIRE-IND. DTSBX421 -02099 MOVE X104-MERGER-SPLIT-IND TO Y104-MERGE-SPLIT-IND. DTSBX421 -02100 MOVE X104-REORG-IND TO Y104-REORG-IND. DTSBX421 -02101 MOVE X104-COMMON-OWN-IND TO Y104-COMMON-OWN-IND. DTSBX421 -02102 MOVE X104-SALE-TRANSFER-IND TO Y104-SALE-TRANSFER-IND. DTSBX421 -02103 DTSBX421 -02104 MOVE Y104-REC TO T002-DATA-AREA. DTSBX421 -02105 SET T002-DETERM-88 TO TRUE. DTSBX421 -02106 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 -02107 DTSBX421 -02108 *& DTSBX421 -02109 * DISPLAY 'BX421 DETERM ' W-EMP-NO. DTSBX421 -02110 *& DTSBX421 -02111 IF NOT X104-NOT-LIAB-NULL-88 DTSBX421 -02112 PERFORM P3210-NOT-LIAB-REASON THRU P3210-EXIT DTSBX421 -02113 END-IF. DTSBX421 -02114 DTSBX421 -02115 P3200-EXIT. DTSBX421 -02116 EXIT. DTSBX421 -02117 DTSBX421 -02118 P3210-NOT-LIAB-REASON. DTSBX421 -02119 DISPLAY 'P3210-NOT-LIAB-REASON ' DTSBX421 -02120 DISPLAY 'P3210 ' W-EMP-NO ' ' X104-NOT-LIAB-REASON. DTSBX421 -02121 DTSBX421 -02122 PERFORM S3000-INIT-T003 THRU S3000-EXIT. DTSBX421 -02123 DTSBX421 -02124 SET W-MNTE-NOT-LIAB-88 TO TRUE DTSBX421 -02125 MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 -02126 DTSBX421 -02127 MOVE +1 TO MNTE-TEXT-CNT. DTSBX421 -02128 MOVE W-ENTITY-NAME DTSBX421 -02129 TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 -02130 DTSBX421 -02131 ADD +1 TO MNTE-TEXT-CNT. DTSBX421 -02132 DTSBX421 -02133 EVALUATE TRUE DTSBX421 -02134 WHEN X104-NOT-LIAB-BUS-ACT-88 DTSBX421 -02135 MOVE 'THE TYPE OF EMPLOYMENT IS NOT COVERED' DTSBX421 -02136 TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -02137 DTSBX421 -02138 WHEN X104-NOT-LIAB-NO-EMPL-88 DTSBX421 -02139 STRING 'THE BUSINESS PAYS WAGES ONLY TO ' DTSBX421 -02140 'OWNERS OR OFFICERS' DTSBX421 -02141 DELIMITED BY SIZE DTSBX421 -02142 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -02143 END-STRING DTSBX421 -02144 DTSBX421 -02145 WHEN X104-NOT-LIAB-NO-WAGES-88 DTSBX421 -02146 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 -02147 STRING 'A HOUSEHOLD EMPLOYER PAYS LESS ' DTSBX421 -02148 'THAN $500.00 EACH QUARTER' DTSBX421 -02149 DELIMITED BY SIZE DTSBX421 -02150 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -02151 END-STRING DTSBX421 -02152 ELSE DTSBX421 -02153 STRING 'THE BUSINESS DOES NOT PAY WAGES ' DTSBX421 -02154 'FOR WORK PERFORMED IN DC' DTSBX421 -02155 DELIMITED BY SIZE DTSBX421 -02156 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 -02157 END-STRING DTSBX421 -02158 END-IF DTSBX421 -02159 DTSBX421 -02160 WHEN X104-NOT-LIAB-LOCALIZE-88 DTSBX421 -02161 MOVE 'THE WORK IS NOT LOCALIZED IN DC ' DTSBX421 -02162 TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +01464 IF X104-LIAB-RATED-88 DTSBX421 +01465 OR X104-LIAB-SELF-INS-88 DTSBX421 +01466 PERFORM P1212-WAGES-PAID THRU P1212-EXIT DTSBX421 +01467 ELSE DTSBX421 +01468 PERFORM P1213-NO-WAGES THRU P1213-EXIT DTSBX421 +01469 END-IF. DTSBX421 +01470 DTSBX421 +01471 IF X104-ORG-HSEHLD-DMSTIC-88 CL141 +01472 NEXT SENTENCE CL141 +01473 ELSE CL141 +01474 PERFORM P1199-EDIT-FEIN THRU P1199-EXIT CL141 +01475 IF W-ERROR-YES-88 CL141 +01476 MOVE '999999' TO LX42-X102-EMP-NO CL141 +01477 DISPLAY ' #### INVALID FEIN ... ' X102-EMP-FEIN CL141 +01478 MOVE X102-EMP-FEIN TO MSG11-FEIN W-FEIN CL141 +01479 MOVE MSG11-INVALID-FEIN TO R140-MESSAGE CL141 +01480 PERFORM S2000-WRITE-RPT THRU S2000-EXIT. CL141 +01481 CL141 +01482 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 +01483 OR X104-LIAB-NO-DETERM-88 DTSBX421 +01484 OR X104-LIAB-NOT-LIABLE-88 DTSBX421 +01485 NEXT SENTENCE DTSBX421 +01486 ELSE DTSBX421 +01487 PERFORM P1217-PRED-SUCC THRU P1217-EXIT DTSBX421 +01488 END-IF. DTSBX421 +01489 DTSBX421 +01490 P1210-EXIT. DTSBX421 +01491 EXIT. DTSBX421 +01492 DTSBX421 +01493 P1211-INCONSIST-ELIG-LIAB. DTSBX421 +01494 SET W-ERROR-YES-88 TO TRUE. DTSBX421 +01495 MOVE X104-ELIG-CD TO MSG10-ELIG-CD. DTSBX421 +01496 MOVE X104-LIAB-CD TO MSG10-LIAB-CD. DTSBX421 +01497 MOVE MSG10-INCONSISTENT-LIAB-CD TO R140-MESSAGE. DTSBX421 +01498 PERFORM S2000-WRITE-RPT THRU S2000-EXIT. DTSBX421 +01499 DTSBX421 +01500 P1211-EXIT. DTSBX421 +01501 EXIT. DTSBX421 +01502 DTSBX421 +01503 P1212-WAGES-PAID. DTSBX421 +01504 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 +01505 PERFORM P1212A-HOUSEHOLD THRU P1212A-EXIT DTSBX421 +01506 ELSE DTSBX421 +01507 PERFORM P1212B-REGULAR THRU P1212B-EXIT DTSBX421 +01508 END-IF. DTSBX421 +01509 DTSBX421 +01510 P1212-EXIT. DTSBX421 +01511 EXIT. DTSBX421 +01512 DTSBX421 +01513 P1212A-HOUSEHOLD. DTSBX421 +01514 CL*54 +01515 IF X104-FIRST-500-QTR > SPACES CL*54 +01516 NEXT SENTENCE CL*54 +01517 ELSE CL*54 +01518 GO TO P1212A-HOUSEHOLD-WAGES-PAID. CL*54 +01519 CL*54 +01520 MOVE X104-FIRST-500-QTR TO W-SLASH-QTR. CL*54 +01521 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX421 +01522 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX421 +01523 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX421 +01524 IF NOT L004-VALID-QTR DTSBX421 +01525 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01526 MOVE X104-FIRST-500-QTR TO MSG11-QTR DTSBX421 +01527 MOVE MSG11-WAGES-PAID-QTR TO R140-MESSAGE DTSBX421 +01528 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01529 ELSE DTSBX421 +01530 MOVE L004-QTR-START-DATE TO W-LIABLE-DATE DTSBX421 +01531 MOVE L004-QTR-5-9 TO W-FIRST-500-QTR DTSBX421 +01532 GO TO P1212A-EXIT CL*54 +01533 END-IF. DTSBX421 +01534 DTSBX421 +01535 P1212A-HOUSEHOLD-WAGES-PAID. CL*54 +01536 MOVE X104-FIRST-WAGE-DT TO W-SLASH-DATE CL*54 +01537 MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*54 +01538 MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*54 +01539 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*54 +01540 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*54 +01541 IF NOT L001-VALID-DATE CL*54 +01542 SET W-ERROR-YES-88 TO TRUE CL*54 +01543 MOVE X104-FIRST-WAGE-DT TO MSG12-DATE CL*54 +01544 MOVE MSG12-FIRST-WAGE-DATE TO R140-MESSAGE CL*54 +01545 PERFORM S2000-WRITE-RPT THRU S2000-EXIT CL*54 +01546 ELSE CL*54 +01547 MOVE L001-FED-8-DATE-9 TO W-LIABLE-DATE CL*54 +01548 MOVE ZEROS TO W-FIRST-500-QTR CL*54 +01549 END-IF. CL*54 +01550 CL*54 +01551 P1212A-EXIT. DTSBX421 +01552 EXIT. DTSBX421 +01553 DTSBX421 +01554 P1212B-REGULAR. DTSBX421 +01555 MOVE X104-FIRST-WAGE-DT TO W-SLASH-DATE DTSBX421 +01556 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 +01557 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 +01558 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 +01559 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 +01560 IF NOT L001-VALID-DATE DTSBX421 +01561 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01562 MOVE X104-FIRST-WAGE-DT TO MSG12-DATE DTSBX421 +01563 MOVE MSG12-FIRST-WAGE-DATE TO R140-MESSAGE DTSBX421 +01564 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 +01565 ELSE DTSBX421 +01566 MOVE L001-FED-8-DATE-9 TO W-LIABLE-DATE DTSBX421 +01567 END-IF. DTSBX421 +01568 DTSBX421 +01569 P1212B-EXIT. DTSBX421 +01570 EXIT. DTSBX421 +01571 DTSBX421 +01572 P1213-NO-WAGES. DTSBX421 +01573 MOVE SPACES TO X104-FIRST-500-QTR DTSBX421 +01574 X104-FIRST-WAGE-DT. DTSBX421 +01575 DTSBX421 +01576 *** IF X104-FIRST-500-QTR > SPACES DTSBX421 +01577 * OR X104-FIRST-WAGE-DT > SPACES DTSBX421 +01578 * SET W-ERROR-YES-88 TO TRUE DTSBX421 +01579 * MOVE SPACES TO R140-MESSAGE DTSBX421 +01580 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01581 * STRING DTSBX421 +01582 * 'DETERM WAGE DATES NOT NULL ' DTSBX421 +01583 * X104-FIRST-WAGE-DT ' ' X104-FIRST-500-QTR DTSBX421 +01584 * DELIMITED BY SIZE DTSBX421 +01585 * INTO R140-MESSAGE DTSBX421 +01586 * END-STRING DTSBX421 +01587 * DISPLAY R140-MESSAGE DTSBX421 +01588 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01589 *** END-IF. DTSBX421 +01590 DTSBX421 +01591 P1213-EXIT. DTSBX421 +01592 EXIT. DTSBX421 +01593 DTSBX421 +01594 P1217-PRED-SUCC. DTSBX421 +01595 IF X104-ACQUIRE-IND = SPACES DTSBX421 +01596 SET X104-ACQUIRE-NO-88 TO TRUE DTSBX421 +01597 ELSE DTSBX421 +01598 IF (X104-ACQUIRE-IND NOT = 'Y' AND 'N') DTSBX421 +01599 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01600 MOVE SPACES TO R140-MESSAGE DTSBX421 +01601 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01602 STRING DTSBX421 +01603 'X421 INVALID ACQUIRE IND ' CL**2 +01604 X104-ACQUIRE-IND DTSBX421 +01605 DELIMITED BY SIZE DTSBX421 +01606 INTO R140-MESSAGE DTSBX421 +01607 END-STRING DTSBX421 +01608 ** DISPLAY R140-MESSAGE DTSBX421 +01609 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01610 END-IF DTSBX421 +01611 END-IF. DTSBX421 +01612 DTSBX421 +01613 IF X104-MERGER-SPLIT-IND = SPACES DTSBX421 +01614 SET X104-MERGE-SPLIT-NO-88 TO TRUE DTSBX421 +01615 ELSE DTSBX421 +01616 IF (X104-MERGER-SPLIT-IND NOT = 'Y' AND 'N') DTSBX421 +01617 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01618 MOVE SPACES TO R140-MESSAGE DTSBX421 +01619 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01620 STRING DTSBX421 +01621 'X421 INVALID MERGER-SPLIT IND ' CL**2 +01622 X104-MERGER-SPLIT-IND DTSBX421 +01623 DELIMITED BY SIZE DTSBX421 +01624 INTO R140-MESSAGE DTSBX421 +01625 END-STRING DTSBX421 +01626 ** DISPLAY R140-MESSAGE DTSBX421 +01627 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01628 END-IF DTSBX421 +01629 END-IF. DTSBX421 +01630 DTSBX421 +01631 IF X104-REORG-IND = SPACES DTSBX421 +01632 SET X104-REORG-NO-88 TO TRUE DTSBX421 +01633 ELSE DTSBX421 +01634 IF (X104-REORG-IND NOT = 'Y' AND 'N') DTSBX421 +01635 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01636 MOVE SPACES TO R140-MESSAGE DTSBX421 +01637 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01638 STRING DTSBX421 +01639 'X421 INVALID REORG IND ' CL**2 +01640 X104-REORG-IND DTSBX421 +01641 DELIMITED BY SIZE DTSBX421 +01642 INTO R140-MESSAGE DTSBX421 +01643 END-STRING DTSBX421 +01644 ** DISPLAY R140-MESSAGE DTSBX421 +01645 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01646 END-IF DTSBX421 +01647 END-IF. DTSBX421 +01648 DTSBX421 +01649 IF X104-COMMON-OWN-IND = SPACES DTSBX421 +01650 SET X104-COMMON-OWN-NO-88 TO TRUE DTSBX421 +01651 ELSE DTSBX421 +01652 IF (X104-COMMON-OWN-IND NOT = 'Y' AND 'N') DTSBX421 +01653 MOVE SPACES TO R140-MESSAGE DTSBX421 +01654 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01655 STRING DTSBX421 +01656 'X421 INVALID COMMON OWN IND ' CL**2 +01657 X104-COMMON-OWN-IND DTSBX421 +01658 DELIMITED BY SIZE DTSBX421 +01659 INTO R140-MESSAGE DTSBX421 +01660 END-STRING DTSBX421 +01661 ** DISPLAY R140-MESSAGE DTSBX421 +01662 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01663 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01664 END-IF DTSBX421 +01665 END-IF. DTSBX421 +01666 DTSBX421 +01667 IF X104-SALE-TRANSFER-IND = SPACES DTSBX421 +01668 SET X104-SALE-TRANSFER-NO-88 TO TRUE DTSBX421 +01669 ELSE DTSBX421 +01670 IF (X104-SALE-TRANSFER-IND NOT = 'Y' AND 'N') DTSBX421 +01671 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01672 MOVE SPACES TO R140-MESSAGE DTSBX421 +01673 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01674 STRING DTSBX421 +01675 'X421 INVALID SALE-TRANS IND ' CL**2 +01676 X104-SALE-TRANSFER-IND DTSBX421 +01677 DELIMITED BY SIZE DTSBX421 +01678 INTO R140-MESSAGE DTSBX421 +01679 END-STRING DTSBX421 +01680 ** DISPLAY R140-MESSAGE DTSBX421 +01681 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01682 END-IF DTSBX421 +01683 END-IF. DTSBX421 +01684 DTSBX421 +01685 P1217-EXIT. DTSBX421 +01686 EXIT. DTSBX421 +01687 DTSBX421 +01688 P1230-RATE-YEARS. DTSBX421 +01689 IF W-LIABLE-DATE > ZERO DTSBX421 +01690 MOVE W-LIABLE-DATE TO L001-FED-8-DATE-9 DTSBX421 +01691 PERFORM DTSBX421 +01692 VARYING SUB FROM +1 BY +1 DTSBX421 +01693 UNTIL L001-FED-8-YR > LX42-LAST-RATE-YEAR DTSBX421 +01694 MOVE L001-FED-8-YR TO W-RATE-YEAR (SUB) DTSBX421 +01695 ADD 1 TO L001-FED-8-YR DTSBX421 +01696 END-PERFORM DTSBX421 +01697 END-IF. DTSBX421 +01698 DTSBX421 +01699 P1230-EXIT. DTSBX421 +01700 EXIT. DTSBX421 +01701 DTSBX421 +01702 P1300-NAME. DTSBX421 +01703 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 +01704 MOVE LX42-DATA-AREA TO X106-REC. DTSBX421 +01705 DTSBX421 +01706 ADD +1 TO W-X106-RED-CNT. CL*38 +01707 DISPLAY 'X106- EMPLOYER NAME ' W-EMP-NO. CL*23 +01708 CL*23 +01709 * IF LX42-REC-TYPE-NAME-88 CL*28 +01710 * IF LX42-X106-KEY-AREA = X106-EMP-NO CL*28 +01711 * ADD +1 TO W-X106-DUP-CNT CL*38 +01712 * DISPLAY 'X106 DUPLICATE EMP NAME RECORD ' W-EMP-NO CL*28 +01713 * ' ERR IND ' W-ERROR-IND CL*28 +01714 * MOVE '999999' TO LX42-X106-EMP-NO CL*28 +01715 * SET W-ERROR-YES-88 TO TRUE CL*28 +01716 * MOVE SPACES TO R140-MESSAGE CL*28 +01717 * MOVE W-EMP-NO TO R140-EMP-NO CL*28 +01718 * STRING CL*28 +01719 * 'X106 DUPLICATE EMPLOYER NAME ---- RECORDS SKIPED ' CL*28 +01720 * DELIMITED BY SIZE CL*28 +01721 * INTO R140-MESSAGE CL*28 +01722 * END-STRING CL*28 +01723 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*28 +01724 * GO TO P1300-EXIT CL*28 +01725 * ELSE CL*28 +01726 * MOVE X106-EMP-NO TO LX42-X106-KEY-AREA CL*28 +01727 * END-IF CL*28 +01728 * END-IF. CL*28 +01729 DTSBX421 +01730 MOVE X106-EMP-NO TO LX42-X106-EMP-NO CL**2 +01731 CL**4 +01732 IF LX42-X102-EMP-NO = '999999' OR CL**4 +01733 LX42-X102-EMP-NO = '888888' OR CL*58 +01734 LX42-X104-EMP-NO = '999999' OR CL*58 +01735 LX42-X104-EMP-NO = '888888' CL*58 +01736 SET W-ERROR-YES-88 TO TRUE CL**4 +01737 MOVE SPACES TO R140-MESSAGE CL**4 +01738 MOVE W-EMP-NO TO R140-EMP-NO CL**4 +01739 ADD +1 TO W-X106-ERR-CNT CL*38 +01740 STRING CL**4 +01741 'X106- PROFILE OR DETERMINATION IN ERROR -' CL*23 +01742 W-EMP-NO CL**4 +01743 DELIMITED BY SIZE CL**4 +01744 INTO R140-MESSAGE CL**4 +01745 END-STRING CL**4 +01746 MOVE '999999' TO LX42-X106-EMP-NO CL**4 +01747 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 +01748 GO TO P1300-EXIT. CL**4 +01749 CL**4 +01750 IF W-PREV-REC-DETERM-88 CL**2 +01751 OR W-PREV-REC-PRF-88 CL*33 +01752 OR W-PREV-REC-NAME-88 DTSBX421 +01753 SET W-PREV-REC-NAME-88 TO TRUE DTSBX421 +01754 ADD +1 TO W-X106-PRO-CNT CL*38 +01755 PERFORM P1310-EDIT-NAME THRU P1310-EXIT DTSBX421 +01756 IF W-ERROR-NO-88 DTSBX421 +01757 DISPLAY 'X106- EMPLOYER NAME PASS EDITS OK' CL*30 +01758 PERFORM P1320-SAVE-NAME THRU P1320-EXIT DTSBX421 +01759 ADD +1 TO W-X106-SAV-CNT CL*38 +01760 MOVE SPACES TO LX42-X106-EMP-NO CL*56 +01761 ELSE CL**2 +01762 MOVE '999999' TO LX42-X106-EMP-NO CL**2 +01763 END-IF DTSBX421 +01764 ELSE DTSBX421 +01765 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01766 MOVE SPACES TO R140-MESSAGE DTSBX421 +01767 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01768 ADD +1 TO W-X106-ERR-CNT CL*38 +01769 STRING DTSBX421 +01770 'X106 - NAME RECORD NOT IN SYNC - DUP REC ' DTSBX421 +01771 DELIMITED BY SIZE DTSBX421 +01772 INTO R140-MESSAGE DTSBX421 +01773 END-STRING DTSBX421 +01774 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01775 END-IF. DTSBX421 +01776 DTSBX421 +01777 P1300-EXIT. DTSBX421 +01778 EXIT. DTSBX421 +01779 DTSBX421 +01780 P1310-EDIT-NAME. DTSBX421 +01781 IF X106-NAME-TYPE-TRADE-88 AND CL133 +01782 X106-EMP-NAME = SPACES CL133 +01783 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01784 MOVE SPACES TO R140-MESSAGE DTSBX421 +01785 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01786 STRING DTSBX421 +01787 'X106 - EMPLOYER NAME IS BLANK - ERROR ' CL133 +01788 DELIMITED BY SIZE DTSBX421 +01789 INTO R140-MESSAGE DTSBX421 +01790 END-STRING DTSBX421 +01791 DISPLAY R140-MESSAGE CL133 +01792 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01793 END-IF. DTSBX421 +01794 DTSBX421 +01795 P1310-EXIT. DTSBX421 +01796 EXIT. DTSBX421 +01797 DTSBX421 +01798 P1320-SAVE-NAME. DTSBX421 +01799 IF X106-NAME-TYPE-ENTITY-88 DTSBX421 +01800 MOVE X106-EMP-NAME TO W-ENTITY-NAME DTSBX421 +01801 ELSE DTSBX421 +01802 IF X106-NAME-TYPE-TRADE-88 DTSBX421 +01803 IF W-TRADE-NAME = SPACES DTSBX421 +01804 MOVE X106-EMP-NAME TO W-TRADE-NAME DTSBX421 +01805 ELSE DTSBX421 +01806 PERFORM P1321-ALT-NAME THRU P1321-EXIT DTSBX421 +01807 END-IF DTSBX421 +01808 END-IF DTSBX421 +01809 END-IF. DTSBX421 +01810 DTSBX421 +01811 P1320-EXIT. DTSBX421 +01812 EXIT. DTSBX421 +01813 DTSBX421 +01814 P1321-ALT-NAME. DTSBX421 +01815 DISPLAY 'P1321-ALT-NAME' CL*24 +01816 MOVE LOW-VALUES TO T002-REC. DTSBX421 +01817 DTSBX421 +01818 SET T002-LENGTH-EMP-NAME-88 TO TRUE. DTSBX421 +01819 MOVE '002' TO T002-REC-TYPE. DTSBX421 +01820 MOVE X106-EMP-NO TO T002-EMP-NO. DTSBX421 +01821 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 +01822 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 +01823 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 +01824 DTSBX421 +01825 DTSBX421 +01826 MOVE X106-NAME-TYPE TO Y106-EMP-NAME-TYPE. DTSBX421 +01827 CL*74 +01828 IF X106-EMP-NAME > SPACES CL*74 +01829 MOVE X106-EMP-NAME TO L009-DATA CL*74 +01830 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*74 +01831 MOVE L009-DATA TO Y106-EMP-NAME CL*74 +01832 ELSE CL*74 +01833 MOVE X106-EMP-NAME TO Y106-EMP-NAME. CL*74 +01834 DTSBX421 +01835 MOVE Y106-REC TO T002-DATA-AREA. DTSBX421 +01836 SET T002-EMP-NAME-88 TO TRUE. DTSBX421 +01837 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 +01838 DTSBX421 +01839 ADD +1 TO W-T002-NAME-CNT. CL*26 +01840 P1321-EXIT. DTSBX421 +01841 EXIT. DTSBX421 +01842 DTSBX421 +01843 P1400-RATE. DTSBX421 +01844 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 +01845 MOVE LX42-DATA-AREA TO X108-REC. DTSBX421 +01846 *& DTSBX421 +01847 DISPLAY 'BX421- RATE ' W-EMP-NO ' ' X108-RATE-YEAR CL*35 +01848 ' ' X108-RATE. DTSBX421 +01849 CL**4 +01850 ADD +1 TO W-X108-RED-CNT. CL*38 +01851 CL*24 +01852 * IF LX42-REC-TYPE-RATE-88 CL*33 +01853 * IF LX42-X108-KEY-AREA = X108-EMP-NO CL*33 +01854 * ADD +1 TO W-X108-DUP CL*33 +01855 * DISPLAY 'X108 DUPLICATE EMP RATE RECORD ' W-EMP-NO CL*33 +01856 * ' ERR IND ' W-ERROR-IND CL*33 +01857 * MOVE SPACES TO R140-MESSAGE CL*33 +01858 * MOVE W-EMP-NO TO R140-EMP-NO CL*33 +01859 * STRING CL*33 +01860 * 'X108 DUPLICATE RATE RECORD - REVIEW FOR ERRORS ' CL*33 +01861 * DELIMITED BY SIZE CL*33 +01862 * INTO R140-MESSAGE CL*33 +01863 * END-STRING CL*33 +01864 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*33 +01865 * GO TO P1400-EXIT CL*33 +01866 * ELSE CL*33 +01867 * MOVE X108-EMP-NO TO LX42-X108-KEY-AREA CL*33 +01868 * END-IF CL*33 +01869 * END-IF. CL*33 +01870 CL*24 +01871 MOVE X108-EMP-NO TO LX42-X108-EMP-NO CL**4 +01872 CL**4 +01873 IF LX42-X102-EMP-NO = '999999' OR CL**4 +01874 LX42-X102-EMP-NO = '888888' OR CL*58 +01875 LX42-X104-EMP-NO = '999999' OR CL*34 +01876 LX42-X104-EMP-NO = '888888' OR CL*58 +01877 LX42-X106-EMP-NO = '999999' OR CL*58 +01878 LX42-X106-EMP-NO = '888888' CL*58 +01879 SET W-ERROR-YES-88 TO TRUE CL**4 +01880 ADD +1 TO W-X108-ERR-CNT CL*38 +01881 MOVE SPACES TO R140-MESSAGE CL**4 +01882 MOVE W-EMP-NO TO R140-EMP-NO CL**4 +01883 STRING CL**4 +01884 'X108- PROFILE / DETERMINATION OR NAME REC IN ERROR ' CL*34 +01885 DELIMITED BY SIZE CL**4 +01886 INTO R140-MESSAGE CL**4 +01887 END-STRING CL**4 +01888 MOVE '999999' TO LX42-X108-EMP-NO CL**4 +01889 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 +01890 GO TO P1400-EXIT. CL**4 +01891 CL**4 +01892 IF X104-LIAB-SELF-INS-88 CL*84 +01893 MOVE SPACES TO R140-MESSAGE CL*84 +01894 MOVE W-EMP-NO TO R140-EMP-NO CL*84 +01895 STRING CL*84 +01896 'X108- SELF INSURED - RATE RECORD FOUND ' CL*84 +01897 DELIMITED BY SIZE CL*84 +01898 INTO R140-MESSAGE CL*84 +01899 END-STRING CL*84 +01900 MOVE '999999' TO LX42-X108-EMP-NO CL*84 +01901 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*84 +01902 GO TO P1400-EXIT. CL*84 +01903 DTSBX421 +01904 IF W-PREV-REC-DETERM-88 DTSBX421 +01905 OR W-PREV-REC-NAME-88 CL*24 +01906 OR W-PREV-REC-RATE-88 CL*24 +01907 SET W-PREV-REC-RATE-88 TO TRUE DTSBX421 +01908 ADD +1 TO W-X108-PRO-CNT CL*38 +01909 PERFORM P1410-EDIT-RATE THRU P1410-EXIT DTSBX421 +01910 IF W-ERROR-NO-88 DTSBX421 +01911 IF W-DUP-RATE-NO-88 DTSBX421 +01912 DISPLAY 'X108- RATE PASS EDITS OK' CL*30 +01913 PERFORM P1420-SAVE-RATE THRU P1420-EXIT DTSBX421 +01914 ADD +1 TO W-X108-SAV-CNT CL*38 +01915 MOVE SPACES TO LX42-X108-EMP-NO CL*56 +01916 ELSE CL**4 +01917 MOVE '999999' TO LX42-X108-EMP-NO CL**4 +01918 ADD +1 TO W-X108-ERR-CNT CL*38 +01919 END-IF DTSBX421 +01920 ELSE CL**4 +01921 MOVE '999999' TO LX42-X108-EMP-NO CL**4 +01922 ADD +1 TO W-X108-ERR-CNT CL*38 +01923 END-IF DTSBX421 +01924 ELSE DTSBX421 +01925 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01926 MOVE SPACES TO R140-MESSAGE DTSBX421 +01927 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01928 ADD +1 TO W-X108-ERR-CNT CL*38 +01929 STRING DTSBX421 +01930 'X108 - RATE RECORD OUT OF SYNC - DUP REC ' DTSBX421 +01931 DELIMITED BY SIZE DTSBX421 +01932 INTO R140-MESSAGE DTSBX421 +01933 END-STRING DTSBX421 +01934 MOVE '999999' TO LX42-X108-EMP-NO CL**4 +01935 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01936 END-IF. DTSBX421 +01937 DTSBX421 +01938 P1400-EXIT. DTSBX421 +01939 EXIT. DTSBX421 +01940 DTSBX421 +01941 P1410-EDIT-RATE. DTSBX421 +01942 SET W-RATE-ERROR-NO-88 TO TRUE. DTSBX421 +01943 SET W-DUP-RATE-NO-88 TO TRUE. DTSBX421 +01944 DTSBX421 +01945 IF X104-STAFF-REVIEW-YES-88 DTSBX421 +01946 * SET W-ERROR-YES-88 TO TRUE CL*29 +01947 MOVE SPACES TO R140-MESSAGE CL**4 +01948 MOVE W-EMP-NO TO R140-EMP-NO CL**4 +01949 STRING CL**4 +01950 'X108 - RATE RECORD - STAFF NEED REVIEW ' CL**4 +01951 DELIMITED BY SIZE CL**4 +01952 INTO R140-MESSAGE CL**4 +01953 END-STRING CL**4 +01954 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 +01955 DISPLAY ' STAFF NEED REVIEW ------- ' W-EMP-NO DTSBX421 +01956 * MOVE '999999' TO LX42-X108-EMP-NO CL*29 +01957 * GO TO P1410-EXIT CL*35 +01958 END-IF. DTSBX421 +01959 DTSBX421 +01960 IF NOT X104-LIAB-RATED-88 DTSBX421 +01961 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01962 MOVE SPACES TO R140-MESSAGE DTSBX421 +01963 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01964 STRING DTSBX421 +01965 'X108 EMPLOYER IS NOT LIAB CANNOT HAVE RATE ' CL*24 +01966 DELIMITED BY SIZE DTSBX421 +01967 INTO R140-MESSAGE DTSBX421 +01968 END-STRING DTSBX421 +01969 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01970 MOVE '999999' TO LX42-X108-EMP-NO CL*24 +01971 GO TO P1410-EXIT DTSBX421 +01972 END-IF. DTSBX421 +01973 DTSBX421 +01974 MOVE X108-RATE-YEAR (1:4) TO L004-QTR-5-YR. DTSBX421 +01975 MOVE 1 TO L004-QTR-5-Q. DTSBX421 +01976 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX421 +01977 IF NOT L004-VALID-QTR DTSBX421 +01978 SET W-ERROR-YES-88 TO TRUE DTSBX421 +01979 MOVE SPACES TO R140-MESSAGE DTSBX421 +01980 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +01981 STRING DTSBX421 +01982 'X108 RATE RECORD CANTAINS INVALID RATE YEAR ' CL*24 +01983 L004-QTR-5-X DTSBX421 +01984 DELIMITED BY SIZE DTSBX421 +01985 INTO R140-MESSAGE DTSBX421 +01986 END-STRING DTSBX421 +01987 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +01988 MOVE '999999' TO LX42-X108-EMP-NO CL*24 +01989 GO TO P1410-EXIT CL*33 +01990 ELSE DTSBX421 +01991 PERFORM P1411-ADD-TO-TBL THRU P1411-EXIT DTSBX421 +01992 END-IF. DTSBX421 +01993 DTSBX421 +01994 * IF W-DUP-RATE-YES-88 DTSBX421 +01995 ** DISPLAY 'RATE: DUP IGNORED ' DTSBX421 +01996 ** W-EMP-NO ' ' X108-RATE-YEAR DTSBX421 +01997 * GO TO P1410-EXIT DTSBX421 +01998 * END-IF. DTSBX421 +01999 DTSBX421 +02000 PERFORM P1415-FORMAT-RATE THRU P1415-EXIT. DTSBX421 +02001 IF W-ERROR-YES-88 DTSBX421 +02002 DISPLAY 'X108 - RATE HAS ERRORS ' W-EMP-NO CL128 +02003 MOVE '999999' TO LX42-X108-EMP-NO CL*24 +02004 GO TO P1410-EXIT DTSBX421 +02005 END-IF. DTSBX421 +02006 DTSBX421 +02007 DISPLAY ' BEFORE L005 YRQ ' L004-QTR-5-9 CL*76 +02008 * IF L004-QTR-5-9 = 20191 CL156 +02009 * MOVE 20211 TO L052-EFF-YRQ CL156 +02010 * MOVE W-RATE TO L052-UI-RATE CL156 +02011 * ELSE CL156 +02012 MOVE L004-QTR-5-9 TO L052-EFF-YRQ CL*76 +02013 MOVE W-RATE TO L052-UI-RATE DTSBX421 +02014 PERFORM S052-UI-RATE-EDIT THRU S052-EXIT DTSBX421 +02015 IF L052-NOT-VALID DTSBX421 +02016 SET W-ERROR-YES-88 TO TRUE DTSBX421 +02017 MOVE SPACES TO R140-MESSAGE DTSBX421 +02018 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02019 STRING DTSBX421 +02020 'X108 INVALID TAX RATE (BU052)YEAR FOR DUTAS ' CL*24 +02021 X108-RATE ' ' X108-RATE-YEAR DTSBX421 +02022 DELIMITED BY SIZE DTSBX421 +02023 INTO R140-MESSAGE DTSBX421 +02024 END-STRING DTSBX421 +02025 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02026 MOVE '999999' TO LX42-X108-EMP-NO CL*24 +02027 ELSE CL*34 +02028 DISPLAY ' L052 YRQ ' L052-EFF-YRQ CL*34 +02029 DISPLAY ' L005 YRQ ' L004-QTR-5-9 CL*34 +02030 END-IF. DTSBX421 +02031 P1410-EXIT. DTSBX421 +02032 EXIT. DTSBX421 +02033 DTSBX421 +02034 P1411-ADD-TO-TBL. DTSBX421 +02035 PERFORM DTSBX421 +02036 VARYING SUB FROM +1 BY +1 DTSBX421 +02037 UNTIL SUB > +5 DTSBX421 +02038 IF W-RATE-YEAR (SUB) = L004-QTR-5-YR DTSBX421 +02039 IF W-RATE-FOUND-YES-88 (SUB) DTSBX421 +02040 SET W-DUP-RATE-YES-88 TO TRUE DTSBX421 +02041 ELSE DTSBX421 +02042 SET W-RATE-FOUND-YES-88 (SUB) TO TRUE DTSBX421 +02043 END-IF DTSBX421 +02044 END-IF DTSBX421 +02045 END-PERFORM. DTSBX421 +02046 DTSBX421 +02047 P1411-EXIT. DTSBX421 +02048 EXIT. DTSBX421 +02049 DTSBX421 +02050 P1415-FORMAT-RATE. DTSBX421 +02051 MOVE X108-RATE TO W-TEST-AMT. DTSBX421 +02052 DTSBX421 +02053 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX421 +02054 MOVE +1 TO W-MULTIPLIER. DTSBX421 +02055 MOVE +0 TO W-VALUE. DTSBX421 +02056 DTSBX421 +02057 ** DISPLAY 'INTEGER'. DTSBX421 +02058 PERFORM DTSBX421 +02059 VARYING RSUB FROM +6 BY -1 DTSBX421 +02060 UNTIL RSUB < +1 DTSBX421 +02061 IF W-TEST-AMT (RSUB:1) = '.' DTSBX421 +02062 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX421 +02063 ** DISPLAY 'DECIMAL ' RSUB DTSBX421 +02064 ELSE DTSBX421 +02065 IF W-DECIMAL-FOUND-YES-88 DTSBX421 +02066 PERFORM P1415A-INTEGER THRU P1415A-EXIT DTSBX421 +02067 END-IF DTSBX421 +02068 END-IF DTSBX421 +02069 END-PERFORM. DTSBX421 +02070 DTSBX421 +02071 IF W-DECIMAL-FOUND-NO-88 DTSBX421 +02072 SET W-ERROR-YES-88 TO TRUE DTSBX421 +02073 MOVE SPACES TO R140-MESSAGE DTSBX421 +02074 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02075 STRING DTSBX421 +02076 'X108 CONTAINS INVALID RATE NO DEC POINT ' CL*24 +02077 X108-RATE ' ' X108-RATE-YEAR DTSBX421 +02078 DELIMITED BY SIZE DTSBX421 +02079 INTO R140-MESSAGE DTSBX421 +02080 END-STRING DTSBX421 +02081 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02082 SET W-ERROR-YES-88 TO TRUE DTSBX421 +02083 MOVE '999999' TO LX42-X108-EMP-NO CL*24 +02084 GO TO P1415-EXIT DTSBX421 +02085 END-IF. DTSBX421 +02086 DTSBX421 +02087 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX421 +02088 MOVE +0.1 TO W-MULTIPLIER. DTSBX421 +02089 DTSBX421 +02090 PERFORM DTSBX421 +02091 VARYING RSUB FROM +1 BY +1 DTSBX421 +02092 UNTIL RSUB > +6 DTSBX421 +02093 IF W-TEST-AMT (RSUB:1) = '.' DTSBX421 +02094 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX421 +02095 ** DISPLAY 'DECIMAL ' RSUB DTSBX421 +02096 ELSE DTSBX421 +02097 IF W-DECIMAL-FOUND-YES-88 DTSBX421 +02098 PERFORM P1415B-FRACTION THRU P1415B-EXIT DTSBX421 +02099 END-IF DTSBX421 +02100 END-IF DTSBX421 +02101 END-PERFORM. DTSBX421 +02102 DTSBX421 +02103 COMPUTE W-RATE = (W-VALUE / 100). DTSBX421 +02104 IF X108-RATE < W-RATE-X CL130 +02105 SET W-ERROR-YES-88 TO TRUE CL125 +02106 MOVE SPACES TO R140-MESSAGE CL125 +02107 MOVE W-EMP-NO TO R140-EMP-NO CL125 +02108 DISPLAY ' X108-RATE ' X108-RATE CL129 +02109 DISPLAY ' XXXX-RATE ' W-RATE-X CL130 +02110 STRING CL125 +02111 'X108 CONTAINS INVALID RATE ' CL125 +02112 X108-RATE ' ' X108-RATE-YEAR CL125 +02113 DELIMITED BY SIZE CL125 +02114 INTO R140-MESSAGE CL125 +02115 END-STRING CL125 +02116 PERFORM S946-WRITE-R140 THRU S946-EXIT CL125 +02117 SET W-ERROR-YES-88 TO TRUE CL125 +02118 MOVE '999999' TO LX42-X108-EMP-NO CL125 +02119 GO TO P1415-EXIT. CL125 +02120 P1415-EXIT. DTSBX421 +02121 EXIT. DTSBX421 +02122 DTSBX421 +02123 P1415A-INTEGER. DTSBX421 +02124 MOVE W-TEST-AMT(RSUB:1) TO W-DIGIT. DTSBX421 +02125 COMPUTE W-VALUE = W-VALUE + DTSBX421 +02126 (W-DIGIT * W-MULTIPLIER). DTSBX421 +02127 ** MOVE W-VALUE TO W-DISP-AMT. DTSBX421 +02128 ** DISPLAY W-DISP-AMT ' ' W-MULTIPLIER. DTSBX421 +02129 COMPUTE W-MULTIPLIER = DTSBX421 +02130 (W-MULTIPLIER * +10). DTSBX421 +02131 DTSBX421 +02132 P1415A-EXIT. DTSBX421 +02133 EXIT. DTSBX421 +02134 DTSBX421 +02135 P1415B-FRACTION. DTSBX421 +02136 MOVE W-TEST-AMT(RSUB:1) TO W-DIGIT. DTSBX421 +02137 COMPUTE W-VALUE = W-VALUE + DTSBX421 +02138 (W-DIGIT * W-MULTIPLIER). DTSBX421 +02139 ** MOVE W-VALUE TO W-DISP-AMT. DTSBX421 +02140 ** DISPLAY W-DISP-AMT ' ' W-MULTIPLIER. DTSBX421 +02141 COMPUTE W-MULTIPLIER = DTSBX421 +02142 (W-MULTIPLIER / +10). DTSBX421 +02143 DTSBX421 +02144 P1415B-EXIT. DTSBX421 +02145 EXIT. DTSBX421 +02146 DTSBX421 +02147 P1420-SAVE-RATE. DTSBX421 +02148 DISPLAY 'P1420-SAVE-RATE' DTSBX421 +02149 MOVE LOW-VALUES TO T002-REC. DTSBX421 +02150 MOVE SPACES TO LX42-X108-EMP-NO. CL*83 +02151 SET T002-LENGTH-RATE-88 TO TRUE. DTSBX421 +02152 MOVE '002' TO T002-REC-TYPE. DTSBX421 +02153 MOVE X108-EMP-NO TO T002-EMP-NO. DTSBX421 +02154 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 +02155 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 +02156 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 +02157 DTSBX421 +02158 DISPLAY ' RATE YRQ ' L004-QTR-5-9 CL*34 +02159 MOVE ZEROS TO Y108-RATE-EFF-YRQ. CL*32 +02160 DISPLAY ' L052 YRQ ' L052-EFF-YRQ. CL*32 +02161 MOVE L052-EFF-YRQ TO Y108-RATE-EFF-YRQ. DTSBX421 +02162 MOVE L052-UI-RATE TO Y108-UI-RATE. DTSBX421 02163 DTSBX421 -02164 END-EVALUATE. DTSBX421 -02165 DTSBX421 -02166 DTSBX421 -02167 MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 -02168 DTSBX421 -02169 PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 -02170 DTSBX421 -02171 *& DTSBX421 -02172 * DISPLAY 'NOT LIAB MNTE ' W-EMP-NO. DTSBX421 -02173 * PERFORM DTSBX421 -02174 * VARYING SUB FROM +1 BY +1 DTSBX421 -02175 * UNTIL SUB > MNTE-TEXT-CNT DTSBX421 -02176 * DISPLAY MNTE-TEXT (SUB) DTSBX421 -02177 * END-PERFORM. DTSBX421 -02178 *& DTSBX421 -02179 P3210-EXIT. DTSBX421 -02180 EXIT. DTSBX421 -02181 DTSBX421 -02182 P3300-COPY-TO-BTC. DTSBX421 -02183 DISPLAY 'P3300-COPY-TO-BTC ' DTSBX421 -02184 DISPLAY 'BX421 COMPLETE ' W-EMP-NO. DTSBX421 -02185 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. DTSBX421 -02186 IF W-FATAL-ERROR-NO-88 DTSBX421 -02187 IF W-ERROR-NO-88 DTSBX421 -02188 PERFORM P3310-COPY-TO-BTC THRU P3310-EXIT DTSBX421 -02189 END-IF DTSBX421 -02190 ELSE DTSBX421 -02191 DISPLAY 'P3300 FATAL ERR ON CLOSE' DTSBX421 -02192 GO TO P3300-EXIT DTSBX421 -02193 END-IF. DTSBX421 -02194 DTSBX421 -02195 IF NOT LX42-TERMINATE-88 DTSBX421 -02196 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT DTSBX421 -02197 END-IF. DTSBX421 -02198 DTSBX421 -02199 P3300-EXIT. DTSBX421 -02200 EXIT. DTSBX421 -02201 DTSBX421 -02202 P3310-COPY-TO-BTC. DTSBX421 -02203 DISPLAY 'P3310-COPY-TO-BTC ' DTSBX421 -02204 PERFORM S1050-OPEN-TEMP-BTC-IN THRU S1050-EXIT DTSBX421 -02205 IF W-FATAL-ERROR-YES-88 DTSBX421 -02206 GO TO P3310-EXIT DTSBX421 -02207 END-IF. DTSBX421 -02208 DTSBX421 -02209 PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT. DTSBX421 -02210 DTSBX421 -02211 PERFORM DTSBX421 -02212 UNTIL TEMP-BTC-STATUS-EOF-88 DTSBX421 -02213 OR W-FATAL-ERROR-YES-88 DTSBX421 -02214 PERFORM S927B-WRITE THRU S927B-EXIT DTSBX421 -02215 PERFORM P3311-COUNT THRU P3311-EXIT DTSBX421 -02216 PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT DTSBX421 -02217 END-PERFORM. DTSBX421 -02218 DTSBX421 -02219 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. DTSBX421 -02220 DTSBX421 -02221 P3310-EXIT. DTSBX421 -02222 EXIT. DTSBX421 -02223 DTSBX421 -02224 P3311-COUNT. DTSBX421 -02225 IF TSKL-NOTEPAD-88 DTSBX421 -02226 ADD +1 TO W-T003-WRITE-CNT DTSBX421 -02227 GO TO P3311-EXIT DTSBX421 -02228 END-IF. DTSBX421 -02229 DTSBX421 -02230 MOVE TEMP-BTC-REC TO T002-REC. DTSBX421 -02231 ADD +1 TO W-T002-WRITE-CNT. DTSBX421 -02232 DTSBX421 -02233 EVALUATE TRUE DTSBX421 -02234 WHEN T002-DETERM-88 DTSBX421 -02235 ADD +1 TO W-T002-DETERM-CNT DTSBX421 -02236 DTSBX421 -02237 WHEN T002-EMP-NAME-88 DTSBX421 -02238 ADD +1 TO W-T002-NAME-CNT DTSBX421 -02239 DTSBX421 -02240 WHEN T002-EMP-RATE-88 DTSBX421 -02241 ADD +1 TO W-T002-RATE-CNT DTSBX421 -02242 DTSBX421 -02243 WHEN T002-EMP-ADDR-88 DTSBX421 -02244 ADD +1 TO W-T002-ADDR-CNT DTSBX421 -02245 DTSBX421 -02246 WHEN T002-CONTACT-88 DTSBX421 -02247 ADD +1 TO W-T002-OPO-CNT DTSBX421 -02248 DTSBX421 -02249 WHEN T002-EMP-REL-88 DTSBX421 -02250 ADD +1 TO W-T002-REL-CNT DTSBX421 -02251 DTSBX421 -02252 END-EVALUATE. DTSBX421 -02253 DTSBX421 -02254 P3311-EXIT. DTSBX421 -02255 EXIT. DTSBX421 -02256 DTSBX421 -02257 P3400-INIT-NEW-EMP. DTSBX421 -02258 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX421 -02259 SET W-ERROR-NO-88 TO TRUE. DTSBX421 -02260 SET W-PREV-REC-NULL-88 TO TRUE. DTSBX421 -02261 MOVE ZERO TO W-LIABLE-DATE DTSBX421 -02262 W-INCORP-DATE DTSBX421 -02263 W-WAGES-PLANNED-DATE DTSBX421 -02264 W-FIRST-500-QTR DTSBX421 -02265 W-FEIN. DTSBX421 -02266 DTSBX421 -02267 MOVE SPACES TO W-ENTITY-NAME DTSBX421 -02268 W-TRADE-NAME DTSBX421 -02269 W-SOURCE-CD DTSBX421 -02270 W-FIELD-ZIP DTSBX421 -02271 W-FIELD-STATE DTSBX421 -02272 DTSBX421 -02273 INITIALIZE X102-REC DTSBX421 -02274 X104-REC DTSBX421 -02275 X106-REC DTSBX421 -02276 X108-REC DTSBX421 -02277 X110-REC DTSBX421 -02278 X120-REC DTSBX421 -02279 X130-REC. DTSBX421 -02280 PERFORM DTSBX421 -02281 VARYING SUB FROM +1 BY +1 DTSBX421 -02282 UNTIL SUB > +5 DTSBX421 -02283 MOVE ZERO TO W-RATE-YEAR (SUB) DTSBX421 -02284 SET W-RATE-FOUND-NO-88 (SUB) TO TRUE DTSBX421 -02285 END-PERFORM. DTSBX421 -02286 DTSBX421 -02287 P3400-EXIT. DTSBX421 -02288 EXIT. DTSBX421 -02289 DTSBX421 -02290 DTSBX421 -02291 T0000-TERMINATE. DTSBX421 -02292 DISPLAY ' '. DTSBX421 -02293 DTSBX421 -02294 DISPLAY '*** DTSBX421 TERMINATION STATISTICS ***'. DTSBX421 -02295 DTSBX421 -02296 DISPLAY ' '. DTSBX421 -02297 DTSBX421 -02298 DISPLAY '*** EMPLOYER REGISTRATION ***'. DTSBX421 -02299 DTSBX421 -02300 DISPLAY ' '. DTSBX421 -02301 DTSBX421 -02302 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX421 -02303 DTSBX421 -02304 DISPLAY ' '. DTSBX421 -02305 DISPLAY '***************************************'. DTSBX421 -02306 DTSBX421 -02307 CLOSE TEMP-BTC-FILE. DTSBX421 -02308 DTSBX421 -02309 *RW1 DTSBX421 -02310 * DISPLAY ' '. DTSBX421 -02311 * MOVE WRK-R140-CNT TO DISPLAY-CNT. DTSBX421 -02312 * DISPLAY 'R140 RECORDS WRITTEN : ' DTSBX421 -02313 * DISPLAY-CNT. DTSBX421 -02314 * DTSBX421 -02315 * MOVE LOW-VALUES TO R140-REC. DTSBX421 -02316 * MOVE -1 TO R140-LENGTH. DTSBX421 -02317 * DTSBX421 -02318 * PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSBX421 -02319 *RW2 DTSBX421 -02320 DTSBX421 -02321 T0000-EXIT. DTSBX421 -02322 EXIT. DTSBX421 -02323 DTSBX421 -02324 T2000-DISPLAY-TOTALS. DTSBX421 -02325 DISPLAY 'DETERMINATIONS INPUT ' DTSBX421 -02326 W-X102-CNT. DTSBX421 -02327 DTSBX421 -02328 DISPLAY 'DETERMINATIONS WRITTEN ' DTSBX421 -02329 W-T002-DETERM-CNT. DTSBX421 -02330 DTSBX421 -02331 DISPLAY 'NAME RECORDS WRITTEN ' DTSBX421 -02332 W-T002-NAME-CNT. DTSBX421 -02333 DTSBX421 -02334 DISPLAY 'RATE RECORDS WRITTEN ' DTSBX421 -02335 W-T002-RATE-CNT. DTSBX421 -02336 DTSBX421 -02337 DISPLAY 'OUTPUT T002 RECORDS WRITTEN ' DTSBX421 -02338 W-T002-WRITE-CNT. DTSBX421 -02339 DISPLAY 'OUTPUT T003 RECORDS WRITTEN ' DTSBX421 -02340 W-T003-WRITE-CNT. DTSBX421 -02341 DTSBX421 -02342 DISPLAY ' '. DTSBX421 -02343 DTSBX421 -02344 T2000-EXIT. DTSBX421 -02345 EXIT. DTSBX421 -02346 DTSBX421 -02347 S001-FROM-FED-8. DTSBX421 -02348 SET L001-FROM-FED-8 TO TRUE. DTSBX421 -02349 GO TO S001-DATE. DTSBX421 -02350 DTSBX421 -02351 S001-FROM-CAL-8. DTSBX421 -02352 SET L001-FROM-CAL-8 TO TRUE. DTSBX421 -02353 GO TO S001-DATE. DTSBX421 -02354 DTSBX421 -02355 S001-FROM-ABS-DAY. DTSBX421 -02356 SET L001-FROM-ABS-DAY TO TRUE. DTSBX421 -02357 GO TO S001-DATE. DTSBX421 -02358 DTSBX421 -02359 S001-DATE. DTSBX421 -02360 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX421 -02361 S001-EXIT. DTSBX421 -02362 EXIT. DTSBX421 -02363 DTSBX421 -02364 S003-AGENCY-DAY. DTSBX421 -02365 SET L003-AGENCY-DAY TO TRUE. DTSBX421 -02366 GO TO S003-WORK-DAY. DTSBX421 -02367 DTSBX421 -02368 S003-WORK-DAY. DTSBX421 -02369 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX421 -02370 S003-EXIT. DTSBX421 -02371 EXIT. DTSBX421 -02372 DTSBX421 -02373 S004-FROM-5. DTSBX421 -02374 SET L004-FROM-5 TO TRUE. DTSBX421 -02375 GO TO S004-YRQ. DTSBX421 -02376 DTSBX421 -02377 S004-FROM-DATE. DTSBX421 -02378 SET L004-FROM-DATE TO TRUE. DTSBX421 -02379 GO TO S004-YRQ. DTSBX421 -02380 DTSBX421 -02381 S004-FROM-ABS. DTSBX421 -02382 SET L004-FROM-ABS TO TRUE. DTSBX421 -02383 GO TO S004-YRQ. DTSBX421 -02384 DTSBX421 -02385 S004-YRQ. DTSBX421 -02386 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX421 -02387 DTSBX421 -02388 S004-EXIT. DTSBX421 -02389 EXIT. DTSBX421 -02390 DTSBX421 -02391 S052-UI-RATE-EDIT. DTSBX421 -02392 CALL 'DTSBU052' USING L052-LINK-AREA. DTSBX421 -02393 DTSBX421 -02394 S052-EXIT. DTSBX421 -02395 EXIT. DTSBX421 -02396 DTSBX421 -02397 S072-ADDRESS. DTSBX421 -02398 CALL 'DTSBU072' USING L072-LINK-AREA. DTSBX421 -02399 DTSBX421 -02400 S072-EXIT. DTSBX421 -02401 EXIT. DTSBX421 -02402 DTSBX421 -02403 S516-LIABILITY-INFO. DTSBX421 -02404 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX421 -02405 MPRF-REC. DTSBX421 -02406 S516-EXIT. DTSBX421 -02407 EXIT. DTSBX421 -02408 DTSBX421 -02409 *S910-OPEN-READ. DTSBX421 -02410 * SET L910-OPEN-READ-88 TO TRUE. DTSBX421 -02411 * GO TO S910-MSTR-IO. DTSBX421 -02412 DTSBX421 -02413 S910-READ. DTSBX421 -02414 SET L910-READ-88 TO TRUE. DTSBX421 -02415 GO TO S910-MSTR-IO. DTSBX421 -02416 DTSBX421 -02417 S910-START-BROWSE. DTSBX421 -02418 SET L910-START-BROWSE-88 TO TRUE. DTSBX421 -02419 GO TO S910-MSTR-IO. DTSBX421 -02420 DTSBX421 -02421 S910-READ-NEXT. DTSBX421 -02422 SET L910-READ-NEXT-88 TO TRUE. DTSBX421 -02423 GO TO S910-MSTR-IO. DTSBX421 -02424 DTSBX421 -02425 *S910-CLOSE. DTSBX421 -02426 * SET L910-CLOSE-88 TO TRUE. DTSBX421 -02427 * GO TO S910-MSTR-IO. DTSBX421 -02428 DTSBX421 -02429 S910-MSTR-IO. DTSBX421 -02430 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX421 -02431 MSKL-REC. DTSBX421 -02432 S910-EXIT. DTSBX421 -02433 EXIT. DTSBX421 -02434 DTSBX421 -02435 S921-OPEN-READ. DTSBX421 -02436 SET L921-OPEN-READ-88 TO TRUE. DTSBX421 -02437 GO TO S921-AIX-IO. DTSBX421 -02438 DTSBX421 -02439 S921-READ. DTSBX421 -02440 SET L921-READ-88 TO TRUE. DTSBX421 -02441 GO TO S921-AIX-IO. DTSBX421 -02442 DTSBX421 -02443 S921-START-BROWSE. DTSBX421 -02444 SET L921-START-BROWSE-88 TO TRUE. DTSBX421 -02445 GO TO S921-AIX-IO. DTSBX421 -02446 DTSBX421 -02447 S921-READ-NEXT. DTSBX421 -02448 SET L921-READ-NEXT-88 TO TRUE. DTSBX421 -02449 GO TO S921-AIX-IO. DTSBX421 -02450 DTSBX421 -02451 S921-CLOSE. DTSBX421 -02452 SET L921-CLOSE-88 TO TRUE. DTSBX421 -02453 GO TO S921-AIX-IO. DTSBX421 -02454 DTSBX421 -02455 S921-AIX-IO. DTSBX421 -02456 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX421 -02457 ISKL-REC. DTSBX421 -02458 S921-EXIT. DTSBX421 -02459 EXIT. DTSBX421 -02460 DTSBX421 -02461 *S927A-OPEN. DTSBX421 -02462 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX421 -02463 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 -02464 * DTSBX421 -02465 *S927A-EXIT. DTSBX421 -02466 * EXIT. DTSBX421 -02467 DTSBX421 -02468 S927B-WRITE. DTSBX421 -02469 SET L927-WRITE-88 TO TRUE. DTSBX421 -02470 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 -02471 DTSBX421 -02472 S927B-EXIT. DTSBX421 -02473 EXIT. DTSBX421 -02474 DTSBX421 -02475 *S927C-CLOSE. DTSBX421 -02476 * SET L927-CLOSE-88 TO TRUE. DTSBX421 -02477 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 -02478 * DTSBX421 -02479 *S927C-EXIT. DTSBX421 -02480 * EXIT. DTSBX421 -02481 DTSBX421 -02482 S927Z-IO. DTSBX421 -02483 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX421 -02484 TSKL-REC. DTSBX421 -02485 S927Z-EXIT. DTSBX421 -02486 EXIT. DTSBX421 -02487 DTSBX421 -02488 *S931-OPEN-READ. DTSBX421 -02489 * SET L931-OPEN-READ-88 TO TRUE. DTSBX421 -02490 * GO TO S931-REF-IO. DTSBX421 -02491 * DTSBX421 -02492 *S931-CLOSE. DTSBX421 -02493 * SET L931-CLOSE-88 TO TRUE. DTSBX421 -02494 * GO TO S931-REF-IO. DTSBX421 -02495 * DTSBX421 -02496 *S931-REF-IO. DTSBX421 -02497 * CALL 'DTSBU931' USING L931-LINK-AREA DTSBX421 -02498 * FSKL-REC. DTSBX421 -02499 *S931-EXIT. DTSBX421 -02500 * EXIT. DTSBX421 -02501 DTSBX421 -02502 S946-WRITE-R140. DTSBX421 -02503 * MOVE SPACES TO R140-MESSAGE DTSBX421 -02504 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -02505 * STRING DTSBX421 -02506 * MSG1-TYPE ' - ' DTSBX421 -02507 * MSG1-MESSAGE ': ' DTSBX421 -02508 * X108-RATE-YEAR DTSBX421 -02509 * DELIMITED BY SIZE DTSBX421 -02510 * INTO R140-MESSAGE DTSBX421 -02511 * END-STRING. DTSBX421 -02512 DTSBX421 -02513 CALL 'DTSBU946' USING R140-REC. DTSBX421 -02514 DTSBX421 -02515 S946-EXIT. DTSBX421 -02516 EXIT. DTSBX421 -02517 DTSBX421 -02518 S1030-WRITE-TEMP-T002. DTSBX421 -02519 DISPLAY 'S1020-WRITE-TEMP-T002' DTSBX421 -02520 MOVE T002-LENGTH TO VAR-CHAR-CNT. DTSBX421 -02521 MOVE T002-REC TO TEMP-BTC-REC. DTSBX421 -02522 WRITE TEMP-BTC-REC. DTSBX421 -02523 IF TEMP-BTC-STATUS-OK-88 DTSBX421 -02524 DISPLAY 'WROTE T002 ' DTSBX421 -02525 ** NEXT SENTENCE DTSBX421 -02526 ELSE DTSBX421 -02527 SET W-ERROR-YES-88 TO TRUE DTSBX421 -02528 DISPLAY 'CANNOT WRITE TEMP T002: ' DTSBX421 -02529 TEMP-BTC-STATUS DTSBX421 -02530 END-IF. DTSBX421 -02531 DTSBX421 -02532 S1030-EXIT. DTSBX421 -02533 EXIT. DTSBX421 -02534 DTSBX421 -02535 S1031-WRITE-TEMP-T003. DTSBX421 -02536 MOVE T003-LENGTH TO VAR-CHAR-CNT. DTSBX421 -02537 MOVE T003-REC TO TEMP-BTC-REC. DTSBX421 -02538 WRITE TEMP-BTC-REC. DTSBX421 -02539 IF TEMP-BTC-STATUS-OK-88 DTSBX421 -02540 NEXT SENTENCE DTSBX421 -02541 ELSE DTSBX421 -02542 SET W-ERROR-YES-88 TO TRUE DTSBX421 -02543 DISPLAY 'CANNOT WRITE TEMP T003: ' DTSBX421 -02544 TEMP-BTC-STATUS DTSBX421 -02545 END-IF. DTSBX421 -02546 DTSBX421 -02547 S1031-EXIT. DTSBX421 -02548 EXIT. DTSBX421 -02549 DTSBX421 -02550 S1032-WRITE-TEMP-T027. DTSBX421 -02551 MOVE T027-LENGTH TO VAR-CHAR-CNT. DTSBX421 -02552 MOVE T027-REC TO TEMP-BTC-REC. DTSBX421 -02553 WRITE TEMP-BTC-REC. DTSBX421 -02554 IF TEMP-BTC-STATUS-OK-88 DTSBX421 -02555 NEXT SENTENCE DTSBX421 -02556 ELSE DTSBX421 -02557 SET W-ERROR-YES-88 TO TRUE DTSBX421 -02558 DISPLAY 'CANNOT WRITE TEMP T027: ' DTSBX421 -02559 TEMP-BTC-STATUS DTSBX421 -02560 END-IF. DTSBX421 -02561 DTSBX421 -02562 S1032-EXIT. DTSBX421 -02563 EXIT. DTSBX421 -02564 DTSBX421 -02565 S1040-OPEN-TEMP-BTC-OUT. DTSBX421 -02566 OPEN OUTPUT TEMP-BTC-FILE. DTSBX421 -02567 IF TEMP-BTC-STATUS-OK-88 DTSBX421 -02568 NEXT SENTENCE DTSBX421 -02569 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX421 -02570 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX421 -02571 ELSE DTSBX421 -02572 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 -02573 DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: ' DTSBX421 -02574 TEMP-BTC-STATUS DTSBX421 -02575 END-IF. DTSBX421 -02576 DTSBX421 -02577 S1040-EXIT. DTSBX421 -02578 EXIT. DTSBX421 -02579 DTSBX421 -02580 S1050-OPEN-TEMP-BTC-IN. DTSBX421 -02581 OPEN INPUT TEMP-BTC-FILE. DTSBX421 -02582 IF TEMP-BTC-STATUS-OK-88 DTSBX421 -02583 NEXT SENTENCE DTSBX421 -02584 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX421 -02585 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX421 -02586 ELSE DTSBX421 -02587 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 -02588 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBX421 -02589 TEMP-BTC-STATUS DTSBX421 -02590 END-IF. DTSBX421 -02591 DTSBX421 -02592 S1050-EXIT. DTSBX421 -02593 EXIT. DTSBX421 -02594 DTSBX421 -02595 S1060-CLOSE-TEMP-BTC. DTSBX421 -02596 CLOSE TEMP-BTC-FILE. DTSBX421 -02597 IF TEMP-BTC-STATUS-OK-88 DTSBX421 -02598 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX421 -02599 NEXT SENTENCE DTSBX421 -02600 ELSE DTSBX421 -02601 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 -02602 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX421 -02603 TEMP-BTC-STATUS DTSBX421 -02604 END-IF. DTSBX421 -02605 DTSBX421 -02606 S1060-EXIT. DTSBX421 -02607 EXIT. DTSBX421 -02608 DTSBX421 -02609 S1070-READ-TEMP-BTC. DTSBX421 -02610 READ TEMP-BTC-FILE. DTSBX421 -02611 IF TEMP-BTC-STATUS-OK-88 DTSBX421 -02612 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBX421 -02613 ELSE DTSBX421 -02614 IF TEMP-BTC-STATUS-EOF-88 DTSBX421 -02615 NEXT SENTENCE DTSBX421 -02616 ELSE DTSBX421 -02617 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBX421 -02618 TEMP-BTC-STATUS DTSBX421 -02619 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 -02620 END-IF DTSBX421 -02621 END-IF. DTSBX421 -02622 DTSBX421 -02623 S1070-EXIT. DTSBX421 -02624 EXIT. DTSBX421 -02625 DTSBX421 -02626 S2000-WRITE-RPT. DTSBX421 -02627 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 -02628 DISPLAY W-EMP-NO ': ' R140-MESSAGE DTSBX421 -02629 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 -02630 ADD +1 TO WRK-R140-CNT. DTSBX421 -02631 DTSBX421 -02632 S2000-EXIT. DTSBX421 -02633 EXIT. DTSBX421 -02634 DTSBX421 -02635 DTSBX421 -02636 S3000-INIT-T003. DTSBX421 -02637 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBX421 -02638 MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBX421 -02639 SET MNTE-NTE-88 TO TRUE. DTSBX421 -02640 MOVE +0 TO MNTE-PURGE-DATE. DTSBX421 -02641 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX421 -02642 DTSBX421 -02643 MOVE LX42-SYS-DATE TO MNTE-ESTB-DATE DTSBX421 -02644 MNTE-CHNG-DATE. DTSBX421 -02645 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBX421 -02646 MNTE-DATA-ESTB-ABSTIME DTSBX421 -02647 MNTE-CHNG-ABSTIME. DTSBX421 -02648 MOVE 'WEBESSP ' TO MNTE-ESTB-OP-ID DTSBX421 -02649 MNTE-CHNG-OP-ID. DTSBX421 -02650 MOVE +0 TO MNTE-TEXT-CNT. DTSBX421 -02651 MOVE SPACES TO MNTE-TEXT-AREA. DTSBX421 -02652 DTSBX421 -02653 MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBX421 -02654 MOVE '003' TO T003-REC-TYPE. DTSBX421 -02655 MOVE W-EMP-NO TO T003-EMP-NO. DTSBX421 -02656 MOVE 'WEB REG ' TO T003-ORIGIN. DTSBX421 -02657 MOVE LX42-SYS-DATE TO T003-SYS-DATE. DTSBX421 -02658 MOVE LX42-SYS-TIME TO T003-SYS-TIME. DTSBX421 -02659 SET T003-ADD-MNTE-88 TO TRUE. DTSBX421 -02660 DTSBX421 -02661 S3000-EXIT. DTSBX421 -02662 EXIT. DTSBX421 -02663 DTSBX421 -02664 S999-ABEND. DTSBX421 -02665 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX421 -02666 S999-EXIT. DTSBX421 -02667 EXIT. DTSBX421 -02668 DTSBX421 +02164 MOVE Y108-REC TO T002-DATA-AREA. DTSBX421 +02165 SET T002-EMP-RATE-88 TO TRUE. DTSBX421 +02166 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 +02167 ADD +1 TO W-T002-RATE-CNT. CL*26 +02168 *& CL153 +02169 DISPLAY 'ESSP Y108 ' Y108-REC. CL156 +02170 DISPLAY 'ESSP RATE ' X108-EMP-NO ' ' Y108-RATE-EFF-YRQ CL154 +02171 ' ' Y108-UI-RATE. CL154 +02172 *& CL156 +02173 PERFORM P1421-SAVE-2021 THRU P1421-EXIT. CL156 +02174 *& CL153 +02175 P1420-EXIT. DTSBX421 +02176 EXIT. DTSBX421 +02177 P1421-SAVE-2021. CL156 +02178 DISPLAY 'P1421-SAVE-RATE' CL156 +02179 MOVE LOW-VALUES TO T002-REC. CL156 +02180 MOVE SPACES TO LX42-X108-EMP-NO. CL156 +02181 SET T002-LENGTH-RATE-88 TO TRUE. CL156 +02182 MOVE '002' TO T002-REC-TYPE. CL156 +02183 MOVE X108-EMP-NO TO T002-EMP-NO. CL156 +02184 MOVE 'WEB REG ' TO T002-ORIGIN. CL156 +02185 MOVE LX42-SYS-DATE TO T002-SYS-DATE. CL156 +02186 MOVE LX42-SYS-TIME TO T002-SYS-TIME. CL156 +02187 CL156 +02188 DISPLAY ' RATE YRQ ' L004-QTR-5-9 CL156 +02189 MOVE ZEROS TO Y108-RATE-EFF-YRQ. CL156 +02190 DISPLAY ' L052 YRQ ' L052-EFF-YRQ. CL156 +02191 * MOVE L052-EFF-YRQ TO Y108-RATE-EFF-YRQ. CL156 +02192 * MOVE L052-UI-RATE TO Y108-UI-RATE. CL156 +02193 CL156 +02194 MOVE 20211 TO Y108-RATE-EFF-YRQ. CL156 +02195 MOVE 27000 TO Y108-UI-RATE. CL156 +02196 CL156 +02197 MOVE Y108-REC TO T002-DATA-AREA. CL156 +02198 SET T002-EMP-RATE-88 TO TRUE. CL156 +02199 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. CL156 +02200 ADD +1 TO W-T002-RATE-CNT. CL156 +02201 *& CL156 +02202 DISPLAY 'DUTAS Y108 ' Y108-REC. CL156 +02203 DISPLAY 'DUTAS RATE ' X108-EMP-NO ' ' Y108-RATE-EFF-YRQ CL156 +02204 ' ' Y108-UI-RATE. CL156 +02205 *& CL156 +02206 *& CL156 +02207 P1421-EXIT. CL156 +02208 EXIT. CL156 +02209 DTSBX421 +02210 * DTSBX421 +02211 *P1700-RELATION. DTSBX421 +02212 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 +02213 * INITIALIZE X130-REC. DTSBX421 +02214 * MOVE +16 TO W-LAST-FIELD. DTSBX421 +02215 * MOVE +40 TO W-LAST-FIELD-LEN. DTSBX421 +02216 * PERFORM S2000-PARSE-INPUT THRU S2000-EXIT. DTSBX421 +02217 *& DTSBX421 +02218 * DISPLAY 'RELATIONSHIP'. DTSBX421 +02219 ** DISPLAY X130-REC. DTSBX421 +02220 *& DTSBX421 +02221 * DTSBX421 +02222 * IF W-PREV-REC-OPO-88 DTSBX421 +02223 * OR W-PREV-REC-REL-88 DTSBX421 +02224 * SET W-PREV-REC-REL-88 TO TRUE DTSBX421 +02225 * ADD +1 TO W-X130-CNT DTSBX421 +02226 * PERFORM P1710-EDIT-RELATION THRU P1710-EXIT DTSBX421 +02227 * IF W-ERROR-NO-88 DTSBX421 +02228 * PERFORM P1720-SAVE-REL THRU P1720-EXIT DTSBX421 +02229 * END-IF DTSBX421 +02230 * ELSE DTSBX421 +02231 * DISPLAY 'REL RECORD FOUND FOLLOWING ' DTSBX421 +02232 * W-PREV-REC-TYPE ' ' W-EMP-NO DTSBX421 +02233 * SET W-ERROR-YES-88 TO TRUE DTSBX421 +02234 * END-IF. DTSBX421 +02235 * DTSBX421 +02236 *P1700-EXIT. DTSBX421 +02237 * EXIT. DTSBX421 +02238 * DTSBX421 +02239 *P1710-EDIT-RELATION. DTSBX421 +02240 * IF X130-PRED-FEIN NOT NUMERIC DTSBX421 +02241 * DISPLAY 'REL: NON-NUMERIC FEIN ' X130-PRED-FEIN DTSBX421 +02242 * ' ' W-EMP-NO DTSBX421 +02243 * SET W-ERROR-YES-88 TO TRUE DTSBX421 +02244 *RW1 DTSBX421 +02245 * MOVE SPACES TO R140-MESSAGE DTSBX421 +02246 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02247 * STRING DTSBX421 +02248 * 'RELATION NON-NUMERIC FEIN ' X130-PRED-FEIN DTSBX421 +02249 * DELIMITED BY SIZE DTSBX421 +02250 * INTO R140-MESSAGE DTSBX421 +02251 * END-STRING DTSBX421 +02252 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02253 *RW2 DTSBX421 +02254 * ELSE DTSBX421 +02255 * MOVE X130-PRED-FEIN TO W-PRED-FEIN DTSBX421 +02256 * END-IF. DTSBX421 +02257 * DTSBX421 +02258 *** DISPLAY 'REL: EMP ' X130-PRED-EMP-NO. DTSBX421 +02259 * IF X130-PRED-EMP-NO NOT NUMERIC DTSBX421 +02260 * DISPLAY 'REL: NON-NUMERIC PRED EMP ' DTSBX421 +02261 * X130-PRED-EMP-NO ' ' W-EMP-NO DTSBX421 +02262 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 +02263 *RW1 DTSBX421 +02264 * MOVE SPACES TO R140-MESSAGE DTSBX421 +02265 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02266 * STRING DTSBX421 +02267 * 'RELATION NON-NUMERIC PRED EMP ' X130-PRED-EMP-NO DTSBX421 +02268 * DELIMITED BY SIZE DTSBX421 +02269 * INTO R140-MESSAGE DTSBX421 +02270 * END-STRING DTSBX421 +02271 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02272 * MOVE ZERO TO W-PRED-EMP-NO DTSBX421 +02273 *RW2 DTSBX421 +02274 * ELSE DTSBX421 +02275 * MOVE X130-PRED-EMP-NO TO W-PRED-EMP-NO DTSBX421 +02276 * END-IF. DTSBX421 +02277 * DTSBX421 +02278 * IF NOT X130-REL-VALID-88 DTSBX421 +02279 * DISPLAY 'REL: INVALID RELATIONSHIP CODE ' DTSBX421 +02280 * X130-RELATIONSHIP-CD ' ' W-EMP-NO DTSBX421 +02281 * SET W-ERROR-YES-88 TO TRUE DTSBX421 +02282 * END-IF. DTSBX421 +02283 * DTSBX421 +02284 * MOVE X130-EFF-DATE TO W-SLASH-DATE DTSBX421 +02285 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 +02286 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 +02287 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 +02288 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 +02289 * IF NOT L001-VALID-DATE DTSBX421 +02290 * DISPLAY 'REL: INVALID EFFECTIVE DATE ' DTSBX421 +02291 * W-EMP-NO ' ' X130-EFF-DATE DTSBX421 +02292 * SET W-ERROR-YES-88 TO TRUE DTSBX421 +02293 *RW1 DTSBX421 +02294 * MOVE SPACES TO R140-MESSAGE DTSBX421 +02295 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02296 * STRING DTSBX421 +02297 * 'RELATION INVALID EFFECTIVE DATE ' X130-EFF-DATE DTSBX421 +02298 * DELIMITED BY SIZE DTSBX421 +02299 * INTO R140-MESSAGE DTSBX421 +02300 * END-STRING DTSBX421 +02301 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02302 *RW2 DTSBX421 +02303 * ELSE DTSBX421 +02304 * MOVE L001-SLASH-8-DATE TO W-PRED-EFF-DATE DTSBX421 +02305 * END-IF. DTSBX421 +02306 * DTSBX421 +02307 * PERFORM DTSBX421 +02308 * VARYING RSUB FROM +1 BY +1 DTSBX421 +02309 * UNTIL RSUB > +6 DTSBX421 +02310 * IF RSUB = +4 DTSBX421 +02311 * IF X130-PORTION-EXP-TRNSF (RSUB:1) = '.' DTSBX421 +02312 * NEXT SENTENCE DTSBX421 +02313 * ELSE DTSBX421 +02314 * DISPLAY 'NON-NUMERIC PERCENT ' DTSBX421 +02315 * X130-PORTION-EXP-TRNSF DTSBX421 +02316 * SET W-ERROR-YES-88 TO TRUE DTSBX421 +02317 *RW1 DTSBX421 +02318 * MOVE SPACES TO R140-MESSAGE DTSBX421 +02319 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02320 * STRING DTSBX421 +02321 * 'RELATION NON-NUMERIC PERCENT ' DTSBX421 +02322 * X130-PORTION-EXP-TRNSF DTSBX421 +02323 * DELIMITED BY SIZE DTSBX421 +02324 * INTO R140-MESSAGE DTSBX421 +02325 * END-STRING DTSBX421 +02326 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02327 *RW2 DTSBX421 +02328 * END-IF DTSBX421 +02329 * ELSE DTSBX421 +02330 * IF X130-PORTION-EXP-TRNSF (RSUB:1) >= '0' DTSBX421 +02331 * OR X130-PORTION-EXP-TRNSF (RSUB:1) <= '9' DTSBX421 +02332 * NEXT SENTENCE DTSBX421 +02333 * ELSE DTSBX421 +02334 * DISPLAY 'NON-NUMERIC PERCENT ' DTSBX421 +02335 * X130-PORTION-EXP-TRNSF DTSBX421 +02336 * SET W-ERROR-YES-88 TO TRUE DTSBX421 +02337 *RW1 DTSBX421 +02338 * MOVE SPACES TO R140-MESSAGE DTSBX421 +02339 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02340 * STRING DTSBX421 +02341 * 'RELATION NON-NUMERIC PERCENT ' DTSBX421 +02342 * X130-PORTION-EXP-TRNSF DTSBX421 +02343 * DELIMITED BY SIZE DTSBX421 +02344 * INTO R140-MESSAGE DTSBX421 +02345 * END-STRING DTSBX421 +02346 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02347 *RW2 DTSBX421 +02348 * END-IF DTSBX421 +02349 * END-IF DTSBX421 +02350 * END-PERFORM. DTSBX421 +02351 * DTSBX421 +02352 * MOVE X130-PORTION-EXP-TRNSF TO W-PORTION-EXP-TRNSF-X. DTSBX421 +02353 * DTSBX421 +02354 * IF W-PRED-EMP-NO > ZERO DTSBX421 +02355 * MOVE LOW-VALUE TO MPRF-KEY-AREA DTSBX421 +02356 * MOVE X130-PRED-EMP-NO TO MPRF-EMP-NO DTSBX421 +02357 * SET MPRF-PRF-88 TO TRUE DTSBX421 +02358 * MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBX421 +02359 * PERFORM S910-READ THRU S910-EXIT DTSBX421 +02360 * IF L910-NO-REC-88 DTSBX421 +02361 * DISPLAY 'PREDECESSOR DOES NOT EXIST ' DTSBX421 +02362 * X130-PRED-EMP-NO ' ' W-EMP-NO DTSBX421 +02363 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 +02364 *RW1 DTSBX421 +02365 * MOVE SPACES TO R140-MESSAGE DTSBX421 +02366 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02367 * STRING DTSBX421 +02368 * 'RELATION PREDECESSOR DOES NOT EXIST ' DTSBX421 +02369 * X130-PRED-EMP-NO DTSBX421 +02370 * DELIMITED BY SIZE DTSBX421 +02371 * INTO R140-MESSAGE DTSBX421 +02372 * END-STRING DTSBX421 +02373 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02374 *RW2 DTSBX421 +02375 * END-IF DTSBX421 +02376 * END-IF. DTSBX421 +02377 * DTSBX421 +02378 *P1710-EXIT. DTSBX421 +02379 * EXIT. DTSBX421 +02380 * DTSBX421 +02381 *P1720-SAVE-REL. DTSBX421 +02382 * PERFORM S3000-INIT-T003 THRU S3000-EXIT. DTSBX421 +02383 * DTSBX421 +02384 * SET W-MNTE-RELATIONSHIP-88 TO TRUE DTSBX421 +02385 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 +02386 * DTSBX421 +02387 * PERFORM P1721-MOVE-TEXT THRU P1721-EXIT. DTSBX421 +02388 * DTSBX421 +02389 * MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 +02390 * DTSBX421 +02391 * PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 +02392 * DTSBX421 +02393 *& DTSBX421 +02394 * DISPLAY 'MNTE ' W-EMP-NO. DTSBX421 +02395 * PERFORM DTSBX421 +02396 * VARYING SUB FROM +1 BY +1 DTSBX421 +02397 * UNTIL SUB > MNTE-TEXT-CNT DTSBX421 +02398 * DISPLAY MNTE-TEXT (SUB) DTSBX421 +02399 * END-PERFORM. DTSBX421 +02400 *& DTSBX421 +02401 *********************************************** DTSBX421 +02402 * MOVE LOW-VALUES TO T002-REC. DTSBX421 +02403 * DTSBX421 +02404 * SET T002-LENGTH-REL-88 TO TRUE. DTSBX421 +02405 * MOVE '002' TO T002-REC-TYPE. DTSBX421 +02406 * MOVE W-EMP-NO TO T002-EMP-NO. DTSBX421 +02407 * MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 +02408 * MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 +02409 * MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 +02410 * DTSBX421 +02411 * SET T002-EMP-REL-88 TO TRUE. DTSBX421 +02412 * DTSBX421 +02413 * MOVE W-PRED-EMP-NO TO T002-PRED-EMP-NO. DTSBX421 +02414 * MOVE W-PRED-FEIN TO T002-PRED-FEIN. DTSBX421 +02415 * MOVE X130-RELATIONSHIP-CD TO T002-RELATIONSHIP-CD. DTSBX421 +02416 * COMPUTE T002-PORTION-EXP-TRNSF = DTSBX421 +02417 * (W-PORTION-EXP-TRNSF / 100). DTSBX421 +02418 * MOVE W-PRED-EFF-DATE TO T002-REL-EFF-DATE. DTSBX421 +02419 * MOVE X130-SOURCE TO T002-REL-SOURCE. DTSBX421 +02420 * MOVE X130-ENTITY-NAME TO T002-REL-NAME. DTSBX421 +02421 * DTSBX421 +02422 * MOVE X130-ATTENTION TO T002-REL-ATTN. DTSBX421 +02423 * MOVE X130-STREET-1 TO T002-REL-DELV1. DTSBX421 +02424 * MOVE X130-STREET-2 TO T002-REL-DELV2. DTSBX421 +02425 * MOVE X130-CITY TO T002-REL-CITY. DTSBX421 +02426 * MOVE X130-STATE TO T002-REL-STATE. DTSBX421 +02427 * MOVE X130-ZIP TO T002-REL-ZIP. DTSBX421 +02428 * MOVE X130-PHONE TO T002-REL-VOICE. DTSBX421 +02429 * MOVE X130-FAX TO T002-REL-FAX. DTSBX421 +02430 * MOVE X130-EMAIL TO T002-REL-EMAIL. DTSBX421 +02431 * DTSBX421 +02432 * PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 +02433 * DTSBX421 +02434 *P1720-EXIT. DTSBX421 +02435 * EXIT. DTSBX421 +02436 * DTSBX421 +02437 *P1721-MOVE-TEXT. DTSBX421 +02438 * IF X104-LIAB-RATED-88 DTSBX421 +02439 * MOVE 'R' TO W-CLASS DTSBX421 +02440 * ELSE DTSBX421 +02441 * IF X104-LIAB-SELF-INS-88 DTSBX421 +02442 * MOVE 'S' TO W-CLASS DTSBX421 +02443 * ELSE DTSBX421 +02444 * MOVE 'U' TO W-CLASS DTSBX421 +02445 * END-IF DTSBX421 +02446 * END-IF. DTSBX421 +02447 * DTSBX421 +02448 * MOVE +1 TO MNTE-TEXT-CNT. DTSBX421 +02449 * MOVE 'SUCCESSOR LIABILITY INFO: ' DTSBX421 +02450 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 +02451 * DTSBX421 +02452 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02453 * STRING 'CLASS: ' W-CLASS DTSBX421 +02454 * ' LIABILITY CODE: ' X104-LIAB-CD DTSBX421 +02455 * ' LIABILITY DATE: ' X104-FIRST-WAGE-DT DTSBX421 +02456 * DELIMITED BY SIZE DTSBX421 +02457 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02458 * END-STRING. DTSBX421 +02459 * DTSBX421 +02460 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02461 * MOVE SPACES DTSBX421 +02462 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 +02463 * DTSBX421 +02464 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02465 * MOVE 'PREDECESSOR INFO:' DTSBX421 +02466 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 +02467 * DTSBX421 +02468 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02469 * STRING 'NAME: ' X130-ENTITY-NAME DTSBX421 +02470 * DELIMITED BY SIZE DTSBX421 +02471 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02472 * END-STRING. DTSBX421 +02473 * DTSBX421 +02474 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02475 * STRING 'ACCOUNT ' W-PRED-EMP-NO DTSBX421 +02476 * ' FEIN ' W-PRED-FEIN DTSBX421 +02477 * ' RELATIONSHIP CODE: ' X130-RELATIONSHIP-CD DTSBX421 +02478 * DELIMITED BY SIZE DTSBX421 +02479 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02480 * END-STRING. DTSBX421 +02481 * DTSBX421 +02482 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02483 * STRING 'EXP TRANSFERRED: ' DTSBX421 +02484 * W-PORTION-EXP-TRNSF-X DTSBX421 +02485 * ' EFF DATE: ' DTSBX421 +02486 * W-PRED-EFF-DATE DTSBX421 +02487 * DELIMITED BY SIZE DTSBX421 +02488 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02489 * END-STRING. DTSBX421 +02490 * DTSBX421 +02491 *** ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02492 ** STRING 'TRANSFER EFFECTIVE DATE: ' DTSBX421 +02493 ** W-PRED-EFF-DATE DTSBX421 +02494 ** DELIMITED BY SIZE DTSBX421 +02495 ** INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02496 ** END-STRING. DTSBX421 +02497 ** DTSBX421 +02498 ** IF X130-ATTENTION > SPACES DTSBX421 +02499 ** ADD +1 TO MNTE-TEXT-CNT DTSBX421 +02500 ** MOVE X130-ATTENTION DTSBX421 +02501 ** TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02502 *** END-IF. DTSBX421 +02503 * DTSBX421 +02504 * IF X130-STREET-1 > SPACES DTSBX421 +02505 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 +02506 * MOVE X130-STREET-1 DTSBX421 +02507 * TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02508 * END-IF. DTSBX421 +02509 * DTSBX421 +02510 * IF X130-STREET-2 > SPACES DTSBX421 +02511 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 +02512 * MOVE X130-STREET-2 DTSBX421 +02513 * TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02514 * END-IF. DTSBX421 +02515 * DTSBX421 +02516 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 +02517 * STRING X130-CITY ', ' DTSBX421 +02518 * X130-STATE ' ' DTSBX421 +02519 * X130-ZIP DTSBX421 +02520 * DELIMITED BY SIZE DTSBX421 +02521 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02522 * END-STRING. DTSBX421 +02523 * DTSBX421 +02524 * MOVE SPACES TO WRK-PHONE DTSBX421 +02525 * WRK-PHONE-TEXT1 DTSBX421 +02526 * WRK-PHONE-TEXT2. DTSBX421 +02527 * IF X130-PHONE > SPACES DTSBX421 +02528 * MOVE X130-PHONE TO WRK-PHONE DTSBX421 +02529 * IF WRK-EXT > SPACES DTSBX421 +02530 * MOVE '-' TO WRK-EXT-HYPHEN DTSBX421 +02531 * ELSE DTSBX421 +02532 * MOVE ' ' TO WRK-EXT-HYPHEN DTSBX421 +02533 * END-IF DTSBX421 +02534 * STRING DTSBX421 +02535 * 'PHONE ' WRK-AREA-CD '-' DTSBX421 +02536 * WRK-PREFIX '-' DTSBX421 +02537 * WRK-SUFFIX DTSBX421 +02538 * WRK-EXT-HYPHEN DTSBX421 +02539 * WRK-EXT DTSBX421 +02540 * DELIMITED BY SIZE DTSBX421 +02541 * INTO WRK-PHONE-TEXT1 DTSBX421 +02542 * END-STRING DTSBX421 +02543 * END-IF. DTSBX421 +02544 * DTSBX421 +02545 * IF X130-FAX > SPACES DTSBX421 +02546 * MOVE X130-FAX TO WRK-PHONE DTSBX421 +02547 * STRING DTSBX421 +02548 * 'FAX ' WRK-AREA-CD '-' DTSBX421 +02549 * WRK-PREFIX '-' DTSBX421 +02550 * WRK-SUFFIX DTSBX421 +02551 * DELIMITED BY SIZE DTSBX421 +02552 * INTO WRK-PHONE-TEXT2 DTSBX421 +02553 * END-STRING DTSBX421 +02554 * END-IF. DTSBX421 +02555 * DTSBX421 +02556 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02557 * STRING WRK-PHONE-TEXT1 ' ' DTSBX421 +02558 * WRK-PHONE-TEXT2 DTSBX421 +02559 * DELIMITED BY SIZE DTSBX421 +02560 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02561 * END-STRING. DTSBX421 +02562 * DTSBX421 +02563 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02564 * MOVE X130-EMAIL DTSBX421 +02565 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 +02566 * DTSBX421 +02567 *P1721-EXIT. DTSBX421 +02568 * EXIT. DTSBX421 +02569 * DTSBX421 +02570 *P1800-IND-DESC. DTSBX421 +02571 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 +02572 * INITIALIZE X132-REC. DTSBX421 +02573 * MOVE +4 TO W-LAST-FIELD. DTSBX421 +02574 * MOVE +500 TO W-LAST-FIELD-LEN. DTSBX421 +02575 * PERFORM S2000-PARSE-INPUT THRU S2000-EXIT. DTSBX421 +02576 *& DTSBX421 +02577 * DISPLAY 'INDUSTRY DESCRIPTION'. DTSBX421 +02578 *& DTSBX421 +02579 * DTSBX421 +02580 * SET W-PREV-REC-IND-88 TO TRUE. DTSBX421 +02581 * ADD +1 TO W-X132-CNT. DTSBX421 +02582 * PERFORM P1820-SAVE-IND THRU P1820-EXIT. DTSBX421 +02583 * DTSBX421 +02584 *P1800-EXIT. DTSBX421 +02585 * EXIT. DTSBX421 +02586 * DTSBX421 +02587 *P1820-SAVE-IND. DTSBX421 +02588 * MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBX421 +02589 * MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBX421 +02590 * SET MNTE-NTE-88 TO TRUE. DTSBX421 +02591 * MOVE +0 TO MNTE-PURGE-DATE. DTSBX421 +02592 * SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX421 +02593 * DTSBX421 +02594 * MOVE LX42-SYS-DATE TO MNTE-ESTB-DATE DTSBX421 +02595 * MNTE-CHNG-DATE. DTSBX421 +02596 * MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBX421 +02597 * MNTE-DATA-ESTB-ABSTIME DTSBX421 +02598 * MNTE-CHNG-ABSTIME. DTSBX421 +02599 * MOVE 'WEB REG ' TO MNTE-ESTB-OP-ID DTSBX421 +02600 * MNTE-CHNG-OP-ID. DTSBX421 +02601 * MOVE +0 TO MNTE-TEXT-CNT. DTSBX421 +02602 * MOVE SPACES TO MNTE-TEXT-AREA. DTSBX421 +02603 * DTSBX421 +02604 * IF X132-SOURCE-KEY-WORD-88 DTSBX421 +02605 * SET W-MNTE-KEY-WORD-88 TO TRUE DTSBX421 +02606 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 +02607 * ELSE DTSBX421 +02608 * SET W-MNTE-DATA-ENTRY-88 TO TRUE DTSBX421 +02609 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 +02610 * END-IF. DTSBX421 +02611 * DTSBX421 +02612 * PERFORM P1821-MOVE-TEXT THRU P1821-EXIT. DTSBX421 +02613 * DTSBX421 +02614 * MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBX421 +02615 * MOVE '003' TO T003-REC-TYPE. DTSBX421 +02616 * MOVE W-EMP-NO TO T003-EMP-NO. DTSBX421 +02617 * MOVE 'WEB REG ' TO T003-ORIGIN. DTSBX421 +02618 * MOVE LX42-SYS-DATE TO T003-SYS-DATE. DTSBX421 +02619 * MOVE LX42-SYS-TIME TO T003-SYS-TIME. DTSBX421 +02620 * SET T003-ADD-MNTE-88 TO TRUE. DTSBX421 +02621 * MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 +02622 * DTSBX421 +02623 * PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 +02624 * DTSBX421 +02625 *P1820-EXIT. DTSBX421 +02626 * EXIT. DTSBX421 +02627 * DTSBX421 +02628 *P1821-MOVE-TEXT. DTSBX421 +02629 * SET W-MNTE-COMPLETE-NO-88 TO TRUE. DTSBX421 +02630 * MOVE SPACES TO W-MNTE-LINE. DTSBX421 +02631 * MOVE +0 TO W-LAST-SPACE DTSBX421 +02632 * TSUB1 DTSBX421 +02633 * TSUB2. DTSBX421 +02634 * DTSBX421 +02635 * PERFORM DTSBX421 +02636 * UNTIL W-MNTE-COMPLETE-YES-88 DTSBX421 +02637 * ADD +1 TO TSUB1 DTSBX421 +02638 * IF TSUB1 <= +500 DTSBX421 +02639 * PERFORM P1821A-MOVE-DATA THRU P1821A-EXIT DTSBX421 +02640 * ELSE DTSBX421 +02641 * SET W-MNTE-COMPLETE-YES-88 TO TRUE DTSBX421 +02642 * END-IF DTSBX421 +02643 * END-PERFORM. DTSBX421 +02644 * DTSBX421 +02645 *P1821-EXIT. DTSBX421 +02646 * EXIT. DTSBX421 +02647 * DTSBX421 +02648 *P1821A-MOVE-DATA. DTSBX421 +02649 * IF TSUB2 < +72 DTSBX421 +02650 * ADD +1 TO TSUB2 DTSBX421 +02651 * MOVE X132-IND-DESC (TSUB1:1) DTSBX421 +02652 * TO W-MNTE-LINE (TSUB2:1) DTSBX421 +02653 * IF X132-IND-DESC (TSUB1:1) = SPACE DTSBX421 +02654 * MOVE TSUB2 TO W-LAST-SPACE DTSBX421 +02655 * END-IF DTSBX421 +02656 * ELSE DTSBX421 +02657 * PERFORM P1821B-RESET THRU P1821B-EXIT DTSBX421 +02658 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 +02659 * MOVE W-MNTE-LINE TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02660 * MOVE SPACES TO W-MNTE-LINE DTSBX421 +02661 * MOVE +0 TO W-LAST-SPACE DTSBX421 +02662 * TSUB2 DTSBX421 +02663 * END-IF. DTSBX421 +02664 * DTSBX421 +02665 *** DISPLAY 'A ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX421 +02666 *P1821A-EXIT. DTSBX421 +02667 * EXIT. DTSBX421 +02668 * DTSBX421 +02669 *P1821B-RESET. DTSBX421 +02670 *** DISPLAY 'B1 ' W-LAST-SPACE ' ' TSUB1 ' ' TSUB2. DTSBX421 +02671 ************* DTSBX421 +02672 * EXIT IF THE LAST LETTER MOVED IS A SPACE, OR IF THE CURRENT DTSBX421 +02673 * LINE DOES NOT CONTAIN ANY SPACES. DTSBX421 +02674 ************* DTSBX421 +02675 * IF W-MNTE-LINE (72:1) = SPACE DTSBX421 +02676 * SUBTRACT +1 FROM TSUB1 DTSBX421 +02677 * GO TO P1821B-EXIT DTSBX421 +02678 * END-IF. DTSBX421 +02679 * DTSBX421 +02680 * IF W-LAST-SPACE = ZERO DTSBX421 +02681 * GO TO P1821B-EXIT DTSBX421 +02682 * END-IF. DTSBX421 +02683 * DTSBX421 +02684 ************* DTSBX421 +02685 * REPLACE THE LAST LETTERS WRITTEN (OCCURRING IN THE MIDDLE OF DTSBX421 +02686 * A WORD) WITH SPACES. DTSBX421 +02687 ************* DTSBX421 +02688 * PERFORM DTSBX421 +02689 * VARYING TSUB2 FROM W-LAST-SPACE BY +1 DTSBX421 +02690 * UNTIL TSUB2 > +72 DTSBX421 +02691 * MOVE SPACE TO W-MNTE-LINE (TSUB2:1) DTSBX421 +02692 * END-PERFORM. DTSBX421 +02693 * DTSBX421 +02694 ************* DTSBX421 +02695 * RESET TSUB1 TO POINT TO THE FIRST LETTER OF THE INCOMPLETED DTSBX421 +02696 * WORD. DTSBX421 +02697 ************* DTSBX421 +02698 * COMPUTE TSUB1 = TSUB1 - (73 - W-LAST-SPACE). DTSBX421 +02699 * DTSBX421 +02700 *** DISPLAY 'B2 ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX421 +02701 *P1821B-EXIT. DTSBX421 +02702 * EXIT. DTSBX421 +02703 DTSBX421 +02704 P3000-NEW-EMP. DTSBX421 +02705 DTSBX421 +02706 DISPLAY 'BX421 P3000 OLDE ' W-EMP-NO ' NEWE ' LX42-EMP-NO. CL*10 +02707 DISPLAY 'W-ERROR-IND ' W-ERROR-IND DTSBX421 +02708 IF W-EMP-IN-PROGRESS-YES-88 DTSBX421 +02709 SET W-EMP-IN-PROGRESS-NO-88 TO TRUE DTSBX421 +02710 PERFORM P3100-CHK-COMPLETION THRU P3100-EXIT DTSBX421 +02711 IF W-ERROR-NO-88 CL**8 +02712 PERFORM P3200-DETERM THRU P3200-EXIT CL*51 +02713 * PERFORM P3300-COPY-TO-BTC THRU P3300-EXIT CL*52 +02714 MOVE SPACES TO R140-MESSAGE CL*19 +02715 MOVE W-EMP-NO TO R140-EMP-NO CL*19 +02716 ADD +1 TO TOT-DUTAS-ADD-CNT CL*38 +02717 ADD +1 TO WS-X140-RED-CNT CL105 +02718 MOVE 'X421- ESSP REG PASSED >>>> ' TO X421-MESSAGE CL*90 +02719 STRING CL*19 +02720 'X421- ESSP REGISTRATION ACCEPTED BY DUTAS >>>> ' CL*85 +02721 W-EMP-NO CL*19 +02722 DELIMITED BY SIZE CL*19 +02723 INTO R140-MESSAGE CL*19 +02724 END-STRING CL*19 +02725 PERFORM S2100-WRITE-REG-RPT THRU S2100-EXIT CL*90 +02726 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*19 +02727 END-IF CL*19 +02728 END-IF. DTSBX421 +02729 PERFORM P3400-INIT-NEW-EMP THRU P3400-EXIT. DTSBX421 +02730 DTSBX421 +02731 DTSBX421 +02732 P3000-EXIT. DTSBX421 +02733 EXIT. DTSBX421 +02734 DTSBX421 +02735 P3100-CHK-COMPLETION. DTSBX421 +02736 MOVE SPACES TO X421-MESSAGE. CL*97 +02737 IF LX42-X102-EMP-NO NOT = SPACES CL*56 +02738 MOVE SPACES TO R140-MESSAGE CL*84 +02739 MOVE W-EMP-NO TO R140-EMP-NO CL*84 +02740 MOVE 'X102 ERROR - ESSP REG FAILED >' TO X421-MESSAGE CL*96 +02741 STRING CL*84 +02742 'X102- ESSP REGISTRATION FAILED (PROFILE ERROR) >>>> ' CL*86 +02743 W-EMP-NO CL*84 +02744 DELIMITED BY SIZE CL*84 +02745 INTO R140-MESSAGE CL*84 +02746 END-STRING CL*84 +02747 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*84 +02748 SET W-ERROR-YES-88 TO TRUE. CL**7 +02749 CL*84 +02750 IF LX42-X104-EMP-NO NOT = SPACES CL*56 +02751 MOVE SPACES TO R140-MESSAGE CL*84 +02752 MOVE W-EMP-NO TO R140-EMP-NO CL*84 +02753 STRING CL*84 +02754 'X104- ESSP REGISTRATION FAILED (DETERM ERROR) >>>> ' CL*86 +02755 W-EMP-NO CL*84 +02756 DELIMITED BY SIZE CL*84 +02757 INTO R140-MESSAGE CL*84 +02758 END-STRING CL*84 +02759 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*84 +02760 SET W-ERROR-YES-88 TO TRUE CL*97 +02761 IF X421-MESSAGE = SPACES CL*97 +02762 MOVE 'X104 ERROR - ESSP REG FAILED >' TO X421-MESSAGE. CL*97 +02763 CL*84 +02764 IF LX42-X106-EMP-NO NOT = SPACES CL*56 +02765 MOVE SPACES TO R140-MESSAGE CL*84 +02766 MOVE W-EMP-NO TO R140-EMP-NO CL*84 +02767 STRING CL*84 +02768 'X106- ESSP REGISTRAION FAILED (EMPL NAME ERROR) >>> ' CL*86 +02769 W-EMP-NO CL*84 +02770 DELIMITED BY SIZE CL*84 +02771 INTO R140-MESSAGE CL*84 +02772 END-STRING CL*84 +02773 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*84 +02774 SET W-ERROR-YES-88 TO TRUE CL*97 +02775 IF X421-MESSAGE = SPACES CL*97 +02776 MOVE 'X106 ERROR - ESSP REG FAILED >' TO X421-MESSAGE. CL*97 +02777 CL*84 +02778 IF LX42-X108-EMP-NO NOT = SPACES CL*79 +02779 MOVE SPACES TO R140-MESSAGE CL*84 +02780 MOVE W-EMP-NO TO R140-EMP-NO CL*84 +02781 STRING CL*84 +02782 'X108- ESSP REFISTRATION FAILED (RATE ERROR) >>>> ' CL*86 +02783 W-EMP-NO CL*84 +02784 DELIMITED BY SIZE CL*84 +02785 INTO R140-MESSAGE CL*84 +02786 END-STRING CL*84 +02787 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*84 +02788 SET W-ERROR-YES-88 TO TRUE CL*97 +02789 IF X421-MESSAGE = SPACES CL*97 +02790 MOVE 'X108 ERROR - ESSP REG FAILED >' TO X421-MESSAGE. CL*97 +02791 CL*84 +02792 IF LX42-X110-EMP-NO NOT = SPACES CL*70 +02793 MOVE SPACES TO R140-MESSAGE CL*84 +02794 MOVE W-EMP-NO TO R140-EMP-NO CL*84 +02795 STRING CL*84 +02796 'X110- ESSP REGISTRATION FAILED (ADDRESS ERROR) >>>> ' CL*86 +02797 W-EMP-NO CL*84 +02798 DELIMITED BY SIZE CL*84 +02799 INTO R140-MESSAGE CL*84 +02800 END-STRING CL*84 +02801 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*84 +02802 SET W-ERROR-YES-88 TO TRUE CL*97 +02803 IF X421-MESSAGE = SPACES CL*97 +02804 MOVE 'X110 ERROR - ESSP REG FAILED >' TO X421-MESSAGE. CL*97 +02805 CL*84 +02806 * IF LX42-X120-EMP-NO NOT = SPACES CL*71 +02807 * DISPLAY 'X120 HAS ERRORS ' W-EMP-NO CL*71 +02808 * SET W-ERROR-YES-88 TO TRUE. CL*71 +02809 CL**7 +02810 IF W-ERROR-YES-88 CL**7 +02811 MOVE SPACES TO R140-MESSAGE CL**7 +02812 MOVE W-EMP-NO TO R140-EMP-NO CL**7 +02813 ADD +1 TO TOT-DUTAS-ERR-CNT CL*38 +02814 ADD +1 TO WS-X140-ERR-CNT CL105 +02815 STRING CL**7 +02816 'X421- ****** ESSP REGISTRATION FAILED (REVIEW) ****** ' CL*85 +02817 W-EMP-NO CL**7 +02818 DELIMITED BY SIZE CL**7 +02819 INTO R140-MESSAGE CL**7 +02820 END-STRING CL**7 +02821 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**7 +02822 * MOVE 'X421- ESSP REG FAILED ****** ' TO X421-MESSAGE CL*96 +02823 PERFORM S2100-WRITE-REG-RPT THRU S2100-EXIT CL*90 +02824 END-IF. CL**7 +02825 CL**7 +02826 DISPLAY 'P3100-CHK-COMPLETION ' CL*65 +02827 GO TO P3100-EXIT. CL*67 +02828 CL*65 +02829 *** DO NOT CHECK RATES IF PREDECESSORS EXIST DTSBX421 +02830 ** IF X104-STAFF-REVIEW-YES-88 CL**9 +02831 * OR W-ERROR-YES-88 CL**9 +02832 * NEXT SENTENCE CL**9 +02833 * ELSE CL**9 +02834 * IF X104-LIAB-RATED-88 CL**9 +02835 * PERFORM P3111-CHECK-RATES THRU P3111-EXIT CL**9 +02836 * END-IF CL**9 +02837 * END-IF. CL**9 +02838 ** DISPLAY 'W-ENTITY-NAME' W-ENTITY-NAME DTSBX421 +02839 * IF W-ENTITY-NAME = SPACES CL**9 +02840 ** DISPLAY 'NO ENITITY NAME' DTSBX421 +02841 * SET W-ERROR-YES-88 TO TRUE CL**9 +02842 * MOVE SPACES TO R140-MESSAGE CL**9 +02843 * MOVE W-EMP-NO TO R140-EMP-NO CL**9 +02844 * STRING CL**9 +02845 * 'ENTITY NO ENTITY NAME FOUND ' CL**9 +02846 * W-EMP-NO CL**9 +02847 * DELIMITED BY SIZE CL**9 +02848 * INTO R140-MESSAGE CL**9 +02849 * END-STRING CL**9 +02850 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**9 +02851 * END-IF. CL**9 +02852 DTSBX421 +02853 * IF W-ERROR-YES-88 CL*65 +02854 * PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT CL*65 +02855 * IF W-FATAL-ERROR-NO-88 CL*65 +02856 * PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT CL*65 +02857 * GO TO P3100-EXIT CL*65 +02858 * ELSE CL*65 +02859 * GO TO P3100-EXIT CL*65 +02860 * END-IF CL*65 +02861 * END-IF. CL*65 +02862 ** DISPLAY 'P3100 - 2 ' W-EMP-NO ' ' W-ERROR-IND. DTSBX421 +02863 CL*66 +02864 P3100-EXIT. EXIT. CL*67 +02865 DTSBX421 +02866 P3111-CHECK-RATES. DTSBX421 +02867 DISPLAY 'P3111-CHECK-RATES ' DTSBX421 +02868 SET W-RATE-ERROR-NO-88 TO TRUE. DTSBX421 +02869 PERFORM DTSBX421 +02870 VARYING SUB FROM +1 BY +1 DTSBX421 +02871 UNTIL SUB > +5 DTSBX421 +02872 IF W-RATE-YEAR (SUB) > ZERO DTSBX421 +02873 IF W-RATE-FOUND-NO-88 (SUB) DTSBX421 +02874 SET W-RATE-ERROR-YES-88 TO TRUE DTSBX421 +02875 SET W-ERROR-YES-88 TO TRUE DTSBX421 +02876 END-IF DTSBX421 +02877 END-IF DTSBX421 +02878 END-PERFORM. DTSBX421 +02879 DTSBX421 +02880 IF W-RATE-ERROR-YES-88 DTSBX421 +02881 MOVE SPACES TO R140-MESSAGE DTSBX421 +02882 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +02883 STRING DTSBX421 +02884 'RATE SOME RATES MISSING ' DTSBX421 +02885 W-EMP-NO DTSBX421 +02886 DELIMITED BY SIZE DTSBX421 +02887 INTO R140-MESSAGE DTSBX421 +02888 END-STRING DTSBX421 +02889 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +02890 ** PERFORM DTSBX421 +02891 * VARYING SUB FROM +1 BY +1 DTSBX421 +02892 * UNTIL SUB > +5 DTSBX421 +02893 * IF W-RATE-YEAR (SUB) > ZERO DTSBX421 +02894 * DISPLAY W-RATE-YEAR (SUB) ' ' DTSBX421 +02895 * W-RATE-FOUND-IND (SUB) DTSBX421 +02896 * END-IF DTSBX421 +02897 ** END-PERFORM DTSBX421 +02898 END-IF. DTSBX421 +02899 DTSBX421 +02900 P3111-EXIT. DTSBX421 +02901 EXIT. DTSBX421 +02902 DTSBX421 +02903 P3200-DETERM. DTSBX421 +02904 * DISPLAY 'P3200-DETERM' CL*10 +02905 DISPLAY 'BX421 NEW EMP ADDED ' W-EMP-NO ' ' W-ENTITY-NAME. CL*36 +02906 DTSBX421 +02907 MOVE LOW-VALUES TO T002-REC. DTSBX421 +02908 DTSBX421 +02909 SET T002-LENGTH-DETERM-88 TO TRUE. DTSBX421 +02910 MOVE '002' TO T002-REC-TYPE. DTSBX421 +02911 MOVE W-EMP-NO TO T002-EMP-NO. DTSBX421 +02912 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 +02913 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 +02914 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 +02915 DTSBX421 +02916 DTSBX421 +02917 MOVE W-FEIN TO Y104-FEIN. DTSBX421 +02918 * MOVE X104-STAFF-REVIEW-IND TO Y104-STAFF-REVIEW-IND. CL*73 +02919 MOVE 'N' TO Y104-STAFF-REVIEW-IND. CL*73 +02920 IF W-ENTITY-NAME > SPACES CL*74 +02921 MOVE W-ENTITY-NAME TO L009-DATA CL*74 +02922 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*74 +02923 MOVE L009-DATA TO Y104-ENTITY-NAME CL*74 +02924 ELSE CL*74 +02925 MOVE W-ENTITY-NAME TO Y104-ENTITY-NAME. CL*74 +02926 CL*74 +02927 IF W-TRADE-NAME > SPACES CL*74 +02928 MOVE W-TRADE-NAME TO L009-DATA CL*74 +02929 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*74 +02930 MOVE L009-DATA TO Y104-TRADE-NAME CL*74 +02931 ELSE CL*74 +02932 MOVE W-TRADE-NAME TO Y104-TRADE-NAME. CL*74 +02933 CL*74 +02934 MOVE W-SOURCE-CD TO Y104-SOURCE-CD. DTSBX421 +02935 MOVE X104-LIAB-CD TO Y104-LIAB-CD. DTSBX421 +02936 MOVE X104-ELIG-CD TO Y104-ELIG-CD. DTSBX421 +02937 MOVE X104-NAICS-CD TO Y104-NAICS. DTSBX421 +02938 MOVE SPACES TO Y104-OWN-CD. DTSBX421 +02939 MOVE X104-ORG-TYPE TO Y104-ORG-TYPE. DTSBX421 +02940 MOVE X104-HOUSEHOLD-FILING TO Y104-HOUSEHOLD-FILING. DTSBX421 +02941 MOVE X104-INCORP-STATE TO Y104-CORP-STATE. DTSBX421 +02942 MOVE W-INCORP-DATE TO Y104-CORP-DATE. DTSBX421 +02943 MOVE W-LIABLE-DATE TO Y104-FIRST-WAGE-DT. DTSBX421 +02944 MOVE W-FIRST-500-QTR TO Y104-FIRST-500-QTR. DTSBX421 +02945 MOVE ZERO TO Y104-LAST-WAGE-DT. DTSBX421 +02946 MOVE X104-ACQUIRE-IND TO Y104-ACQUIRE-IND. DTSBX421 +02947 MOVE X104-MERGER-SPLIT-IND TO Y104-MERGE-SPLIT-IND. DTSBX421 +02948 MOVE X104-REORG-IND TO Y104-REORG-IND. DTSBX421 +02949 MOVE X104-COMMON-OWN-IND TO Y104-COMMON-OWN-IND. DTSBX421 +02950 MOVE X104-SALE-TRANSFER-IND TO Y104-SALE-TRANSFER-IND. DTSBX421 +02951 CL*79 +02952 * IF X104-ORG-HSEHLD-DMSTIC-88 CL135 +02953 MOVE 'N' TO Y104-MERGE-SPLIT-IND CL*79 +02954 Y104-REORG-IND CL*79 +02955 Y104-ACQUIRE-IND CL*79 +02956 Y104-COMMON-OWN-IND CL*79 +02957 Y104-SALE-TRANSFER-IND. CL135 +02958 * END-IF. CL135 +02959 DTSBX421 +02960 MOVE Y104-REC TO T002-DATA-AREA. DTSBX421 +02961 SET T002-DETERM-88 TO TRUE. DTSBX421 +02962 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 +02963 CL*79 +02964 *** ADD +1 TO W-T002-DETERM-CNT. CL*44 +02965 *& DTSBX421 +02966 DISPLAY 'BX421 NEW EMP LIABILITY ADDED ' W-EMP-NO ' ' CL*54 +02967 X104-HOUSEHOLD-FILING ' ' CL*54 +02968 W-LIABLE-DATE ' ' W-FIRST-500-QTR. CL*54 +02969 *& CL*54 +02970 IF NOT X104-NOT-LIAB-NULL-88 DTSBX421 +02971 PERFORM P3210-NOT-LIAB-REASON THRU P3210-EXIT DTSBX421 +02972 END-IF. DTSBX421 +02973 DTSBX421 +02974 P3200-EXIT. DTSBX421 +02975 EXIT. DTSBX421 +02976 DTSBX421 +02977 P3210-NOT-LIAB-REASON. DTSBX421 +02978 DISPLAY 'P3210-NOT-LIAB-REASON ' DTSBX421 +02979 DISPLAY 'P3210 ' W-EMP-NO ' ' X104-NOT-LIAB-REASON. DTSBX421 +02980 DTSBX421 +02981 PERFORM S3000-INIT-T003 THRU S3000-EXIT. DTSBX421 +02982 DTSBX421 +02983 SET W-MNTE-NOT-LIAB-88 TO TRUE DTSBX421 +02984 MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 +02985 DTSBX421 +02986 MOVE +1 TO MNTE-TEXT-CNT. DTSBX421 +02987 MOVE W-ENTITY-NAME DTSBX421 +02988 TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 +02989 DTSBX421 +02990 ADD +1 TO MNTE-TEXT-CNT. DTSBX421 +02991 DTSBX421 +02992 EVALUATE TRUE DTSBX421 +02993 WHEN X104-NOT-LIAB-BUS-ACT-88 DTSBX421 +02994 MOVE 'THE TYPE OF EMPLOYMENT IS NOT COVERED' DTSBX421 +02995 TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +02996 DTSBX421 +02997 WHEN X104-NOT-LIAB-NO-EMPL-88 DTSBX421 +02998 STRING 'THE BUSINESS PAYS WAGES ONLY TO ' DTSBX421 +02999 'OWNERS OR OFFICERS' DTSBX421 +03000 DELIMITED BY SIZE DTSBX421 +03001 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +03002 END-STRING DTSBX421 +03003 DTSBX421 +03004 WHEN X104-NOT-LIAB-NO-WAGES-88 DTSBX421 +03005 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 +03006 STRING 'A HOUSEHOLD EMPLOYER PAYS LESS ' DTSBX421 +03007 'THAN $500.00 EACH QUARTER' DTSBX421 +03008 DELIMITED BY SIZE DTSBX421 +03009 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +03010 END-STRING DTSBX421 +03011 ELSE DTSBX421 +03012 STRING 'THE BUSINESS DOES NOT PAY WAGES ' DTSBX421 +03013 'FOR WORK PERFORMED IN DC' DTSBX421 +03014 DELIMITED BY SIZE DTSBX421 +03015 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +03016 END-STRING DTSBX421 +03017 END-IF DTSBX421 +03018 DTSBX421 +03019 WHEN X104-NOT-LIAB-LOCALIZE-88 DTSBX421 +03020 MOVE 'THE WORK IS NOT LOCALIZED IN DC ' DTSBX421 +03021 TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 +03022 DTSBX421 +03023 END-EVALUATE. DTSBX421 +03024 DTSBX421 +03025 DTSBX421 +03026 MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 +03027 DTSBX421 +03028 PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 +03029 DTSBX421 +03030 *& DTSBX421 +03031 * DISPLAY 'NOT LIAB MNTE ' W-EMP-NO. DTSBX421 +03032 * PERFORM DTSBX421 +03033 * VARYING SUB FROM +1 BY +1 DTSBX421 +03034 * UNTIL SUB > MNTE-TEXT-CNT DTSBX421 +03035 * DISPLAY MNTE-TEXT (SUB) DTSBX421 +03036 * END-PERFORM. DTSBX421 +03037 *& DTSBX421 +03038 P3210-EXIT. DTSBX421 +03039 EXIT. DTSBX421 +03040 DTSBX421 +03041 *P3300-COPY-TO-BTC. CL*63 +03042 * DISPLAY 'P3300-COPY-TO-BTC ' CL*63 +03043 * DISPLAY 'BX421 COMPLETE ' W-EMP-NO. CL*63 +03044 * PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. CL*63 +03045 * IF W-FATAL-ERROR-NO-88 CL*63 +03046 * IF W-ERROR-NO-88 CL*63 +03047 * PERFORM P3310-COPY-TO-BTC THRU P3310-EXIT CL*63 +03048 * END-IF CL*63 +03049 * ELSE CL*63 +03050 * DISPLAY 'P3300 FATAL ERR ON CLOSE' CL*63 +03051 * GO TO P3300-EXIT CL*63 +03052 * END-IF. CL*63 +03053 DTSBX421 +03054 * IF NOT LX42-TERMINATE-88 CL*63 +03055 * PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT CL*63 +03056 * END-IF. CL*63 +03057 DTSBX421 +03058 *P3300-EXIT. CL*63 +03059 EXIT. DTSBX421 +03060 DTSBX421 +03061 *P3310-COPY-TO-BTC. CL*64 +03062 * DISPLAY 'P3310-COPY-TO-BTC ' CL*64 +03063 * PERFORM S1050-OPEN-TEMP-BTC-IN THRU S1050-EXIT CL*64 +03064 * IF W-FATAL-ERROR-YES-88 CL*64 +03065 * GO TO P3310-EXIT CL*64 +03066 * END-IF. CL*64 +03067 DTSBX421 +03068 * PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT. CL*64 +03069 DTSBX421 +03070 * PERFORM CL*64 +03071 * UNTIL TEMP-BTC-STATUS-EOF-88 CL*64 +03072 * OR W-FATAL-ERROR-YES-88 CL*64 +03073 * PERFORM S927B-WRITE THRU S927B-EXIT CL*64 +03074 * PERFORM P3311-COUNT THRU P3311-EXIT CL*64 +03075 * PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT CL*64 +03076 * END-PERFORM. CL*64 +03077 DTSBX421 +03078 * PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. CL*64 +03079 DTSBX421 +03080 *P3310-EXIT. CL*64 +03081 * EXIT. CL*64 +03082 DTSBX421 +03083 P3311-COUNT. DTSBX421 +03084 IF TSKL-NOTEPAD-88 DTSBX421 +03085 ADD +1 TO W-T003-WRITE-CNT DTSBX421 +03086 GO TO P3311-EXIT DTSBX421 +03087 END-IF. DTSBX421 +03088 DTSBX421 +03089 MOVE TEMP-BTC-REC TO T002-REC. DTSBX421 +03090 ADD +1 TO W-T002-WRITE-CNT. DTSBX421 +03091 DTSBX421 +03092 EVALUATE TRUE DTSBX421 +03093 WHEN T002-DETERM-88 DTSBX421 +03094 ADD +1 TO W-T002-DETERM-CNT DTSBX421 +03095 DTSBX421 +03096 WHEN T002-EMP-NAME-88 DTSBX421 +03097 ADD +1 TO W-T002-NAME-CNT DTSBX421 +03098 DTSBX421 +03099 WHEN T002-EMP-RATE-88 DTSBX421 +03100 ADD +1 TO W-T002-RATE-CNT DTSBX421 +03101 DTSBX421 +03102 WHEN T002-EMP-ADDR-88 DTSBX421 +03103 ADD +1 TO W-T002-ADDR-CNT DTSBX421 +03104 DTSBX421 +03105 WHEN T002-CONTACT-88 DTSBX421 +03106 ADD +1 TO W-T002-OPO-CNT DTSBX421 +03107 DTSBX421 +03108 WHEN T002-EMP-REL-88 DTSBX421 +03109 ADD +1 TO W-T002-REL-CNT DTSBX421 +03110 DTSBX421 +03111 END-EVALUATE. DTSBX421 +03112 DTSBX421 +03113 P3311-EXIT. DTSBX421 +03114 EXIT. DTSBX421 +03115 DTSBX421 +03116 P3400-INIT-NEW-EMP. DTSBX421 +03117 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX421 +03118 SET W-ERROR-NO-88 TO TRUE. DTSBX421 +03119 SET W-PREV-REC-NULL-88 TO TRUE. DTSBX421 +03120 MOVE ZERO TO W-LIABLE-DATE DTSBX421 +03121 W-INCORP-DATE DTSBX421 +03122 W-WAGES-PLANNED-DATE DTSBX421 +03123 W-FIRST-500-QTR DTSBX421 +03124 W-FEIN. DTSBX421 +03125 DTSBX421 +03126 MOVE SPACES TO W-ENTITY-NAME DTSBX421 +03127 W-TRADE-NAME DTSBX421 +03128 W-SOURCE-CD DTSBX421 +03129 W-FIELD-ZIP DTSBX421 +03130 W-FIELD-STATE CL*56 +03131 LX42-X104-LIAB-CD. CL*56 +03132 MOVE '888888' TO LX42-X102-EMP-NO CL*57 +03133 LX42-X104-EMP-NO CL**4 +03134 LX42-X106-EMP-NO CL**4 +03135 LX42-X108-EMP-NO CL**4 +03136 LX42-X110-EMP-NO CL**4 +03137 LX42-X120-EMP-NO. CL*56 +03138 * LX42-X140-EMP-NO CL*45 +03139 * LX42-X144-EMP-NO CL*45 +03140 * LX42-X145-EMP-NO. CL*56 +03141 CL**4 +03142 INITIALIZE X102-REC DTSBX421 +03143 X104-REC DTSBX421 +03144 X106-REC DTSBX421 +03145 X108-REC DTSBX421 +03146 X110-REC DTSBX421 +03147 X120-REC DTSBX421 +03148 X130-REC. DTSBX421 +03149 PERFORM DTSBX421 +03150 VARYING SUB FROM +1 BY +1 DTSBX421 +03151 UNTIL SUB > +5 DTSBX421 +03152 MOVE ZERO TO W-RATE-YEAR (SUB) DTSBX421 +03153 SET W-RATE-FOUND-NO-88 (SUB) TO TRUE DTSBX421 +03154 END-PERFORM. DTSBX421 +03155 DTSBX421 +03156 P3400-EXIT. DTSBX421 +03157 EXIT. DTSBX421 +03158 DTSBX421 +03159 DTSBX421 +03160 T0000-TERMINATE. DTSBX421 +03161 DISPLAY ' '. DTSBX421 +03162 DTSBX421 +03163 DISPLAY '***************************************'. CL*44 +03164 DISPLAY '*** DTSBX421 TERMINATION STATISTICS ***'. DTSBX421 +03165 DISPLAY '*** EMPLOYER REGISTRATION ***'. DTSBX421 +03166 DISPLAY '***************************************'. CL*44 +03167 DTSBX421 +03168 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX421 +03169 DTSBX421 +03170 DISPLAY ' '. DTSBX421 +03171 MOVE WS-X140-RED-CNT TO WS-X102-RED-CNT CL106 +03172 MOVE WS-X140-ERR-CNT TO WS-X102-ERR-CNT CL106 +03173 MOVE WS-X140-PEN-CNT TO WS-X102-PEN-CNT CL107 +03174 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 2 CL106 +03175 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1 CL106 +03176 WRITE REPT-PAID-REC FROM FOOTING-LINE-51 AFTER 1 CL107 +03177 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1 CL107 +03178 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1 CL106 +03179 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1 CL106 +03180 DTSBX421 +03181 CLOSE TEMP-BTC-FILE. DTSBX421 +03182 DTSBX421 +03183 DTSBX421 +03184 T0000-EXIT. DTSBX421 +03185 EXIT. DTSBX421 +03186 DTSBX421 +03187 T2000-DISPLAY-TOTALS. DTSBX421 +03188 DISPLAY ' ' CL*38 +03189 DISPLAY 'X102- PROFILE RECORDS READ :' W-X102-RED-CNT. CL*38 +03190 DISPLAY ' X102-PROFILE RECORDS ERROR :' W-X102-ERR-CNT. CL*38 +03191 DISPLAY ' X102-PROFILE RECORDS DUP :' W-X102-DUP-CNT. CL*38 +03192 DISPLAY ' X102-PROFILE RECORDS SAVED :' W-X102-SAV-CNT. CL*38 +03193 DISPLAY ' ' CL*38 +03194 DISPLAY 'X104- DETERM RECORDS READ :' W-X104-RED-CNT. CL*38 +03195 DISPLAY ' X104-DETERM RECORDS ERROR :' W-X104-ERR-CNT. CL*38 +03196 DISPLAY ' X104-DETERM RECORDS DUP :' W-X104-DUP-CNT. CL*38 +03197 DISPLAY ' X104-DETERM RECORDS SAVED :' W-X104-SAV-CNT. CL*38 +03198 DISPLAY ' ' CL*38 +03199 DISPLAY 'X106- EMPNAME RECORDS READ : ' W-X106-RED-CNT. CL*38 +03200 DISPLAY ' X106-EMPNAME RECORDS ERROR : ' W-X106-ERR-CNT. CL*38 +03201 DISPLAY ' X106-EMPNAME RECORDS DUP : ' W-X106-DUP-CNT. CL*38 +03202 DISPLAY ' X106-EMPNAME RECORDS SAVED : ' W-X106-SAV-CNT. CL*38 +03203 DISPLAY ' ' CL*38 +03204 DISPLAY 'X108- RATE RECORDS READ : ' W-X108-RED-CNT. CL*38 +03205 DISPLAY ' X108-RATE RECORDS ERROR : ' W-X108-ERR-CNT. CL*38 +03206 DISPLAY ' X108-RATE RECORDS DUP : ' W-X108-DUP-CNT. CL*38 +03207 DISPLAY ' X108-RATE RECORDS SAVED : ' W-X108-SAV-CNT. CL*38 +03208 DISPLAY ' ' CL*38 +03209 DISPLAY 'TOTAL- DUTAS EMPLOYERS CREATED : ' CL*44 +03210 W-T002-DETERM-CNT. DTSBX421 +03211 DTSBX421 +03212 * DISPLAY 'TOTAL OUTPUT T002 RECORDS WRITTEN: ' CL*44 +03213 * W-T002-WRITE-CNT. CL*44 +03214 CL*25 +03215 * DISPLAY 'TOTAL OUTPUT T003 RECORDS WRITTEN ' CL*44 +03216 * W-T003-WRITE-CNT. CL*44 +03217 DTSBX421 +03218 DISPLAY ' '. DTSBX421 +03219 DISPLAY '*********** END REGISTRATION ************ '. CL*44 +03220 DTSBX421 +03221 T2000-EXIT. DTSBX421 +03222 EXIT. DTSBX421 +03223 DTSBX421 +03224 S001-FROM-FED-8. DTSBX421 +03225 SET L001-FROM-FED-8 TO TRUE. DTSBX421 +03226 GO TO S001-DATE. DTSBX421 +03227 DTSBX421 +03228 S001-FROM-CAL-8. DTSBX421 +03229 SET L001-FROM-CAL-8 TO TRUE. DTSBX421 +03230 GO TO S001-DATE. DTSBX421 +03231 DTSBX421 +03232 S001-FROM-ABS-DAY. DTSBX421 +03233 SET L001-FROM-ABS-DAY TO TRUE. DTSBX421 +03234 GO TO S001-DATE. DTSBX421 +03235 DTSBX421 +03236 S001-DATE. DTSBX421 +03237 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX421 +03238 S001-EXIT. DTSBX421 +03239 EXIT. DTSBX421 +03240 DTSBX421 +03241 S003-AGENCY-DAY. DTSBX421 +03242 SET L003-AGENCY-DAY TO TRUE. DTSBX421 +03243 GO TO S003-WORK-DAY. DTSBX421 +03244 DTSBX421 +03245 S003-WORK-DAY. DTSBX421 +03246 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX421 +03247 S003-EXIT. DTSBX421 +03248 EXIT. DTSBX421 +03249 DTSBX421 +03250 S004-FROM-5. DTSBX421 +03251 SET L004-FROM-5 TO TRUE. DTSBX421 +03252 GO TO S004-YRQ. DTSBX421 +03253 DTSBX421 +03254 S004-FROM-DATE. DTSBX421 +03255 SET L004-FROM-DATE TO TRUE. DTSBX421 +03256 GO TO S004-YRQ. DTSBX421 +03257 DTSBX421 +03258 S004-FROM-ABS. DTSBX421 +03259 SET L004-FROM-ABS TO TRUE. DTSBX421 +03260 GO TO S004-YRQ. DTSBX421 +03261 DTSBX421 +03262 S004-YRQ. DTSBX421 +03263 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX421 +03264 DTSBX421 +03265 S004-EXIT. DTSBX421 +03266 EXIT. DTSBX421 +03267 S009-CONVERT-TO-CAPS. CL*74 +03268 CL*74 +03269 CALL 'DTSBU009' USING L009-LINK-AREA. CL*74 +03270 CL*74 +03271 S009-EXIT. CL*74 +03272 EXIT. CL*74 +03273 CL*74 +03274 DTSBX421 +03275 S052-UI-RATE-EDIT. DTSBX421 +03276 CALL 'DTSBU052' USING L052-LINK-AREA. DTSBX421 +03277 DTSBX421 +03278 S052-EXIT. DTSBX421 +03279 EXIT. DTSBX421 +03280 DTSBX421 +03281 S072-ADDRESS. DTSBX421 +03282 CALL 'DTSBU072' USING L072-LINK-AREA. DTSBX421 +03283 DTSBX421 +03284 S072-EXIT. DTSBX421 +03285 EXIT. DTSBX421 +03286 DTSBX421 +03287 S516-LIABILITY-INFO. DTSBX421 +03288 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX421 +03289 MPRF-REC. DTSBX421 +03290 S516-EXIT. DTSBX421 +03291 EXIT. DTSBX421 +03292 DTSBX421 +03293 *S910-OPEN-READ. DTSBX421 +03294 * SET L910-OPEN-READ-88 TO TRUE. DTSBX421 +03295 * GO TO S910-MSTR-IO. DTSBX421 +03296 DTSBX421 +03297 S910-READ. DTSBX421 +03298 SET L910-READ-88 TO TRUE. DTSBX421 +03299 GO TO S910-MSTR-IO. DTSBX421 +03300 DTSBX421 +03301 S910-START-BROWSE. DTSBX421 +03302 SET L910-START-BROWSE-88 TO TRUE. DTSBX421 +03303 GO TO S910-MSTR-IO. DTSBX421 +03304 DTSBX421 +03305 S910-READ-NEXT. DTSBX421 +03306 SET L910-READ-NEXT-88 TO TRUE. DTSBX421 +03307 GO TO S910-MSTR-IO. DTSBX421 +03308 DTSBX421 +03309 *S910-CLOSE. DTSBX421 +03310 * SET L910-CLOSE-88 TO TRUE. DTSBX421 +03311 * GO TO S910-MSTR-IO. DTSBX421 +03312 DTSBX421 +03313 S910-MSTR-IO. DTSBX421 +03314 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX421 +03315 MSKL-REC. DTSBX421 +03316 S910-EXIT. DTSBX421 +03317 EXIT. DTSBX421 +03318 DTSBX421 +03319 S921-OPEN-READ. DTSBX421 +03320 SET L921-OPEN-READ-88 TO TRUE. DTSBX421 +03321 GO TO S921-AIX-IO. DTSBX421 +03322 DTSBX421 +03323 S921-READ. DTSBX421 +03324 SET L921-READ-88 TO TRUE. DTSBX421 +03325 GO TO S921-AIX-IO. DTSBX421 +03326 DTSBX421 +03327 S921-START-BROWSE. DTSBX421 +03328 SET L921-START-BROWSE-88 TO TRUE. DTSBX421 +03329 GO TO S921-AIX-IO. DTSBX421 +03330 DTSBX421 +03331 S921-READ-NEXT. DTSBX421 +03332 SET L921-READ-NEXT-88 TO TRUE. DTSBX421 +03333 GO TO S921-AIX-IO. DTSBX421 +03334 DTSBX421 +03335 S921-CLOSE. DTSBX421 +03336 SET L921-CLOSE-88 TO TRUE. DTSBX421 +03337 GO TO S921-AIX-IO. DTSBX421 +03338 DTSBX421 +03339 S921-AIX-IO. DTSBX421 +03340 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX421 +03341 ISKL-REC. DTSBX421 +03342 S921-EXIT. DTSBX421 +03343 EXIT. DTSBX421 +03344 DTSBX421 +03345 *S927A-OPEN. DTSBX421 +03346 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX421 +03347 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 +03348 * DTSBX421 +03349 *S927A-EXIT. DTSBX421 +03350 * EXIT. DTSBX421 +03351 DTSBX421 +03352 S927B-WRITE. DTSBX421 +03353 SET L927-WRITE-88 TO TRUE. DTSBX421 +03354 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 +03355 DTSBX421 +03356 S927B-EXIT. DTSBX421 +03357 EXIT. DTSBX421 +03358 DTSBX421 +03359 *S927C-CLOSE. DTSBX421 +03360 * SET L927-CLOSE-88 TO TRUE. DTSBX421 +03361 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 +03362 * DTSBX421 +03363 *S927C-EXIT. DTSBX421 +03364 * EXIT. DTSBX421 +03365 DTSBX421 +03366 S927Z-IO. DTSBX421 +03367 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX421 +03368 TSKL-REC. DTSBX421 +03369 S927Z-EXIT. DTSBX421 +03370 EXIT. DTSBX421 +03371 DTSBX421 +03372 *S931-OPEN-READ. DTSBX421 +03373 * SET L931-OPEN-READ-88 TO TRUE. DTSBX421 +03374 * GO TO S931-REF-IO. DTSBX421 +03375 * DTSBX421 +03376 *S931-CLOSE. DTSBX421 +03377 * SET L931-CLOSE-88 TO TRUE. DTSBX421 +03378 * GO TO S931-REF-IO. DTSBX421 +03379 * DTSBX421 +03380 *S931-REF-IO. DTSBX421 +03381 * CALL 'DTSBU931' USING L931-LINK-AREA DTSBX421 +03382 * FSKL-REC. DTSBX421 +03383 *S931-EXIT. DTSBX421 +03384 * EXIT. DTSBX421 +03385 DTSBX421 +03386 S946-WRITE-R140. DTSBX421 +03387 * MOVE SPACES TO R140-MESSAGE DTSBX421 +03388 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +03389 * STRING DTSBX421 +03390 * MSG1-TYPE ' - ' DTSBX421 +03391 * MSG1-MESSAGE ': ' DTSBX421 +03392 * X108-RATE-YEAR DTSBX421 +03393 * DELIMITED BY SIZE DTSBX421 +03394 * INTO R140-MESSAGE DTSBX421 +03395 * END-STRING. DTSBX421 +03396 DTSBX421 +03397 CALL 'DTSBU946' USING R140-REC. DTSBX421 +03398 DTSBX421 +03399 S946-EXIT. DTSBX421 +03400 EXIT. DTSBX421 +03401 DTSBX421 +03402 S1030-WRITE-TEMP-T002. DTSBX421 +03403 DISPLAY 'S1020-WRITE-TEMP-T002' DTSBX421 +03404 MOVE T002-LENGTH TO VAR-CHAR-CNT. DTSBX421 +03405 MOVE T002-REC TO TEMP-BTC-REC. DTSBX421 +03406 WRITE TEMP-BTC-REC. DTSBX421 +03407 IF TEMP-BTC-STATUS-OK-88 DTSBX421 +03408 DISPLAY 'WROTE PROFILE T002 EMP REC X421 ' W-EMP-NO CL*62 +03409 ELSE DTSBX421 +03410 SET W-ERROR-YES-88 TO TRUE DTSBX421 +03411 DISPLAY 'CANNOT WRITE TEMP T002: ' DTSBX421 +03412 TEMP-BTC-STATUS DTSBX421 +03413 END-IF. DTSBX421 +03414 DTSBX421 +03415 S1030-EXIT. DTSBX421 +03416 EXIT. DTSBX421 +03417 DTSBX421 +03418 S1031-WRITE-TEMP-T003. DTSBX421 +03419 MOVE T003-LENGTH TO VAR-CHAR-CNT. DTSBX421 +03420 MOVE T003-REC TO TEMP-BTC-REC. DTSBX421 +03421 WRITE TEMP-BTC-REC. DTSBX421 +03422 IF TEMP-BTC-STATUS-OK-88 DTSBX421 +03423 NEXT SENTENCE DTSBX421 +03424 ELSE DTSBX421 +03425 SET W-ERROR-YES-88 TO TRUE DTSBX421 +03426 DISPLAY 'CANNOT WRITE TEMP T003: ' DTSBX421 +03427 TEMP-BTC-STATUS DTSBX421 +03428 END-IF. DTSBX421 +03429 DTSBX421 +03430 S1031-EXIT. DTSBX421 +03431 EXIT. DTSBX421 +03432 DTSBX421 +03433 S1032-WRITE-TEMP-T027. DTSBX421 +03434 MOVE T027-LENGTH TO VAR-CHAR-CNT. DTSBX421 +03435 MOVE T027-REC TO TEMP-BTC-REC. DTSBX421 +03436 WRITE TEMP-BTC-REC. DTSBX421 +03437 IF TEMP-BTC-STATUS-OK-88 DTSBX421 +03438 NEXT SENTENCE DTSBX421 +03439 ELSE DTSBX421 +03440 SET W-ERROR-YES-88 TO TRUE DTSBX421 +03441 DISPLAY 'CANNOT WRITE TEMP T027: ' DTSBX421 +03442 TEMP-BTC-STATUS DTSBX421 +03443 END-IF. DTSBX421 +03444 DTSBX421 +03445 S1032-EXIT. DTSBX421 +03446 EXIT. DTSBX421 +03447 DTSBX421 +03448 S1040-OPEN-TEMP-BTC-OUT. DTSBX421 +03449 OPEN OUTPUT TEMP-BTC-FILE. DTSBX421 +03450 IF TEMP-BTC-STATUS-OK-88 DTSBX421 +03451 NEXT SENTENCE DTSBX421 +03452 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX421 +03453 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX421 +03454 ELSE DTSBX421 +03455 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 +03456 DISPLAY 'CANNOT OPEN TEMP X421BTC FILE OUTPUT: ' CL*53 +03457 TEMP-BTC-STATUS DTSBX421 +03458 END-IF. DTSBX421 +03459 DTSBX421 +03460 S1040-EXIT. DTSBX421 +03461 EXIT. DTSBX421 +03462 DTSBX421 +03463 *S1050-OPEN-TEMP-BTC-IN. CL*62 +03464 * OPEN INPUT TEMP-BTC-FILE. CL*62 +03465 * IF TEMP-BTC-STATUS-OK-88 CL*62 +03466 * NEXT SENTENCE CL*62 +03467 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX421 +03468 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX421 +03469 * ELSE CL*62 +03470 * SET W-FATAL-ERROR-YES-88 TO TRUE CL*62 +03471 * DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' CL*62 +03472 * TEMP-BTC-STATUS CL*62 +03473 * END-IF. CL*62 +03474 DTSBX421 +03475 *S1050-EXIT. CL*62 +03476 * EXIT. CL*62 +03477 DTSBX421 +03478 S1060-CLOSE-TEMP-BTC. DTSBX421 +03479 CLOSE TEMP-BTC-FILE. DTSBX421 +03480 IF TEMP-BTC-STATUS-OK-88 DTSBX421 +03481 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX421 +03482 NEXT SENTENCE DTSBX421 +03483 ELSE DTSBX421 +03484 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 +03485 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX421 +03486 TEMP-BTC-STATUS DTSBX421 +03487 END-IF. DTSBX421 +03488 DTSBX421 +03489 S1060-EXIT. DTSBX421 +03490 EXIT. DTSBX421 +03491 DTSBX421 +03492 *S1070-READ-TEMP-BTC. CL*62 +03493 * READ TEMP-BTC-FILE. CL*62 +03494 * IF TEMP-BTC-STATUS-OK-88 CL*62 +03495 * COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) CL*62 +03496 * ELSE CL*62 +03497 * IF TEMP-BTC-STATUS-EOF-88 CL*62 +03498 * NEXT SENTENCE CL*62 +03499 * ELSE CL*62 +03500 * DISPLAY 'CANNOT READ TEMP-BTC FILE ' CL*62 +03501 * TEMP-BTC-STATUS CL*62 +03502 * SET W-FATAL-ERROR-YES-88 TO TRUE CL*62 +03503 * END-IF CL*62 +03504 * END-IF. CL*62 +03505 * CL*62 +03506 *S1070-EXIT. CL*62 +03507 EXIT. DTSBX421 +03508 DTSBX421 +03509 S2000-WRITE-RPT. DTSBX421 +03510 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 +03511 DISPLAY W-EMP-NO ': ' R140-MESSAGE DTSBX421 +03512 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 +03513 ADD +1 TO WRK-R140-CNT. DTSBX421 +03514 DTSBX421 +03515 S2000-EXIT. DTSBX421 +03516 EXIT. DTSBX421 +03517 DTSBX421 +03518 S2100-WRITE-REG-RPT. CL*90 +03519 IF X104-LIAB-SELF-INS-88 CL*95 +03520 MOVE 'S' TO X421-CLASS CL*95 +03521 ELSE CL*95 +03522 MOVE 'R' TO X421-CLASS. CL*95 +03523 CL*95 +03524 IF X104-ORG-HSEHLD-DMSTIC-88 CL100 +03525 MOVE 'Y' TO X421-HHOLD CL100 +03526 ELSE CL100 +03527 MOVE 'N' TO X421-HHOLD. CL100 +03528 CL100 +03529 IF X104-HH-ANNUAL-88 CL107 +03530 MOVE 'A' TO X104-HOUSEHOLD-FILING CL107 +03531 ELSE CL107 +03532 MOVE 'Q' TO X104-HOUSEHOLD-FILING. CL107 +03533 CL107 +03534 MOVE W-EMP-NO TO X421-EMP-NO CL107 +03535 MOVE W-FEIN TO X421-FEIN CL107 +03536 MOVE X104-ORG-TYPE TO X421-ORG-TYPE CL*90 +03537 MOVE X104-LIAB-CD TO X421-LIAB-CD CL*90 +03538 MOVE X104-ELIG-CD TO X421-ELIG-CD CL*90 +03539 MOVE X104-HOUSEHOLD-FILING TO X421-FILING CL110 +03540 MOVE X106-EMP-NAME TO W-X421-NAME CL163 +03541 INSPECT W-X421-NAME REPLACING ALL ',' BY SPACE CL163 +03542 MOVE W-X421-NAME TO X421-NAME CL163 +03543 MOVE X104-FIRST-WAGE-DT TO X421-PAID CL102 +03544 MOVE X108-RATE-YEAR (1:4) TO X421-RATYR CL102 +03545 MOVE X108-RATE TO X421-RATE CL102 +03546 CL*90 +03547 WRITE REPT-PAID-REC FROM DETAIL-LINE-1. CL*91 +03548 CL*90 +03549 S2100-EXIT. CL*90 +03550 EXIT. CL*90 +03551 CL*90 +03552 DTSBX421 +03553 S3000-INIT-T003. DTSBX421 +03554 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBX421 +03555 MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBX421 +03556 SET MNTE-NTE-88 TO TRUE. DTSBX421 +03557 MOVE +0 TO MNTE-PURGE-DATE. DTSBX421 +03558 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX421 +03559 DTSBX421 +03560 MOVE LX42-SYS-DATE TO MNTE-ESTB-DATE DTSBX421 +03561 MNTE-CHNG-DATE. DTSBX421 +03562 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBX421 +03563 MNTE-DATA-ESTB-ABSTIME DTSBX421 +03564 MNTE-CHNG-ABSTIME. DTSBX421 +03565 MOVE 'WEBESSP ' TO MNTE-ESTB-OP-ID DTSBX421 +03566 MNTE-CHNG-OP-ID. DTSBX421 +03567 MOVE +0 TO MNTE-TEXT-CNT. DTSBX421 +03568 MOVE SPACES TO MNTE-TEXT-AREA. DTSBX421 +03569 DTSBX421 +03570 MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBX421 +03571 MOVE '003' TO T003-REC-TYPE. DTSBX421 +03572 MOVE W-EMP-NO TO T003-EMP-NO. DTSBX421 +03573 MOVE 'WEB REG ' TO T003-ORIGIN. DTSBX421 +03574 MOVE LX42-SYS-DATE TO T003-SYS-DATE. DTSBX421 +03575 MOVE LX42-SYS-TIME TO T003-SYS-TIME. DTSBX421 +03576 SET T003-ADD-MNTE-88 TO TRUE. DTSBX421 +03577 DTSBX421 +03578 S3000-EXIT. DTSBX421 +03579 EXIT. DTSBX421 +03580 DTSBX421 +03581 S999-ABEND. DTSBX421 +03582 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX421 +03583 S999-EXIT. DTSBX421 +03584 EXIT. DTSBX421 +03585 DTSBX421 diff --git a/Batch/DTSBX426.cob b/Batch/DTSBX426.cob index b2ab938..fd31552 100644 --- a/Batch/DTSBX426.cob +++ b/Batch/DTSBX426.cob @@ -1,1610 +1,1544 @@ -00001 IDENTIFICATION DIVISION. 04/20/20 +00001 IDENTIFICATION DIVISION. 09/14/25 00002 PROGRAM-ID. DTSBX426. DTSBX426 -00003 AUTHOR. NGC. LV159 +00003 AUTHOR. NGC. LV149 00004 DATE-WRITTEN. SEPT 2013. CL**2 00005 DATE-COMPILED. DTSBX426 00006 SKIP3 DTSBX426 -00007 ***** DTSBX426 -00008 * FUNCTION: READ A DAILY FILE FROM THE AUTOMATED CLEARING HOUSEDTSBX426 -00009 * THAT CONTAINS RECORDS FOR DISHONORED ELECTRONIC DTSBX426 -00010 * PAYMENTS. IT BUILDS DTSIT025 PAYMENT REVERSAL DTSBX426 -00011 * TRANSACTION RECORDS AND WRITES THESE RECORDS DTSBX426 -00012 * TO THE DAILY BTC FILE WHICH IS INPUT TO THE NIGHTLYDTSBX426 -00013 * ACCOUNTING UPDATE. DTSBX426 -00014 ** DTSBX426 -00015 ** 04/16/2015 PER UI CHIEF DO NOT CHARGE 65.00 RETURN FEE CL*77 -00016 ** FOR ACH RETURNS LESS THAN 15.00 ZL1 CL*77 -00017 ** CL*77 -00018 ** 04/21/2015 ALL ACH RETURN TRANSACTIONS WILL BE AUTO REVERSD CL109 -00019 ** ALL EMPLOYERS WITH SAME TRACE NO WILL BE CHARGED CL109 -00020 ** A 65.00 RETURN FEE. AN EMPLOYER WITH MULTIPLE ACH CL109 -00021 ** TRANSACTIONS WITH SAME TRACE NO WILL HAVE ONLY ONE CL109 -00022 ** 65.00 RETURN CHARGE FEE ZL1 CL109 -00023 SKIP3 DTSBX426 -00024 ** 04/27/2015 ALL ACH RETURN TRANSACTIONS WILL BE AUTO REVERSD CL120 -00025 ** ALL EMPLOYERS WITH SAME TRACE NO WILL BE CHARGED CL120 -00026 ** A 65.00 RETURN FEE. AN EMPLOYER WITH MULTIPLE ACH CL120 -00027 ** TRANSACTIONS WITH SAME TRACE NO WILL HAVE ONLY ONE CL120 -00028 ** 65.00 RETURN CHARGE FEE. ALL TRANSACTIONS WILL HAVE CL120 -00029 ** THE NG TRANSACTION TYPE. ZL1 CL120 -00030 SKIP3 CL120 -00031 ** 02/13/2020 CREATE PRINT RECORDS IR333 TO PRINT ACH RETURNED CL153 -00032 ** NOTICE FOR EMPLOYERS. ZL1 CL153 -00033 SKIP3 CL153 -00034 ENVIRONMENT DIVISION. DTSBX426 -00035 CONFIGURATION SECTION. CL*12 -00036 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*12 -00037 CL*12 -00038 INPUT-OUTPUT SECTION. DTSBX426 +00007 *****THIS COPY HAS BEEN MOVED TO RAINCODE - 09/14/2025 **** CL149 +00008 ***** DTSBX426 +00009 * FUNCTION: READ A DAILY FILE FROM THE AUTOMATED CLEARING HOUSEDTSBX426 +00010 * THAT CONTAINS RECORDS FOR DISHONORED ELECTRONIC DTSBX426 +00011 * PAYMENTS. IT BUILDS DTSIT025 PAYMENT REVERSAL DTSBX426 +00012 * TRANSACTION RECORDS AND WRITES THESE RECORDS DTSBX426 +00013 * TO THE DAILY BTC FILE WHICH IS INPUT TO THE NIGHTLYDTSBX426 +00014 * ACCOUNTING UPDATE. DTSBX426 +00015 ** DTSBX426 +00016 ** 04/16/2015 PER UI CHIEF DO NOT CHARGE 65.00 RETURN FEE CL*77 +00017 ** FOR ACH RETURNS LESS THAN 15.00 ZL1 CL*77 +00018 ** CL*77 +00019 ** 04/21/2015 ALL ACH RETURN TRANSACTIONS WILL BE AUTO REVERSD CL109 +00020 ** ALL EMPLOYERS WITH SAME TRACE NO WILL BE CHARGED CL109 +00021 ** A 65.00 RETURN FEE. AN EMPLOYER WITH MULTIPLE ACH CL109 +00022 ** TRANSACTIONS WITH SAME TRACE NO WILL HAVE ONLY ONE CL109 +00023 ** 65.00 RETURN CHARGE FEE ZL1 CL109 +00024 SKIP3 DTSBX426 +00025 ** 04/27/2015 ALL ACH RETURN TRANSACTIONS WILL BE AUTO REVERSD CL120 +00026 ** ALL EMPLOYERS WITH SAME TRACE NO WILL BE CHARGED CL120 +00027 ** A 65.00 RETURN FEE. AN EMPLOYER WITH MULTIPLE ACH CL120 +00028 ** TRANSACTIONS WITH SAME TRACE NO WILL HAVE ONLY ONE CL120 +00029 ** 65.00 RETURN CHARGE FEE. ALL TRANSACTIONS WILL HAVE CL120 +00030 ** THE NG TRANSACTION TYPE. ZL1 CL120 +00031 SKIP3 CL120 +00032 ENVIRONMENT DIVISION. DTSBX426 +00033 CONFIGURATION SECTION. CL*12 +00034 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*12 +00035 CL*12 +00036 INPUT-OUTPUT SECTION. DTSBX426 +00037 DTSBX426 +00038 FILE-CONTROL. DTSBX426 00039 DTSBX426 -00040 FILE-CONTROL. DTSBX426 -00041 DTSBX426 -00042 SELECT IN-FACH ASSIGN TO EFTFACH DTSBX426 -00043 FILE STATUS IS FACH-STATUS. DTSBX426 -00044 CL**5 -00045 SELECT ESSP-ACHD-FILE ASSIGN TO X426RPT1 CL*41 -00046 FILE STATUS IS REPT-STATUS. CL**5 -00047 CL*79 -00048 SELECT ESSP-ACHR-FILE ASSIGN TO X426RPT2 CL*83 -00049 FILE STATUS IS REPT-STATUS. CL*83 -00050 CL*83 -00051 SELECT PEND-FACH-FILE ASSIGN TO PENDFACH CL*79 -00052 FILE STATUS IS REPT-STATUS. CL*79 -00053 CL**5 +00040 SELECT IN-FACH ASSIGN TO EFTFACH DTSBX426 +00041 FILE STATUS IS FACH-STATUS. DTSBX426 +00042 CL**5 +00043 SELECT ESSP-ACHD-FILE ASSIGN TO X426RPT1 CL*41 +00044 FILE STATUS IS REPT-STATUS. CL**5 +00045 CL*79 +00046 SELECT ESSP-ACHR-FILE ASSIGN TO X426RPT2 CL*83 +00047 FILE STATUS IS REPT-STATUS. CL*83 +00048 CL*83 +00049 SELECT PEND-FACH-FILE ASSIGN TO PENDFACH CL*79 +00050 FILE STATUS IS REPT-STATUS. CL*79 +00051 CL**5 +00052 DTSBX426 +00053 DATA DIVISION. DTSBX426 00054 DTSBX426 -00055 DATA DIVISION. DTSBX426 +00055 FILE SECTION. DTSBX426 00056 DTSBX426 -00057 FILE SECTION. DTSBX426 -00058 DTSBX426 -00059 FD IN-FACH DTSBX426 -00060 LABEL RECORDS ARE STANDARD DTSBX426 -00061 RECORDING MODE IS F DTSBX426 -00062 BLOCK CONTAINS 0 RECORDS. DTSBX426 -00063 DTSBX426 -00064 01 IN-FACH-REC. CL*50 -00065 05 FACH-REC-94 PIC X(94). CL*50 -00066 05 FILLER PIC X(418). CL*50 -00067 DTSBX426 -00068 FD PEND-FACH-FILE CL*79 -00069 LABEL RECORDS ARE STANDARD CL*79 -00070 RECORDING MODE IS F CL*79 -00071 BLOCK CONTAINS 0 RECORDS. CL*79 +00057 FD IN-FACH DTSBX426 +00058 LABEL RECORDS ARE STANDARD DTSBX426 +00059 RECORDING MODE IS F DTSBX426 +00060 BLOCK CONTAINS 0 RECORDS. DTSBX426 +00061 DTSBX426 +00062 01 IN-FACH-REC. CL*50 +00063 05 FACH-REC-94 PIC X(94). CL*50 +00064 05 FILLER PIC X(418). CL*50 +00065 DTSBX426 +00066 FD PEND-FACH-FILE CL*79 +00067 LABEL RECORDS ARE STANDARD CL*79 +00068 RECORDING MODE IS F CL*79 +00069 BLOCK CONTAINS 0 RECORDS. CL*79 +00070 CL*79 +00071 01 PEND-FACH-REC PIC X(512). CL*79 00072 CL*79 -00073 01 PEND-FACH-REC PIC X(512). CL*79 -00074 CL*79 -00075 FD ESSP-ACHD-FILE CL**5 -00076 RECORDING MODE IS F CL**5 -00077 BLOCK CONTAINS 0 RECORDS CL**5 -00078 LABEL RECORDS ARE OMITTED. CL**5 +00073 FD ESSP-ACHD-FILE CL**5 +00074 RECORDING MODE IS F CL**5 +00075 BLOCK CONTAINS 0 RECORDS CL**5 +00076 LABEL RECORDS ARE OMITTED. CL**5 +00077 CL**5 +00078 01 ESSP-ACHD-REC PIC X(133). CL**8 00079 CL**5 -00080 01 ESSP-ACHD-REC PIC X(133). CL**8 -00081 CL**5 -00082 FD ESSP-ACHR-FILE CL*83 -00083 RECORDING MODE IS F CL*83 -00084 BLOCK CONTAINS 0 RECORDS CL*83 -00085 LABEL RECORDS ARE OMITTED. CL*83 +00080 FD ESSP-ACHR-FILE CL*83 +00081 RECORDING MODE IS F CL*83 +00082 BLOCK CONTAINS 0 RECORDS CL*83 +00083 LABEL RECORDS ARE OMITTED. CL*83 +00084 CL*83 +00085 01 ESSP-ACHR-REC PIC X(133). CL*83 00086 CL*83 -00087 01 ESSP-ACHR-REC PIC X(133). CL*83 -00088 CL*83 -00089 DTSBX426 -00090 CL158 -00091 WORKING-STORAGE SECTION. DTSBX426 -000915 77 PAN-VALET PICTURE X(24) VALUE '159DTSBX426 04/20/20'. DTSBX426 -00092 77 PAN-VALET PICTURE X(24) VALUE '216DTSBX425 01/22/04'. CL**2 -00093 DTSBX426 -00094 01 WRK-AREA. DTSBX426 -00095 DTSBX426 -00096 05 WRK-F907-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX426 -00097 05 WRK-FAC6-EMP-NO PIC 9(06) VALUE 0. CL125 -00098 05 WS-FAC6-DUTAS-EMP-NAME. CL129 -00099 10 WS-FAC6-DUTAS-EMP-NAMEA PIC X(4) VALUE SPACES. CL129 -00100 10 WS-FAC6-DUTAS-EMP-NAMEB PIC X(36) VALUE SPACES. CL129 -00101 DTSBX426 -00102 05 FACH-STATUS PIC X(02). DTSBX426 -00103 88 FACH-STATUS-EOF-88 VALUE '10'. CL**7 -00104 88 FACH-STATUS-OK-88 VALUE '00'. CL**7 -00105 DTSBX426 -00106 05 REPT-STATUS PIC X(02). CL*10 -00107 88 REPT-STATUS-EOF-88 VALUE '10'. CL*10 -00108 88 REPT-STATUS-OK-88 VALUE '00'. CL*12 -00109 CL*10 -00110 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +50. DTSBX426 -00111 DTSBX426 -00112 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX425'. CL**2 -00113 05 WRK-RTN-CD PIC X(05) VALUE SPACES. CL*46 -00114 05 WRK-FAC7-RTN-CD PIC X(05) VALUE SPACES. CL*83 -00115 05 WRK-DTS-RTN-CD PIC X(05) VALUE SPACES. CL*84 -00116 DTSBX426 -00117 05 WRK-MPAY-REMIT-AMT PIC S9(09)V9(02) COMP-3. DTSBX426 -00118 05 TOT-MPAY-AMOUNT PIC S9(09)V9(02) COMP-3. CL115 -00119 05 WRK-MPAY-EMP-AMT PIC S9(09)V9(02) COMP-3. CL137 +00087 DTSBX426 +00088 WORKING-STORAGE SECTION. DTSBX426 +000885 77 PAN-VALET PICTURE X(24) VALUE '149DTSBX426 09/14/25'. DTSBX426 +00089 77 PAN-VALET PICTURE X(24) VALUE '216DTSBX425 01/22/04'. CL**2 +00090 DTSBX426 +00091 01 WRK-AREA. DTSBX426 +00092 DTSBX426 +00093 05 WRK-F907-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX426 +00094 05 WRK-FAC6-EMP-NO PIC 9(06) VALUE 0. CL125 +00095 05 WS-FAC6-DUTAS-EMP-NAME. CL129 +00096 10 WS-FAC6-DUTAS-EMP-NAMEA PIC X(4) VALUE SPACES. CL129 +00097 10 WS-FAC6-DUTAS-EMP-NAMEB PIC X(36) VALUE SPACES. CL129 +00098 DTSBX426 +00099 05 FACH-STATUS PIC X(02). DTSBX426 +00100 88 FACH-STATUS-EOF-88 VALUE '10'. CL**7 +00101 88 FACH-STATUS-OK-88 VALUE '00'. CL**7 +00102 DTSBX426 +00103 05 REPT-STATUS PIC X(02). CL*10 +00104 88 REPT-STATUS-EOF-88 VALUE '10'. CL*10 +00105 88 REPT-STATUS-OK-88 VALUE '00'. CL*12 +00106 CL*10 +00107 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +50. DTSBX426 +00108 DTSBX426 +00109 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX425'. CL**2 +00110 05 WRK-RTN-CD PIC X(05) VALUE SPACES. CL*46 +00111 05 WRK-FAC7-RTN-CD PIC X(05) VALUE SPACES. CL*83 +00112 05 WRK-DTS-RTN-CD PIC X(05) VALUE SPACES. CL*84 +00113 DTSBX426 +00114 05 WRK-MPAY-REMIT-AMT PIC S9(09)V9(02) COMP-3. DTSBX426 +00115 05 TOT-MPAY-AMOUNT PIC S9(09)V9(02) COMP-3. CL115 +00116 05 WRK-MPAY-EMP-AMT PIC S9(09)V9(02) COMP-3. CL137 +00117 DTSBX426 +00118 05 WRK-CURR-DATE PIC S9(15) COMP-3. DTSBX426 +00119 05 WRK-CURR-TIME PIC S9(09) COMP-3. DTSBX426 00120 DTSBX426 -00121 05 WRK-CURR-DATE PIC S9(15) COMP-3. DTSBX426 -00122 05 WRK-CURR-TIME PIC S9(09) COMP-3. DTSBX426 -00123 DTSBX426 -00124 05 WRK-MPAY-EMP-CNT PIC S9(07) COMP-3. CL137 -00125 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3. CL137 -00126 05 WRK-MPAY-HOLD-EMP-NO PIC S9(07) COMP-3. CL106 -00127 05 WRK-FAC6-RECORDS PIC S9(07) COMP-3. DTSBX426 -00128 05 WRK-FAC7-RECORDS PIC S9(07) COMP-3. CL*10 -00129 05 WRK-OTHER-RECORDS PIC S9(07) COMP-3. DTSBX426 -00130 05 WRK-HEADER-RECORDS PIC S9(07) COMP-3. DTSBX426 -00131 05 WRK-TRAILER-RECORDS PIC S9(07) COMP-3. DTSBX426 -00132 05 WRK-T025-WRITE-CNT PIC S9(07) COMP-3. DTSBX426 -00133 05 WRK-T003-WRITE-CNT PIC S9(07) COMP-3. CL*72 -00134 05 WRK-R907-WRITE-CNT PIC S9(07) COMP-3. DTSBX426 -00135 05 WRK-F907-WRITE-CNT PIC S9(07) COMP-3. DTSBX426 -00136 05 WS-FAC7-PEN-CNT PIC S9(07) COMP-3. CL*85 -00137 05 WRK-FACH-READ-CNT PIC S9(07) COMP-3. DTSBX426 -00138 05 WRK-TRAILER-REC-CNT PIC S9(07) COMP-3. DTSBX426 -00139 05 WRK-FACH-SELECTED-CNT PIC S9(07) COMP-3. DTSBX426 -00140 05 WRK-FAC6-AMOUNT PIC S9(08)V99 COMP-3. DTSBX426 -00141 05 WRK-MPAY-AMOUNT PIC S9(08)V99 COMP-3. CL*99 -00142 05 WRK-TOLR-AMOUNT PIC S9(08)V99 COMP-3 CL*98 -00143 VALUE +15.00. CL102 -00144 05 TOT-FAC6-AMOUNT PIC S9(10)V99 COMP-3. DTSBX426 -00145 05 TOT-TRAILER-AMT PIC S9(10)V99 COMP-3. DTSBX426 -00146 05 WS-LINE-CNT PIC 9(05) VALUE 60. CL*10 -00147 05 WS-RETN-CNT PIC 9(05) VALUE 60. CL*88 -00148 05 WS-PAGE-CNT PIC 9(05) VALUE 0. CL*10 -00149 05 WRK-MPAY-CNT PIC 9(05) VALUE 0. CL107 -00150 05 WRK-FAC6-AMT-DISP PIC ---,---,999.99. CL*95 -00151 05 WRK-AMT-DISP1 PIC ---,---,999.99. CL*95 -00152 05 WRK-AMT-DISP2 PIC ---,---,999.99. CL*95 -00153 CL*33 -00154 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*33 -00155 05 W-SLASH-DATE PIC X(10). CL*33 -00156 05 FILLER REDEFINES W-SLASH-DATE. CL*33 -00157 10 W-SLASH-DT-MM PIC X(02). CL*33 -00158 10 FILLER PIC X(01). CL*33 -00159 10 W-SLASH-DT-DD PIC X(02). CL*33 -00160 10 FILLER PIC X(01). CL*33 -00161 10 W-SLASH-DT-CCYY PIC X(04). CL*33 -00162 CL*33 -00163 05 WRK-FAC1-DATE. CL*92 -00164 10 WRK-FAC1-DATE-YY PIC X(02). CL*92 -00165 10 WRK-FAC1-DATE-MM PIC X(02). CL*92 -00166 10 WRK-FAC1-DATE-DD PIC X(02). CL*92 -00167 CL*92 -00168 05 WRK-RTN-DATE. CL*92 -00169 10 WRK-RTN-DATE-CC PIC 9(02) VALUE 20. CL*94 -00170 10 WRK-RTN-DATE-YY PIC 9(02). CL*94 -00171 10 WRK-RTN-DATE-MM PIC 9(02). CL*92 -00172 10 WRK-RTN-DATE-DD PIC 9(02). CL*93 -00173 CL*92 -00174 05 WRK-RECV-DATE PIC 9(8) VALUE ZERO. CL*92 -00175 CL*46 -00176 05 WS-HOLD-ITRT-REC PIC X(63). CL*47 -00177 CL*47 -00178 05 WRK-FAC7-RTN-CODE PIC X(01). CL*47 -00179 88 WRK-FAC7-RTN-VALID-88 VALUE 'Y'. CL*46 -00180 88 WRK-FAC7-RTN-INVALID-88 VALUE 'N'. CL*46 -00181 DTSBX426 -00182 05 WRK-TEMP-TRACE-NO. DTSBX426 -00183 10 WRK-TEMP-TRACE-NOA PIC X(06) VALUE ZEROS. CL*21 -00184 10 WRK-TEMP-TRACE-NOB PIC X(09) VALUE ZEROS. CL*21 -00185 DTSBX426 -00186 05 WRK-NUMR-TRACE-NO PIC 9(13) VALUE ZEROS. CL*21 -00187 DTSBX426 -00188 05 WRK-FAC6-DOES-TRACE-NO PIC S9(13) COMP-3. CL**4 -00189 CL106 -00190 05 WRK-TRACE-NO-IND PIC X(01). CL106 -00191 88 TRACE-NO-END-YES-88 VALUE 'Y'. CL107 -00192 88 TRACE-NO-END-NO-88 VALUE 'N'. CL107 -00193 CL106 -00194 DTSBX426 -00195 05 WRK-MPRF-IND PIC X(01). DTSBX426 -00196 88 WRK-MPRF-OK VALUE 'Y'. DTSBX426 -00197 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX426 -00198 DTSBX426 -00199 05 WRK-MPAY-IND PIC X(01). DTSBX426 -00200 88 MPAY-FOUND-YES-88 VALUE 'Y'. DTSBX426 -00201 88 MPAY-FOUND-NO-88 VALUE 'N'. DTSBX426 -00202 DTSBX426 -00203 05 WRK-TOLR-IND PIC X(01). CL*98 -00204 88 WRK-TOLR-YES-88 VALUE 'Y'. CL*98 -00205 88 WRK-TOLR-NO-88 VALUE 'N'. CL*98 -00206 CL*98 -00207 05 WRK-MPRF-IND PIC X(01). CL*66 -00208 88 MPRF-FOUND-YES-88 VALUE 'Y'. CL*66 -00209 88 MPRF-FOUND-NO-88 VALUE 'N'. CL*66 -00210 CL*66 -00211 05 WRK-ITRT-IND PIC X(01). CL*79 -00212 88 ITRT-FOUND-YES-88 VALUE 'Y'. CL*79 -00213 88 ITRT-FOUND-NO-88 VALUE 'N'. CL*79 -00214 CL*79 -00215 05 WRITE-T025-IND PIC X(01). DTSBX426 -00216 88 WRITE-T025-YES-88 VALUE 'Y'. DTSBX426 -00217 88 WRITE-T025-NO-88 VALUE 'N'. DTSBX426 -00218 DTSBX426 -00219 05 WRK-DTSBU005-IND PIC X(01). DTSBX426 -00220 88 WRK-DTSBU005-YES VALUE 'Y'. DTSBX426 -00221 88 WRK-DTSBU005-NO VALUE 'N'. DTSBX426 -00222 DTSBX426 -00223 05 WRK-FACH-PEND PIC X(01). CL*84 -00224 88 WRK-FACH-PEND-REC-YES-88 VALUE 'Y'. CL*83 -00225 88 WRK-FACH-PEND-REC-NO-88 VALUE 'N'. CL*83 -00226 CL*83 -00227 05 WRK-FAC1-IND PIC X(01). DTSBX426 -00228 88 WRK-FAC1-FIRST-OK VALUE 'Y'. DTSBX426 -00229 88 WRK-FAC1-FIRST-NO VALUE 'N'. DTSBX426 +00121 05 WRK-MPAY-EMP-CNT PIC S9(07) COMP-3. CL137 +00122 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3. CL137 +00123 05 WRK-MPAY-HOLD-EMP-NO PIC S9(07) COMP-3. CL106 +00124 05 WRK-FAC6-RECORDS PIC S9(07) COMP-3. DTSBX426 +00125 05 WRK-FAC7-RECORDS PIC S9(07) COMP-3. CL*10 +00126 05 WRK-OTHER-RECORDS PIC S9(07) COMP-3. DTSBX426 +00127 05 WRK-HEADER-RECORDS PIC S9(07) COMP-3. DTSBX426 +00128 05 WRK-TRAILER-RECORDS PIC S9(07) COMP-3. DTSBX426 +00129 05 WRK-T025-WRITE-CNT PIC S9(07) COMP-3. DTSBX426 +00130 05 WRK-T003-WRITE-CNT PIC S9(07) COMP-3. CL*72 +00131 05 WRK-R907-WRITE-CNT PIC S9(07) COMP-3. DTSBX426 +00132 05 WRK-F907-WRITE-CNT PIC S9(07) COMP-3. DTSBX426 +00133 05 WS-FAC7-PEN-CNT PIC S9(07) COMP-3. CL*85 +00134 05 WRK-FACH-READ-CNT PIC S9(07) COMP-3. DTSBX426 +00135 05 WRK-TRAILER-REC-CNT PIC S9(07) COMP-3. DTSBX426 +00136 05 WRK-FACH-SELECTED-CNT PIC S9(07) COMP-3. DTSBX426 +00137 05 WRK-FAC6-AMOUNT PIC S9(08)V99 COMP-3. DTSBX426 +00138 05 WRK-MPAY-AMOUNT PIC S9(08)V99 COMP-3. CL*99 +00139 05 WRK-TOLR-AMOUNT PIC S9(08)V99 COMP-3 CL*98 +00140 VALUE +15.00. CL102 +00141 05 TOT-FAC6-AMOUNT PIC S9(10)V99 COMP-3. DTSBX426 +00142 05 TOT-TRAILER-AMT PIC S9(10)V99 COMP-3. DTSBX426 +00143 05 WS-LINE-CNT PIC 9(05) VALUE 60. CL*10 +00144 05 WS-RETN-CNT PIC 9(05) VALUE 60. CL*88 +00145 05 WS-PAGE-CNT PIC 9(05) VALUE 0. CL*10 +00146 05 WRK-MPAY-CNT PIC 9(05) VALUE 0. CL107 +00147 05 WRK-FAC6-AMT-DISP PIC ---,---,999.99. CL*95 +00148 05 WRK-AMT-DISP1 PIC ---,---,999.99. CL*95 +00149 05 WRK-AMT-DISP2 PIC ---,---,999.99. CL*95 +00150 CL*33 +00151 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*33 +00152 05 W-SLASH-DATE PIC X(10). CL*33 +00153 05 FILLER REDEFINES W-SLASH-DATE. CL*33 +00154 10 W-SLASH-DT-MM PIC X(02). CL*33 +00155 10 FILLER PIC X(01). CL*33 +00156 10 W-SLASH-DT-DD PIC X(02). CL*33 +00157 10 FILLER PIC X(01). CL*33 +00158 10 W-SLASH-DT-CCYY PIC X(04). CL*33 +00159 CL*33 +00160 05 WRK-FAC1-DATE. CL*92 +00161 10 WRK-FAC1-DATE-YY PIC X(02). CL*92 +00162 10 WRK-FAC1-DATE-MM PIC X(02). CL*92 +00163 10 WRK-FAC1-DATE-DD PIC X(02). CL*92 +00164 CL*92 +00165 05 WRK-RTN-DATE. CL*92 +00166 10 WRK-RTN-DATE-CC PIC 9(02) VALUE 20. CL*94 +00167 10 WRK-RTN-DATE-YY PIC 9(02). CL*94 +00168 10 WRK-RTN-DATE-MM PIC 9(02). CL*92 +00169 10 WRK-RTN-DATE-DD PIC 9(02). CL*93 +00170 CL*92 +00171 05 WRK-RECV-DATE PIC 9(8) VALUE ZERO. CL*92 +00172 CL*46 +00173 05 WS-HOLD-ITRT-REC PIC X(63). CL*47 +00174 CL*47 +00175 05 WRK-FAC7-RTN-CODE PIC X(01). CL*47 +00176 88 WRK-FAC7-RTN-VALID-88 VALUE 'Y'. CL*46 +00177 88 WRK-FAC7-RTN-INVALID-88 VALUE 'N'. CL*46 +00178 DTSBX426 +00179 05 WRK-TEMP-TRACE-NO. DTSBX426 +00180 10 WRK-TEMP-TRACE-NOA PIC X(06) VALUE ZEROS. CL*21 +00181 10 WRK-TEMP-TRACE-NOB PIC X(09) VALUE ZEROS. CL*21 +00182 DTSBX426 +00183 05 WRK-NUMR-TRACE-NO PIC 9(13) VALUE ZEROS. CL*21 +00184 DTSBX426 +00185 05 WRK-FAC6-DOES-TRACE-NO PIC S9(13) COMP-3. CL**4 +00186 CL106 +00187 05 WRK-TRACE-NO-IND PIC X(01). CL106 +00188 88 TRACE-NO-END-YES-88 VALUE 'Y'. CL107 +00189 88 TRACE-NO-END-NO-88 VALUE 'N'. CL107 +00190 CL106 +00191 DTSBX426 +00192 05 WRK-MPRF-IND PIC X(01). DTSBX426 +00193 88 WRK-MPRF-OK VALUE 'Y'. DTSBX426 +00194 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX426 +00195 DTSBX426 +00196 05 WRK-MPAY-IND PIC X(01). DTSBX426 +00197 88 MPAY-FOUND-YES-88 VALUE 'Y'. DTSBX426 +00198 88 MPAY-FOUND-NO-88 VALUE 'N'. DTSBX426 +00199 DTSBX426 +00200 05 WRK-TOLR-IND PIC X(01). CL*98 +00201 88 WRK-TOLR-YES-88 VALUE 'Y'. CL*98 +00202 88 WRK-TOLR-NO-88 VALUE 'N'. CL*98 +00203 CL*98 +00204 05 WRK-MPRF-IND PIC X(01). CL*66 +00205 88 MPRF-FOUND-YES-88 VALUE 'Y'. CL*66 +00206 88 MPRF-FOUND-NO-88 VALUE 'N'. CL*66 +00207 CL*66 +00208 05 WRK-ITRT-IND PIC X(01). CL*79 +00209 88 ITRT-FOUND-YES-88 VALUE 'Y'. CL*79 +00210 88 ITRT-FOUND-NO-88 VALUE 'N'. CL*79 +00211 CL*79 +00212 05 WRITE-T025-IND PIC X(01). DTSBX426 +00213 88 WRITE-T025-YES-88 VALUE 'Y'. DTSBX426 +00214 88 WRITE-T025-NO-88 VALUE 'N'. DTSBX426 +00215 DTSBX426 +00216 05 WRK-DTSBU005-IND PIC X(01). DTSBX426 +00217 88 WRK-DTSBU005-YES VALUE 'Y'. DTSBX426 +00218 88 WRK-DTSBU005-NO VALUE 'N'. DTSBX426 +00219 DTSBX426 +00220 05 WRK-FACH-PEND PIC X(01). CL*84 +00221 88 WRK-FACH-PEND-REC-YES-88 VALUE 'Y'. CL*83 +00222 88 WRK-FACH-PEND-REC-NO-88 VALUE 'N'. CL*83 +00223 CL*83 +00224 05 WRK-FAC1-IND PIC X(01). DTSBX426 +00225 88 WRK-FAC1-FIRST-OK VALUE 'Y'. DTSBX426 +00226 88 WRK-FAC1-FIRST-NO VALUE 'N'. DTSBX426 +00227 DTSBX426 +00228 05 WRK-FACH-IND PIC X(01). DTSBX426 +00229 88 WRK-FACH-LAST-REC-88 VALUE 'Y'. DTSBX426 00230 DTSBX426 -00231 05 WRK-FACH-IND PIC X(01). DTSBX426 -00232 88 WRK-FACH-LAST-REC-88 VALUE 'Y'. DTSBX426 -00233 DTSBX426 -00234 05 WRK-TRACE-IND PIC X(01). DTSBX426 -00235 DTSBX426 -00236 01 WRK-MNTE-SUBJECT. CL*74 -00237 10 NTE-SUBJ PIC X(19) CL*70 -00238 VALUE 'ACH PAYMENT RETURN '. CL*70 -00239 01 WRK-MNTE-REASON. CL*70 -00240 10 FILLER PIC X(13) CL*70 -00241 VALUE 'CODE/REASON: '. CL*70 -00242 10 NTE-REASON PIC X(54). CL*70 -00243 01 WRK-MNTE-TRACE-NO. CL*70 -00244 10 FILLER PIC X(13) CL*70 -00245 VALUE ' TRACE NO: '. CL*70 -00246 10 NTE-TRACE-NO PIC X(13). CL*70 -00247 01 WRK-MNTE-DEP-DATE. CL*70 -00248 10 FILLER PIC X(13) CL*70 -00249 VALUE 'RECEIVD DTE: '. CL121 -00250 10 NTE-DEPOSIT-DATE PIC X(13). CL*70 -00251 01 WRK-MNTE-BATCH-ITEM. CL*70 -00252 10 FILLER PIC X(13) CL*70 -00253 VALUE ' BATCH/ITEM: '. CL*70 -00254 10 NTE-BATCH-NO PIC X(5). CL*70 -00255 10 FILLER PIC X(1) VALUE '/'. CL*70 -00256 10 NTE-ITEM-NO PIC XXX. CL*70 -00257 01 WRK-MNTE-ACCT-NO. CL*72 -00258 10 FILLER PIC X(13) CL*71 -00259 VALUE ' ACCOUNT NO: '. CL*71 -00260 10 NTE-ACCT-NO PIC X(20). CL*71 -00261 01 WRK-MNTE-AMOUNT. CL*72 -00262 10 FILLER PIC X(13) CL*71 -00263 VALUE ' DEP AMOUNT: '. CL*71 -00264 10 NTE-AMOUNT PIC ---,---,999.99. CL*96 -00265 01 WRK-MNTE-NO-FEE. CL*77 -00266 10 FILLER PIC X(39) CL*77 -00267 VALUE ' RETURN FEE: NO RETURN FEE WAS CHARGED '. CL*77 -00268 10 FILLER PIC X(29) CL*77 -00269 VALUE 'RETURN AMOUNT LESS THAN 15.00'. CL*77 -00270 01 MSG-TABLE. CL*70 -00271 05 MSG1-NO-MPAY. DTSBX426 -00272 10 MSG1-ID. DTSBX426 -00273 15 MSG1-ID-A PIC X(08) VALUE 'DTSBX425'. CL**2 -00274 15 MSG1-ID-B PIC X(03) VALUE '907'. DTSBX426 -00275 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'FAC6 WITH NO MPRF'.DTSBX426 -00276 10 MSG1-LONG-TEXT. DTSBX426 -00277 15 FILLER PIC X(30) DTSBX426 -00278 VALUE 'FAC6 RECORD ENCOUNTERED WITH N'. DTSBX426 -00279 15 FILLER PIC X(30) DTSBX426 -00280 VALUE 'O CORRESPONDING MPAY RECORD '. DTSBX426 -00281 01 HEADER-1. CL**5 -00282 05 FILLER PIC X(01) VALUE SPACES. CL**5 -00283 05 FILLER PIC X(49) VALUE '140R1'. CL**5 -00284 05 FILLER PIC X(54) VALUE CL*28 -00285 'DISTRICT OF COLUMBIA'. CL**5 -00286 05 FILLER PIC X(06) VALUE 'DATE:'. CL**5 -00287 05 HDR1-LRCM-SYS-DATE PIC X(10). CL**5 -00288 01 HEADER-2. CL**5 -00289 05 FILLER PIC X(54) VALUE SPACES. CL**5 -00290 05 FILLER PIC X(49) VALUE CL*28 -00291 'TAX DIVISION'. CL**5 -00292 05 FILLER PIC X(06) VALUE 'TIME:'. CL**5 -00293 05 HDR2-LRCM-SYS-TIME PIC X(08). CL**5 -00294 01 HEADER-3. CL**5 -00295 05 FILLER PIC X(01) VALUE SPACES. CL**5 -00296 05 FILLER PIC X(40) VALUE CL119 -00297 'ROUTE TO: TAX ACCOUNTING '. CL**6 -00298 05 HDR3-LITERAL PIC X(57) VALUE SPACES. CL117 -00299 05 FILLER PIC X(20) VALUE SPACES. CL*27 -00300 05 FILLER PIC X(06) VALUE 'PAGE:'. CL**5 -00301 05 HEADER-3-PAGE PIC ZZ,ZZ9. CL*12 -00302 CL**5 -00303 01 HEADER-3A. CL**6 -00304 05 FILLER PIC X(01) VALUE SPACES. CL**6 -00305 05 FILLER PIC X(23) VALUE CL*30 -00306 'ACH RETURNS DATE/TIME: '. CL*41 -00307 05 FILLER PIC X(01) VALUE SPACES. CL*26 -00308 05 HEADER-3A-DATE PIC X(06) VALUE SPACES. CL*22 -00309 05 FILLER PIC X(01) VALUE '/'. CL*22 -00310 05 HEADER-3A-TIME PIC X(06) VALUE SPACES. CL*22 -00311 CL*22 -00312 01 HEADER-4. CL**5 -00313 05 FILLER PIC X(01) VALUE SPACES. CL**5 -00314 05 FILLER PIC X(132) VALUE SPACES. CL**5 -00315 01 HEADER-5. CL**5 -00316 05 FILLER PIC X(02) VALUE SPACES. CL**5 -00317 05 FILLER PIC X(28) VALUE CL*55 -00318 'EMP NO NAME REV BTCH/ITM '. CL*55 -00319 05 FILLER PIC X(01) VALUE SPACES. CL*55 -00320 05 FILLER PIC X(44) VALUE CL*69 -00321 'BANK ID ACCT NO ACH AMOUNT '. CL*69 -00322 * 05 FILLER PIC X(04) VALUE SPACES. CL*63 -00323 05 FILLER PIC X(09) VALUE CL**5 -00324 'TRACE NO '. CL**5 -00325 * 05 FILLER PIC X(02) VALUE SPACES. CL*63 -00326 05 HDR5-NAME PIC X(50) VALUE CL119 -00327 ' CODE REASON BANK RETURNED ACH DEBIT PAYMENT'. CL119 -00328 01 HEADER-6. CL**5 -00329 05 FILLER PIC X(01) VALUE SPACES. CL**5 -00330 05 FILLER PIC X(132) VALUE SPACES. CL**5 -00331 CL*56 -00332 01 ZNOTE1. CL*56 -00333 05 FILLER PIC X(02) VALUE SPACES. CL*56 -00334 05 FILLER PIC X(53) VALUE CL*56 -00335 '** NOTE 1. CODE BEGINNING WITH 98 INDICATES A NOC '. CL*69 -00336 CL*56 -00337 01 CNOTE1. CL*56 -00338 05 FILLER PIC X(02) VALUE SPACES. CL*56 -00339 05 FILLER PIC X(53) VALUE CL*56 -00340 'THE ACH NETWORK PROVIDED NOTIFICATION THAT SOMETHING '. CL*56 -00341 05 FILLER PIC X(53) VALUE CL*56 -00342 'ABOUT THE BANK ACCOUNT HAS CHANGED. WELLS FARGO HAS '. CL*56 -00343 CL*56 -00344 01 CNOTE2. CL*56 -00345 05 FILLER PIC X(02) VALUE SPACES. CL*56 -00346 05 FILLER PIC X(53) VALUE CL*56 -00347 'CORRECTED SUBSEQUENT PAYMENTS FOR THE AFFTECTED BANK '. CL*56 -00348 05 FILLER PIC X(53) VALUE CL*56 -00349 'ACCOUNT USING THE UPDATED INFORMATION. '. CL*56 -00350 CL*56 -00351 01 CNOTE3. CL*56 -00352 05 FILLER PIC X(02) VALUE SPACES. CL*56 -00353 05 FILLER PIC X(53) VALUE CL*56 -00354 '>>>>>>>> USE THE NOTIFICATION OF CHANGE REPORT FROM '. CL*56 -00355 05 FILLER PIC X(53) VALUE CL*56 -00356 'WELLS FARGO TO UPDATE YOUR SYSTEM INFORMATION. <<<<< '. CL*56 -00357 CL*56 -00358 01 DETAIL-LINE-1. CL**5 -00359 15 FILLER PIC X(02) VALUE SPACES. CL**5 -00360 15 X425-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL**6 -00361 15 FILLER PIC X(02) VALUE SPACES. CL**5 -00362 15 X425-NAME-CHECK PIC X(04) VALUE SPACES. CL*53 -00363 15 FILLER PIC X(02) VALUE SPACES. CL*53 -00364 15 X425-AUTO-REV PIC X(02) VALUE SPACES. CL*53 -00365 15 FILLER PIC X(01) VALUE SPACES. CL*53 -00366 15 X425-AUTO-BATCH PIC X(05) VALUE SPACES. CL*53 -00367 15 X425-AUTO-FILL PIC X(01) VALUE '/'. CL*53 -00368 15 X425-AUTO-ITEM PIC X(03) VALUE SPACES. CL*53 -00369 15 FILLER PIC X(02) VALUE SPACES. CL**5 -00370 15 X425-BANK-ID PIC X(10) VALUE SPACES. CL*38 -00371 15 FILLER PIC X(02) VALUE SPACES. CL*38 -00372 15 X425-ACCT-NUMBER PIC X(17) VALUE SPACES. CL*58 -00373 15 FILLER PIC X(02) VALUE SPACES. CL*22 -00374 15 X425-X145-REMIT PIC -------9.99. CL**7 -00375 15 FILLER PIC X(02) VALUE SPACES. CL*58 -00376 15 X425-X145-TRACE-NOB PIC X(08) VALUE SPACES. CL*10 -00377 15 FILLER PIC X(02) VALUE SPACES. CL*58 -00378 15 X425-MESSAGE PIC X(54). CL*58 -00379 CL**5 -00380 CL*83 -00381 01 DETAIL-LINE-2. CL*30 -00382 15 FILLER PIC X(15) VALUE SPACES. CL*30 -00383 05 FILLER PIC X(56) VALUE CL*30 -00384 ' ********* NO ACH DEBIT RETURNS **********'. CL*41 -00385 CL*30 -00386 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL**5 -00387 01 FOOTING-LINE-2 PIC X(133) VALUE CL117 -00388 ' *** WELLS FARGO TRANSACTIONS **'. CL117 -00389 CL**5 -00390 01 FOOTDTS-LINE-2 PIC X(133) VALUE CL117 -00391 ' *** DOES DUTAS TRANSACTIONS **'. CL117 -00392 01 FOOTING-LINE-3. CL**5 -00393 05 FILLER PIC X(25) VALUE SPACES. CL**5 -00394 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL**5 -00395 05 FILLER PIC X(02) VALUE SPACES. CL**5 -00396 05 FILLER PIC X(45) VALUE CL**5 -00397 ' TOTAL ACH DEBIT DEPOSITS RETURNED '. CL*41 -00398 05 FILLER PIC X(32) VALUE SPACES. CL**5 -00399 CL**5 -00400 01 FOOTING-LINE-4. CL**5 -00401 05 FILLER PIC X(25) VALUE SPACES. CL**5 -00402 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL**5 -00403 05 FILLER PIC X(02) VALUE SPACES. CL**5 -00404 05 FILLER PIC X(40) VALUE CL118 -00405 ' # OF ACH DEBITS RETURNED HAD ERRORS'. CL117 -00406 05 FILLER PIC X(32) VALUE SPACES. CL**5 -00407 01 FOOTING-LINE-5. CL**5 -00408 05 FILLER PIC X(25) VALUE SPACES. CL**5 -00409 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL**5 -00410 05 FILLER PIC X(02) VALUE SPACES. CL**5 -00411 05 FILLER PIC X(40) VALUE CL**5 -00412 ' # OF ACH RETURNS WENT TO PENDING FILE '. CL*83 -00413 05 FILLER PIC X(32) VALUE SPACES. CL**5 -00414 01 FOOTING-LINE-6. CL**5 -00415 05 FILLER PIC X(25) VALUE SPACES. CL**5 -00416 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL**5 -00417 05 FILLER PIC X(02) VALUE SPACES. CL**5 -00418 05 FILLER PIC X(45) VALUE CL**5 -00419 ' # OF ACH REVERSAL TRANS SENT TO DUTAS '. CL117 -00420 05 FILLER PIC X(32) VALUE SPACES. CL**5 -00421 01 FOOTING-LINE-7. CL**5 -00422 05 FILLER PIC X(19) VALUE SPACES. CL**5 -00423 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL**5 -00424 05 FILLER PIC X(02) VALUE SPACES. CL**5 -00425 05 FILLER PIC X(50) VALUE CL114 -00426 ' TOTAL AMOUNT OF ACH PAYMENTS REVERSED'. CL114 -00427 05 FILLER PIC X(32) VALUE SPACES. CL**5 -00428 CL**5 -00429 01 FOOTING-LINE-8. CL**5 -00430 05 FILLER PIC X(19) VALUE SPACES. CL**5 -00431 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL**5 -00432 05 FILLER PIC X(02) VALUE SPACES. CL**5 -00433 05 FILLER PIC X(45) VALUE CL**5 -00434 'TOTAL AMOUNT - ACH DEBITS RETURNED '. CL*41 -00435 05 FILLER PIC X(32) VALUE SPACES. CL**5 -00436 01 FOOTING-LINE-13. CL**5 -00437 05 FILLER PIC X(25) VALUE SPACES. CL**5 -00438 05 FILLER PIC X(67) VALUE CL**5 -00439 '*** END DOES/WELLS FARGO DAILY ACH TRANSMISSION ***'. CL*40 -00440 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL**5 -00441 CL**5 -00442 DTSBX426 -00443 01 FACH-LINK-REC. DTSBX426 -00444 ++INCLUDE DTSIXACH CL**2 +00231 05 WRK-TRACE-IND PIC X(01). DTSBX426 +00232 DTSBX426 +00233 01 WRK-MNTE-SUBJECT. CL*74 +00234 10 NTE-SUBJ PIC X(19) CL*70 +00235 VALUE 'ACH PAYMENT RETURN '. CL*70 +00236 01 WRK-MNTE-REASON. CL*70 +00237 10 FILLER PIC X(13) CL*70 +00238 VALUE 'CODE/REASON: '. CL*70 +00239 10 NTE-REASON PIC X(54). CL*70 +00240 01 WRK-MNTE-TRACE-NO. CL*70 +00241 10 FILLER PIC X(13) CL*70 +00242 VALUE ' TRACE NO: '. CL*70 +00243 10 NTE-TRACE-NO PIC X(13). CL*70 +00244 01 WRK-MNTE-DEP-DATE. CL*70 +00245 10 FILLER PIC X(13) CL*70 +00246 VALUE 'RECEIVD DTE: '. CL121 +00247 10 NTE-DEPOSIT-DATE PIC X(13). CL*70 +00248 01 WRK-MNTE-BATCH-ITEM. CL*70 +00249 10 FILLER PIC X(13) CL*70 +00250 VALUE ' BATCH/ITEM: '. CL*70 +00251 10 NTE-BATCH-NO PIC X(5). CL*70 +00252 10 FILLER PIC X(1) VALUE '/'. CL*70 +00253 10 NTE-ITEM-NO PIC XXX. CL*70 +00254 01 WRK-MNTE-ACCT-NO. CL*72 +00255 10 FILLER PIC X(13) CL*71 +00256 VALUE ' ACCOUNT NO: '. CL*71 +00257 10 NTE-ACCT-NO PIC X(20). CL*71 +00258 01 WRK-MNTE-AMOUNT. CL*72 +00259 10 FILLER PIC X(13) CL*71 +00260 VALUE ' DEP AMOUNT: '. CL*71 +00261 10 NTE-AMOUNT PIC ---,---,999.99. CL*96 +00262 01 WRK-MNTE-NO-FEE. CL*77 +00263 10 FILLER PIC X(39) CL*77 +00264 VALUE ' RETURN FEE: NO RETURN FEE WAS CHARGED '. CL*77 +00265 10 FILLER PIC X(29) CL*77 +00266 VALUE 'RETURN AMOUNT LESS THAN 15.00'. CL*77 +00267 01 MSG-TABLE. CL*70 +00268 05 MSG1-NO-MPAY. DTSBX426 +00269 10 MSG1-ID. DTSBX426 +00270 15 MSG1-ID-A PIC X(08) VALUE 'DTSBX425'. CL**2 +00271 15 MSG1-ID-B PIC X(03) VALUE '907'. DTSBX426 +00272 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'FAC6 WITH NO MPRF'.DTSBX426 +00273 10 MSG1-LONG-TEXT. DTSBX426 +00274 15 FILLER PIC X(30) DTSBX426 +00275 VALUE 'FAC6 RECORD ENCOUNTERED WITH N'. DTSBX426 +00276 15 FILLER PIC X(30) DTSBX426 +00277 VALUE 'O CORRESPONDING MPAY RECORD '. DTSBX426 +00278 01 HEADER-1. CL**5 +00279 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00280 05 FILLER PIC X(49) VALUE '140R1'. CL**5 +00281 05 FILLER PIC X(54) VALUE CL*28 +00282 'DISTRICT OF COLUMBIA'. CL**5 +00283 05 FILLER PIC X(06) VALUE 'DATE:'. CL**5 +00284 05 HDR1-LRCM-SYS-DATE PIC X(10). CL**5 +00285 01 HEADER-2. CL**5 +00286 05 FILLER PIC X(54) VALUE SPACES. CL**5 +00287 05 FILLER PIC X(49) VALUE CL*28 +00288 'TAX DIVISION'. CL**5 +00289 05 FILLER PIC X(06) VALUE 'TIME:'. CL**5 +00290 05 HDR2-LRCM-SYS-TIME PIC X(08). CL**5 +00291 01 HEADER-3. CL**5 +00292 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00293 05 FILLER PIC X(40) VALUE CL119 +00294 'ROUTE TO: TAX ACCOUNTING '. CL**6 +00295 05 HDR3-LITERAL PIC X(57) VALUE SPACES. CL117 +00296 05 FILLER PIC X(20) VALUE SPACES. CL*27 +00297 05 FILLER PIC X(06) VALUE 'PAGE:'. CL**5 +00298 05 HEADER-3-PAGE PIC ZZ,ZZ9. CL*12 +00299 CL**5 +00300 01 HEADER-3A. CL**6 +00301 05 FILLER PIC X(01) VALUE SPACES. CL**6 +00302 05 FILLER PIC X(23) VALUE CL*30 +00303 'ACH RETURNS DATE/TIME: '. CL*41 +00304 05 FILLER PIC X(01) VALUE SPACES. CL*26 +00305 05 HEADER-3A-DATE PIC X(06) VALUE SPACES. CL*22 +00306 05 FILLER PIC X(01) VALUE '/'. CL*22 +00307 05 HEADER-3A-TIME PIC X(06) VALUE SPACES. CL*22 +00308 CL*22 +00309 01 HEADER-4. CL**5 +00310 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00311 05 FILLER PIC X(132) VALUE SPACES. CL**5 +00312 01 HEADER-5. CL**5 +00313 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00314 05 FILLER PIC X(28) VALUE CL*55 +00315 'EMP NO NAME REV BTCH/ITM '. CL*55 +00316 05 FILLER PIC X(01) VALUE SPACES. CL*55 +00317 05 FILLER PIC X(44) VALUE CL*69 +00318 'BANK ID ACCT NO ACH AMOUNT '. CL*69 +00319 * 05 FILLER PIC X(04) VALUE SPACES. CL*63 +00320 05 FILLER PIC X(09) VALUE CL**5 +00321 'TRACE NO '. CL**5 +00322 * 05 FILLER PIC X(02) VALUE SPACES. CL*63 +00323 05 HDR5-NAME PIC X(50) VALUE CL119 +00324 ' CODE REASON BANK RETURNED ACH DEBIT PAYMENT'. CL119 +00325 01 HEADER-6. CL**5 +00326 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00327 05 FILLER PIC X(132) VALUE SPACES. CL**5 +00328 CL*56 +00329 01 ZNOTE1. CL*56 +00330 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00331 05 FILLER PIC X(53) VALUE CL*56 +00332 '** NOTE 1. CODE BEGINNING WITH 98 INDICATES A NOC '. CL*69 +00333 CL*56 +00334 01 CNOTE1. CL*56 +00335 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00336 05 FILLER PIC X(53) VALUE CL*56 +00337 'THE ACH NETWORK PROVIDED NOTIFICATION THAT SOMETHING '. CL*56 +00338 05 FILLER PIC X(53) VALUE CL*56 +00339 'ABOUT THE BANK ACCOUNT HAS CHANGED. WELLS FARGO HAS '. CL*56 +00340 CL*56 +00341 01 CNOTE2. CL*56 +00342 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00343 05 FILLER PIC X(53) VALUE CL*56 +00344 'CORRECTED SUBSEQUENT PAYMENTS FOR THE AFFTECTED BANK '. CL*56 +00345 05 FILLER PIC X(53) VALUE CL*56 +00346 'ACCOUNT USING THE UPDATED INFORMATION. '. CL*56 +00347 CL*56 +00348 01 CNOTE3. CL*56 +00349 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00350 05 FILLER PIC X(53) VALUE CL*56 +00351 '>>>>>>>> USE THE NOTIFICATION OF CHANGE REPORT FROM '. CL*56 +00352 05 FILLER PIC X(53) VALUE CL*56 +00353 'WELLS FARGO TO UPDATE YOUR SYSTEM INFORMATION. <<<<< '. CL*56 +00354 CL*56 +00355 01 DETAIL-LINE-1. CL**5 +00356 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00357 15 X425-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL**6 +00358 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00359 15 X425-NAME-CHECK PIC X(04) VALUE SPACES. CL*53 +00360 15 FILLER PIC X(02) VALUE SPACES. CL*53 +00361 15 X425-AUTO-REV PIC X(02) VALUE SPACES. CL*53 +00362 15 FILLER PIC X(01) VALUE SPACES. CL*53 +00363 15 X425-AUTO-BATCH PIC X(05) VALUE SPACES. CL*53 +00364 15 X425-AUTO-FILL PIC X(01) VALUE '/'. CL*53 +00365 15 X425-AUTO-ITEM PIC X(03) VALUE SPACES. CL*53 +00366 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00367 15 X425-BANK-ID PIC X(10) VALUE SPACES. CL*38 +00368 15 FILLER PIC X(02) VALUE SPACES. CL*38 +00369 15 X425-ACCT-NUMBER PIC X(17) VALUE SPACES. CL*58 +00370 15 FILLER PIC X(02) VALUE SPACES. CL*22 +00371 15 X425-X145-REMIT PIC -------9.99. CL**7 +00372 15 FILLER PIC X(02) VALUE SPACES. CL*58 +00373 15 X425-X145-TRACE-NOB PIC X(08) VALUE SPACES. CL*10 +00374 15 FILLER PIC X(02) VALUE SPACES. CL*58 +00375 15 X425-MESSAGE PIC X(54). CL*58 +00376 CL**5 +00377 CL*83 +00378 01 DETAIL-LINE-2. CL*30 +00379 15 FILLER PIC X(15) VALUE SPACES. CL*30 +00380 05 FILLER PIC X(56) VALUE CL*30 +00381 ' ********* NO ACH DEBIT RETURNS **********'. CL*41 +00382 CL*30 +00383 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL**5 +00384 01 FOOTING-LINE-2 PIC X(133) VALUE CL117 +00385 ' *** WELLS FARGO TRANSACTIONS **'. CL117 +00386 CL**5 +00387 01 FOOTDTS-LINE-2 PIC X(133) VALUE CL117 +00388 ' *** DOES DUTAS TRANSACTIONS **'. CL117 +00389 01 FOOTING-LINE-3. CL**5 +00390 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00391 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL**5 +00392 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00393 05 FILLER PIC X(45) VALUE CL**5 +00394 ' TOTAL ACH DEBIT DEPOSITS RETURNED '. CL*41 +00395 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00396 CL**5 +00397 01 FOOTING-LINE-4. CL**5 +00398 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00399 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL**5 +00400 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00401 05 FILLER PIC X(40) VALUE CL118 +00402 ' # OF ACH DEBITS RETURNED HAD ERRORS'. CL117 +00403 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00404 01 FOOTING-LINE-5. CL**5 +00405 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00406 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL**5 +00407 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00408 05 FILLER PIC X(40) VALUE CL**5 +00409 ' # OF ACH RETURNS WENT TO PENDING FILE '. CL*83 +00410 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00411 01 FOOTING-LINE-6. CL**5 +00412 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00413 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL**5 +00414 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00415 05 FILLER PIC X(45) VALUE CL**5 +00416 ' # OF ACH REVERSAL TRANS SENT TO DUTAS '. CL117 +00417 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00418 01 FOOTING-LINE-7. CL**5 +00419 05 FILLER PIC X(19) VALUE SPACES. CL**5 +00420 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL**5 +00421 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00422 05 FILLER PIC X(50) VALUE CL114 +00423 ' TOTAL AMOUNT OF ACH PAYMENTS REVERSED'. CL114 +00424 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00425 CL**5 +00426 01 FOOTING-LINE-8. CL**5 +00427 05 FILLER PIC X(19) VALUE SPACES. CL**5 +00428 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL**5 +00429 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00430 05 FILLER PIC X(45) VALUE CL**5 +00431 'TOTAL AMOUNT - ACH DEBITS RETURNED '. CL*41 +00432 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00433 01 FOOTING-LINE-13. CL**5 +00434 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00435 05 FILLER PIC X(67) VALUE CL**5 +00436 '*** END DOES/WELLS FARGO DAILY ACH TRANSMISSION ***'. CL*40 +00437 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL**5 +00438 CL**5 +00439 DTSBX426 +00440 01 FACH-LINK-REC. DTSBX426 +00441 ++INCLUDE DTSIXACH CL**2 +00442 EJECT DTSBX426 +00443 01 FAC0-LINK-REC. CL*45 +00444 ++INCLUDE DTSIXAC0 CL*45 00445 EJECT DTSBX426 -00446 01 FAC0-LINK-REC. CL*45 -00447 ++INCLUDE DTSIXAC0 CL*45 -00448 EJECT DTSBX426 +00446 EJECT CL*45 +00447 01 FAC1-LINK-REC. CL*45 +00448 ++INCLUDE DTSIXAC1 CL*45 00449 EJECT CL*45 -00450 01 FAC1-LINK-REC. CL*45 -00451 ++INCLUDE DTSIXAC1 CL*45 -00452 EJECT CL*45 -00453 01 FAC5-LINK-REC. CL**2 -00454 ++INCLUDE DTSIXAC5 CL**2 -00455 EJECT CL**2 -00456 01 FAC6-LINK-REC. DTSBX426 -00457 ++INCLUDE DTSIXAC6 CL**2 -00458 EJECT DTSBX426 -00459 01 FAC7-LINK-REC. CL**3 -00460 ++INCLUDE DTSIXAC7 CL**3 -00461 EJECT CL**3 -00462 01 FAC9-LINK-REC. DTSBX426 -00463 ++INCLUDE DTSIXAC9 CL**2 +00450 01 FAC5-LINK-REC. CL**2 +00451 ++INCLUDE DTSIXAC5 CL**2 +00452 EJECT CL**2 +00453 01 FAC6-LINK-REC. DTSBX426 +00454 ++INCLUDE DTSIXAC6 CL**2 +00455 EJECT DTSBX426 +00456 01 FAC7-LINK-REC. CL**3 +00457 ++INCLUDE DTSIXAC7 CL**3 +00458 EJECT CL**3 +00459 01 FAC9-LINK-REC. DTSBX426 +00460 ++INCLUDE DTSIXAC9 CL**2 +00461 EJECT DTSBX426 +00462 01 MNTE-REC. CL*70 +00463 ++INCLUDE DTSIMNTE CL*70 00464 EJECT DTSBX426 -00465 01 MNTE-REC. CL*70 -00466 ++INCLUDE DTSIMNTE CL*70 -00467 EJECT DTSBX426 -00468 01 MPAY-REC. CL*70 -00469 ++INCLUDE DTSIMPAY CL*70 -00470 EJECT CL*70 -00471 01 L005-LINK-AREA. DTSBX426 -00472 ++INCLUDE DTSIL005 DTSBX426 -00473 EJECT DTSBX426 -00474 01 L001-LINK-AREA. CL*71 -00475 ++INCLUDE DTSIL001 CL*71 -00476 EJECT CL*71 -00477 01 RSK1-REC. DTSBX426 -00478 ++INCLUDE DTSIRSK1 DTSBX426 +00465 01 MPAY-REC. CL*70 +00466 ++INCLUDE DTSIMPAY CL*70 +00467 EJECT CL*70 +00468 01 L005-LINK-AREA. DTSBX426 +00469 ++INCLUDE DTSIL005 DTSBX426 +00470 EJECT DTSBX426 +00471 01 L001-LINK-AREA. CL*71 +00472 ++INCLUDE DTSIL001 CL*71 +00473 EJECT CL*71 +00474 01 RSK1-REC. DTSBX426 +00475 ++INCLUDE DTSIRSK1 DTSBX426 +00476 EJECT DTSBX426 +00477 01 ITRT-REC. DTSBX426 +00478 ++INCLUDE DTSIITRT DTSBX426 00479 EJECT DTSBX426 -00480 01 ITRT-REC. DTSBX426 -00481 ++INCLUDE DTSIITRT DTSBX426 +00480 01 ISKL-REC. DTSBX426 +00481 ++INCLUDE DTSIISKL DTSBX426 00482 EJECT DTSBX426 -00483 01 ISKL-REC. DTSBX426 -00484 ++INCLUDE DTSIISKL DTSBX426 +00483 01 R907-REC. DTSBX426 +00484 ++INCLUDE DTSIR907 DTSBX426 00485 EJECT DTSBX426 -00486 01 R907-REC. DTSBX426 -00487 ++INCLUDE DTSIR907 DTSBX426 +00486 01 EFT-BATCH-ERRORS-MESS. DTSBX426 +00487 ++INCLUDE EFTERMSG DTSBX426 00488 EJECT DTSBX426 -00489 SKIP3 CL149 -00490 01 R333-REC. CL149 -00491 ++INCLUDE DTSIR333 CL149 -00492 SKIP3 CL149 -00493 01 L111-LINK-AREA. CL149 -00494 ++INCLUDE DTSIL111 CL149 -00495 SKIP3 CL149 -00496 01 L112-LINK-AREA. CL149 -00497 ++INCLUDE DTSIL112 CL149 -00498 SKIP3 CL149 -00499 01 EFT-BATCH-ERRORS-MESS. DTSBX426 -00500 ++INCLUDE EFTERMSG DTSBX426 -00501 EJECT DTSBX426 -00502 01 F907-REC. DTSBX426 -00503 ++INCLUDE EFTIF907 DTSBX426 -00504 EJECT DTSBX426 -00505 01 T025-REC. DTSBX426 -00506 ++INCLUDE DTSIT025 DTSBX426 -00507 EJECT DTSBX426 -00508 01 T003-REC. CL*71 -00509 ++INCLUDE DTSIT003 CL*71 -00510 EJECT CL*71 -00511 01 L910-LINK-AREA. DTSBX426 -00512 ++INCLUDE DTSIL910 DTSBX426 -00513 EJECT DTSBX426 -00514 01 L921-LINK-AREA. DTSBX426 -00515 ++INCLUDE DTSIL921 DTSBX426 -00516 EJECT DTSBX426 -00517 01 L927-LINK-AREA. DTSBX426 -00518 ++INCLUDE DTSIL927 DTSBX426 -00519 EJECT DTSBX426 -00520 01 MSKL-REC. DTSBX426 -00521 ++INCLUDE DTSIMSKL DTSBX426 -00522 EJECT DTSBX426 -00523 01 TSKL-REC. DTSBX426 -00524 ++INCLUDE DTSITSKL DTSBX426 -00525 EJECT DTSBX426 -00526 01 MPRF-REC. DTSBX426 -00527 ++INCLUDE DTSIMPRF DTSBX426 -00528 EJECT DTSBX426 -00529 01 MTAD-REC. DTSBX426 -00530 ++INCLUDE DTSIMTAD DTSBX426 -00531 DTSBX426 -00532 PROCEDURE DIVISION. DTSBX426 -00533 DTSBX426 -00534 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX426 -00535 CL*16 -00536 IF RETURN-CODE = +3 CL*32 -00537 PERFORM T0000-TERMINATE THRU T0000-EXIT CL*32 -00538 PERFORM S999-ABEND THRU S999-EXIT CL146 -00539 GOBACK. CL146 -00540 DTSBX426 -00541 PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL DTSBX426 -00542 WRK-FACH-IND = 'Y'. DTSBX426 -00543 DTSBX426 -00544 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX426 -00545 DTSBX426 -00546 GOBACK. DTSBX426 -00547 DTSBX426 -00548 I0000-INITIATE. DTSBX426 -00549 DTSBX426 -00550 MOVE +0 TO WRK-FACH-READ-CNT DTSBX426 -00551 WRK-MPAY-REMIT-AMT DTSBX426 -00552 WRK-FACH-SELECTED-CNT DTSBX426 -00553 WRK-R907-WRITE-CNT DTSBX426 -00554 WRK-OTHER-RECORDS DTSBX426 -00555 WS-FAC7-PEN-CNT CL*86 -00556 WRK-FAC6-RECORDS DTSBX426 -00557 WRK-FAC7-RECORDS CL*43 -00558 WRK-HEADER-RECORDS DTSBX426 -00559 WRK-TRAILER-RECORDS DTSBX426 -00560 WRK-F907-WRITE-CNT DTSBX426 -00561 WRK-T025-WRITE-CNT DTSBX426 -00562 WRK-T003-WRITE-CNT CL*76 -00563 WRK-TRAILER-REC-CNT DTSBX426 -00564 WRK-FAC6-AMOUNT DTSBX426 -00565 WRK-MPAY-AMOUNT CL*99 -00566 TOT-FAC6-AMOUNT DTSBX426 -00567 TOT-MPAY-AMOUNT CL115 -00568 WRK-MPAY-HOLD-EMP-NO CL106 -00569 WRK-MPAY-CNT CL106 -00570 TOT-TRAILER-AMT CL106 -00571 WRK-FAC6-DOES-TRACE-NO. CL**4 -00572 DTSBX426 -00573 MOVE ZEROS TO FAC1-LINK-REC DTSBX426 -00574 FAC6-LINK-REC DTSBX426 -00575 FAC7-LINK-REC CL*48 -00576 FAC9-LINK-REC. DTSBX426 +00489 01 F907-REC. DTSBX426 +00490 ++INCLUDE EFTIF907 DTSBX426 +00491 EJECT DTSBX426 +00492 01 T025-REC. DTSBX426 +00493 ++INCLUDE DTSIT025 DTSBX426 +00494 EJECT DTSBX426 +00495 01 T003-REC. CL*71 +00496 ++INCLUDE DTSIT003 CL*71 +00497 EJECT CL*71 +00498 01 L910-LINK-AREA. DTSBX426 +00499 ++INCLUDE DTSIL910 DTSBX426 +00500 EJECT DTSBX426 +00501 01 L921-LINK-AREA. DTSBX426 +00502 ++INCLUDE DTSIL921 DTSBX426 +00503 EJECT DTSBX426 +00504 01 L927-LINK-AREA. DTSBX426 +00505 ++INCLUDE DTSIL927 DTSBX426 +00506 EJECT DTSBX426 +00507 01 MSKL-REC. DTSBX426 +00508 ++INCLUDE DTSIMSKL DTSBX426 +00509 EJECT DTSBX426 +00510 01 TSKL-REC. DTSBX426 +00511 ++INCLUDE DTSITSKL DTSBX426 +00512 EJECT DTSBX426 +00513 01 MPRF-REC. DTSBX426 +00514 ++INCLUDE DTSIMPRF DTSBX426 +00515 EJECT DTSBX426 +00516 01 MTAD-REC. DTSBX426 +00517 ++INCLUDE DTSIMTAD DTSBX426 +00518 DTSBX426 +00519 PROCEDURE DIVISION. DTSBX426 +00520 DTSBX426 +00521 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX426 +00522 CL*16 +00523 IF RETURN-CODE = +3 CL*32 +00524 PERFORM T0000-TERMINATE THRU T0000-EXIT CL*32 +00525 PERFORM S999-ABEND THRU S999-EXIT CL146 +00526 GOBACK. CL146 +00527 DTSBX426 +00528 PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL DTSBX426 +00529 WRK-FACH-IND = 'Y'. DTSBX426 +00530 DTSBX426 +00531 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX426 +00532 DTSBX426 +00533 GOBACK. DTSBX426 +00534 DTSBX426 +00535 I0000-INITIATE. DTSBX426 +00536 DTSBX426 +00537 MOVE +0 TO WRK-FACH-READ-CNT DTSBX426 +00538 WRK-MPAY-REMIT-AMT DTSBX426 +00539 WRK-FACH-SELECTED-CNT DTSBX426 +00540 WRK-R907-WRITE-CNT DTSBX426 +00541 WRK-OTHER-RECORDS DTSBX426 +00542 WS-FAC7-PEN-CNT CL*86 +00543 WRK-FAC6-RECORDS DTSBX426 +00544 WRK-FAC7-RECORDS CL*43 +00545 WRK-HEADER-RECORDS DTSBX426 +00546 WRK-TRAILER-RECORDS DTSBX426 +00547 WRK-F907-WRITE-CNT DTSBX426 +00548 WRK-T025-WRITE-CNT DTSBX426 +00549 WRK-T003-WRITE-CNT CL*76 +00550 WRK-TRAILER-REC-CNT DTSBX426 +00551 WRK-FAC6-AMOUNT DTSBX426 +00552 WRK-MPAY-AMOUNT CL*99 +00553 TOT-FAC6-AMOUNT DTSBX426 +00554 TOT-MPAY-AMOUNT CL115 +00555 WRK-MPAY-HOLD-EMP-NO CL106 +00556 WRK-MPAY-CNT CL106 +00557 TOT-TRAILER-AMT CL106 +00558 WRK-FAC6-DOES-TRACE-NO. CL**4 +00559 DTSBX426 +00560 MOVE ZEROS TO FAC1-LINK-REC DTSBX426 +00561 FAC6-LINK-REC DTSBX426 +00562 FAC7-LINK-REC CL*48 +00563 FAC9-LINK-REC. DTSBX426 +00564 DTSBX426 +00565 MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND. DTSBX426 +00566 DTSBX426 +00567 MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND. DTSBX426 +00568 DTSBX426 +00569 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX426 +00570 DTSBX426 +00571 I0000-EXIT. DTSBX426 +00572 EXIT. DTSBX426 +00573 I2000-OPEN-FILES. DTSBX426 +00574 DTSBX426 +00575 MOVE LENGTH OF T025-REC TO T025-LENGTH. DTSBX426 +00576 MOVE LENGTH OF F907-REC TO F907-LENGTH. DTSBX426 00577 DTSBX426 -00578 MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND. DTSBX426 +00578 MOVE WRK-TRACE-IND TO L910-TRACE-IND, L921-TRACE-IND. DTSBX426 00579 DTSBX426 -00580 MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND. DTSBX426 +00580 MOVE WRK-MOD-NAME TO L910-MOD-NAME, L921-MOD-NAME DTSBX426 00581 DTSBX426 -00582 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX426 +00582 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX426 00583 DTSBX426 -00584 I0000-EXIT. DTSBX426 -00585 EXIT. DTSBX426 -00586 I2000-OPEN-FILES. DTSBX426 -00587 DTSBX426 -00588 MOVE LENGTH OF T025-REC TO T025-LENGTH. DTSBX426 -00589 MOVE LENGTH OF F907-REC TO F907-LENGTH. DTSBX426 -00590 DTSBX426 -00591 MOVE WRK-TRACE-IND TO L910-TRACE-IND, L921-TRACE-IND. DTSBX426 -00592 DTSBX426 -00593 MOVE WRK-MOD-NAME TO L910-MOD-NAME, L921-MOD-NAME DTSBX426 -00594 DTSBX426 -00595 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX426 -00596 DTSBX426 -00597 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX426 -00598 DTSBX426 -00599 MOVE 'N' TO L927-TRACE-IND. DTSBX426 -00600 MOVE WRK-MOD-NAME TO L927-MOD-NAME. DTSBX426 -00601 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSBX426 -00602 CL*32 -00603 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*32 -00604 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*32 -00605 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*32 -00606 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*32 -00607 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*32 -00608 DTSBX426 -00609 OPEN INPUT IN-FACH. DTSBX426 -00610 DTSBX426 -00611 IF NOT FACH-STATUS-OK-88 CL*17 -00612 DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS CL*32 -00613 MOVE +3 TO RETURN-CODE CL*13 -00614 ELSE CL**6 -00615 IF FACH-STATUS-OK-88 DTSBX426 -00616 NEXT SENTENCE DTSBX426 -00617 ELSE DTSBX426 -00618 DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS DTSBX426 -00619 PERFORM S999-ABEND THRU S999-EXIT CL*12 -00620 END-IF CL**6 -00621 END-IF. CL**6 -00622 CL**6 -00623 OPEN OUTPUT ESSP-ACHD-FILE. CL*35 -00624 IF REPT-STATUS-OK-88 CL*35 -00625 NEXT SENTENCE CL*35 -00626 ELSE CL*35 -00627 DISPLAY 'CANNOT OPEN REPORT ACHD FILE ' CL*35 -00628 REPT-STATUS CL*35 -00629 PERFORM S999-ABEND THRU S999-EXIT CL*35 -00630 END-IF. CL*35 -00631 CL*35 -00632 OPEN OUTPUT ESSP-ACHR-FILE. CL*83 -00633 IF REPT-STATUS-OK-88 CL*83 -00634 NEXT SENTENCE CL*83 -00635 ELSE CL*83 -00636 DISPLAY 'CANNOT OPEN REPORT ACHR FILE ' CL*83 -00637 REPT-STATUS CL*83 -00638 PERFORM S999-ABEND THRU S999-EXIT CL*83 -00639 END-IF. CL*83 -00640 CL*83 -00641 OPEN OUTPUT PEND-FACH-FILE. CL*79 -00642 IF REPT-STATUS-OK-88 CL*79 -00643 NEXT SENTENCE CL*79 -00644 ELSE CL*79 -00645 DISPLAY 'CANNOT OPEN OUTPUT ACH PENDING FILE ' CL*79 -00646 REPT-STATUS CL*79 -00647 PERFORM S999-ABEND THRU S999-EXIT CL*79 -00648 END-IF. CL*79 -00649 CL*79 -00650 READ IN-FACH CL*50 -00651 AT END CL*18 -00652 MOVE +3 TO RETURN-CODE CL*18 -00653 DISPLAY 'NO ACH DEPOSITS RETURNED ' CL*41 -00654 MOVE 'Y' TO WRK-FACH-IND CL*18 -00655 GO TO I2000-EXIT. CL*18 -00656 CL*18 -00657 DTSBX426 -00658 I2000-EXIT. DTSBX426 -00659 EXIT. DTSBX426 -00660 DTSBX426 -00661 P0000-PROCESS. DTSBX426 -00662 DISPLAY ' 1000 - PROCESS'. DTSBX426 -00663 DTSBX426 -00664 MOVE FACH-REC-94 TO FACH-LINK-REC. CL*50 -00665 DTSBX426 -00666 ADD +1 TO WRK-FACH-READ-CNT. DTSBX426 -00667 * MOVE ZEROS TO FAC6-HEADER-REC. CL*81 -00668 DTSBX426 -00669 IF FACH-TYPE-HEADER-88 DTSBX426 -00670 MOVE FACH-LINK-REC TO FAC1-LINK-REC DTSBX426 -00671 ADD 1 TO WRK-HEADER-RECORDS DTSBX426 -00672 PERFORM P1005-HEADER-EDIT THRU P1005-EXIT DTSBX426 -00673 ELSE DTSBX426 -00674 IF FACH-TYPE-ENTRY-DETAIL-88 DTSBX426 -00675 SET WRK-FACH-PEND-REC-NO-88 TO TRUE CL*83 -00676 MOVE FACH-LINK-REC TO FAC6-LINK-REC DTSBX426 -00677 ADD 1 TO WRK-FAC6-RECORDS DTSBX426 -00678 PERFORM P1010-FAC6-EDIT THRU P1010-EXIT DTSBX426 -00679 ELSE CL**5 -00680 IF FACH-TYPE-ADDENDA-88 CL*14 -00681 MOVE FACH-LINK-REC TO FAC7-LINK-REC CL**5 -00682 ADD 1 TO WRK-FAC7-RECORDS CL**5 -00683 PERFORM P1011-FAC7-EDIT THRU P1011-EXIT CL**5 -00684 ELSE CL**3 -00685 IF FACH-TYPE-TRAILER-88 DTSBX426 -00686 MOVE FACH-LINK-REC TO FAC9-LINK-REC DTSBX426 -00687 ADD 1 TO WRK-TRAILER-RECORDS DTSBX426 -00688 ADD 1 TO WRK-TRAILER-REC-CNT DTSBX426 -00689 PERFORM P1015-TRAILER-EDIT THRU P1015-EXIT DTSBX426 -00690 ELSE DTSBX426 -00691 ADD 1 TO WRK-OTHER-RECORDS. CL*18 -00692 CL*18 -00693 READ IN-FACH CL*50 -00694 AT END CL*18 -00695 MOVE 'Y' TO WRK-FACH-IND CL*18 -00696 GO TO P0000-EXIT. CL*18 -00697 DTSBX426 -00698 P0000-EXIT. DTSBX426 -00699 EXIT. DTSBX426 -00700 DTSBX426 -00701 DTSBX426 -00702 P1005-HEADER-EDIT. DTSBX426 +00584 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX426 +00585 DTSBX426 +00586 MOVE 'N' TO L927-TRACE-IND. DTSBX426 +00587 MOVE WRK-MOD-NAME TO L927-MOD-NAME. DTSBX426 +00588 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSBX426 +00589 CL*32 +00590 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*32 +00591 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*32 +00592 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*32 +00593 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*32 +00594 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*32 +00595 DTSBX426 +00596 OPEN INPUT IN-FACH. DTSBX426 +00597 DTSBX426 +00598 IF NOT FACH-STATUS-OK-88 CL*17 +00599 DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS CL*32 +00600 MOVE +3 TO RETURN-CODE CL*13 +00601 ELSE CL**6 +00602 IF FACH-STATUS-OK-88 DTSBX426 +00603 NEXT SENTENCE DTSBX426 +00604 ELSE DTSBX426 +00605 DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS DTSBX426 +00606 PERFORM S999-ABEND THRU S999-EXIT CL*12 +00607 END-IF CL**6 +00608 END-IF. CL**6 +00609 CL**6 +00610 OPEN OUTPUT ESSP-ACHD-FILE. CL*35 +00611 IF REPT-STATUS-OK-88 CL*35 +00612 NEXT SENTENCE CL*35 +00613 ELSE CL*35 +00614 DISPLAY 'CANNOT OPEN REPORT ACHD FILE ' CL*35 +00615 REPT-STATUS CL*35 +00616 PERFORM S999-ABEND THRU S999-EXIT CL*35 +00617 END-IF. CL*35 +00618 CL*35 +00619 OPEN OUTPUT ESSP-ACHR-FILE. CL*83 +00620 IF REPT-STATUS-OK-88 CL*83 +00621 NEXT SENTENCE CL*83 +00622 ELSE CL*83 +00623 DISPLAY 'CANNOT OPEN REPORT ACHR FILE ' CL*83 +00624 REPT-STATUS CL*83 +00625 PERFORM S999-ABEND THRU S999-EXIT CL*83 +00626 END-IF. CL*83 +00627 CL*83 +00628 OPEN OUTPUT PEND-FACH-FILE. CL*79 +00629 IF REPT-STATUS-OK-88 CL*79 +00630 NEXT SENTENCE CL*79 +00631 ELSE CL*79 +00632 DISPLAY 'CANNOT OPEN OUTPUT ACH PENDING FILE ' CL*79 +00633 REPT-STATUS CL*79 +00634 PERFORM S999-ABEND THRU S999-EXIT CL*79 +00635 END-IF. CL*79 +00636 CL*79 +00637 READ IN-FACH CL*50 +00638 AT END CL*18 +00639 MOVE +3 TO RETURN-CODE CL*18 +00640 DISPLAY 'NO ACH DEPOSITS RETURNED ' CL*41 +00641 MOVE 'Y' TO WRK-FACH-IND CL*18 +00642 GO TO I2000-EXIT. CL*18 +00643 CL*18 +00644 DTSBX426 +00645 I2000-EXIT. DTSBX426 +00646 EXIT. DTSBX426 +00647 DTSBX426 +00648 P0000-PROCESS. DTSBX426 +00649 DISPLAY ' 1000 - PROCESS'. DTSBX426 +00650 DTSBX426 +00651 MOVE FACH-REC-94 TO FACH-LINK-REC. CL*50 +00652 DTSBX426 +00653 ADD +1 TO WRK-FACH-READ-CNT. DTSBX426 +00654 * MOVE ZEROS TO FAC6-HEADER-REC. CL*81 +00655 DTSBX426 +00656 IF FACH-TYPE-HEADER-88 DTSBX426 +00657 MOVE FACH-LINK-REC TO FAC1-LINK-REC DTSBX426 +00658 ADD 1 TO WRK-HEADER-RECORDS DTSBX426 +00659 PERFORM P1005-HEADER-EDIT THRU P1005-EXIT DTSBX426 +00660 ELSE DTSBX426 +00661 IF FACH-TYPE-ENTRY-DETAIL-88 DTSBX426 +00662 SET WRK-FACH-PEND-REC-NO-88 TO TRUE CL*83 +00663 MOVE FACH-LINK-REC TO FAC6-LINK-REC DTSBX426 +00664 ADD 1 TO WRK-FAC6-RECORDS DTSBX426 +00665 PERFORM P1010-FAC6-EDIT THRU P1010-EXIT DTSBX426 +00666 ELSE CL**5 +00667 IF FACH-TYPE-ADDENDA-88 CL*14 +00668 MOVE FACH-LINK-REC TO FAC7-LINK-REC CL**5 +00669 ADD 1 TO WRK-FAC7-RECORDS CL**5 +00670 PERFORM P1011-FAC7-EDIT THRU P1011-EXIT CL**5 +00671 ELSE CL**3 +00672 IF FACH-TYPE-TRAILER-88 DTSBX426 +00673 MOVE FACH-LINK-REC TO FAC9-LINK-REC DTSBX426 +00674 ADD 1 TO WRK-TRAILER-RECORDS DTSBX426 +00675 ADD 1 TO WRK-TRAILER-REC-CNT DTSBX426 +00676 PERFORM P1015-TRAILER-EDIT THRU P1015-EXIT DTSBX426 +00677 ELSE DTSBX426 +00678 ADD 1 TO WRK-OTHER-RECORDS. CL*18 +00679 CL*18 +00680 READ IN-FACH CL*50 +00681 AT END CL*18 +00682 MOVE 'Y' TO WRK-FACH-IND CL*18 +00683 GO TO P0000-EXIT. CL*18 +00684 DTSBX426 +00685 P0000-EXIT. DTSBX426 +00686 EXIT. DTSBX426 +00687 DTSBX426 +00688 DTSBX426 +00689 P1005-HEADER-EDIT. DTSBX426 +00690 DTSBX426 +00691 DISPLAY ' 1005 - HEADER PROCESS'. CL*49 +00692 IF WRK-FACH-READ-CNT NOT = 1 DTSBX426 +00693 MOVE 'Y' TO WRK-FACH-IND DTSBX426 +00694 DISPLAY ' FIRST RECORD OF FILE IS NOT A HEADER RECORD' DTSBX426 +00695 PERFORM S999-ABEND THRU S999-EXIT. DTSBX426 +00696 MOVE FAC1-FILE-CREATE-DATE TO WRK-FAC1-DATE. CL*92 +00697 MOVE WRK-FAC1-DATE-YY TO WRK-RTN-DATE-YY. CL*92 +00698 MOVE WRK-FAC1-DATE-MM TO WRK-RTN-DATE-MM. CL*92 +00699 MOVE WRK-FAC1-DATE-DD TO WRK-RTN-DATE-DD. CL*92 +00700 MOVE WRK-RTN-DATE TO WRK-RECV-DATE. CL*92 +00701 P1005-EXIT. DTSBX426 +00702 EXIT. DTSBX426 00703 DTSBX426 -00704 DISPLAY ' 1005 - HEADER PROCESS'. CL*49 -00705 IF WRK-FACH-READ-CNT NOT = 1 DTSBX426 -00706 MOVE 'Y' TO WRK-FACH-IND DTSBX426 -00707 DISPLAY ' FIRST RECORD OF FILE IS NOT A HEADER RECORD' DTSBX426 -00708 PERFORM S999-ABEND THRU S999-EXIT. DTSBX426 -00709 MOVE FAC1-FILE-CREATE-DATE TO WRK-FAC1-DATE. CL*92 -00710 MOVE WRK-FAC1-DATE-YY TO WRK-RTN-DATE-YY. CL*92 -00711 MOVE WRK-FAC1-DATE-MM TO WRK-RTN-DATE-MM. CL*92 -00712 MOVE WRK-FAC1-DATE-DD TO WRK-RTN-DATE-DD. CL*92 -00713 MOVE WRK-RTN-DATE TO WRK-RECV-DATE. CL*92 -00714 P1005-EXIT. DTSBX426 -00715 EXIT. DTSBX426 +00704 P1010-FAC6-EDIT. DTSBX426 +00705 DISPLAY '1010 - TYPE6 PROCESS EMP NO: ' FAC6-DUTAS-EMP-NO. CL*91 +00706 DTSBX426 +00707 SET WRITE-T025-NO-88 TO TRUE. DTSBX426 +00708 SET MPAY-FOUND-YES-88 TO TRUE. CL105 +00709 DISPLAY ' 1010 - AMOUNT ' FAC6-AMOUNT DTSBX426 +00710 DISPLAY ' 1010 - TRACEIN ' FAC6-DOES-TRACE-NO CL**4 +00711 MOVE ZEROS TO WRK-TEMP-TRACE-NO DTSBX426 +00712 WRK-FAC6-DOES-TRACE-NO. CL*12 +00713 * WRK-DOES-TRACE-NO. CL*12 +00714 MOVE FAC6-AMOUNT TO WRK-FAC6-AMOUNT. CL*74 +00715 MOVE FAC6-DOES-TRACE-NO TO WRK-TEMP-TRACE-NO. CL*10 00716 DTSBX426 -00717 P1010-FAC6-EDIT. DTSBX426 -00718 DISPLAY '1010 - TYPE6 PROCESS EMP NO: ' FAC6-DUTAS-EMP-NO. CL*91 -00719 DTSBX426 -00720 SET WRITE-T025-NO-88 TO TRUE. DTSBX426 -00721 SET MPAY-FOUND-YES-88 TO TRUE. CL105 -00722 DISPLAY ' 1010 - AMOUNT ' FAC6-AMOUNT DTSBX426 -00723 DISPLAY ' 1010 - TRACEIN ' FAC6-DOES-TRACE-NO CL**4 -00724 MOVE ZEROS TO WRK-TEMP-TRACE-NO DTSBX426 -00725 WRK-FAC6-DOES-TRACE-NO. CL*12 -00726 * WRK-DOES-TRACE-NO. CL*12 -00727 MOVE FAC6-AMOUNT TO WRK-FAC6-AMOUNT. CL*74 -00728 MOVE FAC6-DOES-TRACE-NO TO WRK-TEMP-TRACE-NO. CL*10 -00729 DTSBX426 -00730 MOVE FAC6-AMOUNT TO WRK-FAC6-AMT-DISP. CL*73 -00731 MOVE WRK-FAC6-AMT-DISP TO NTE-AMOUNT. CL*73 -00732 * MOVE ZEROS TO WRK-TEMP-TRACE-NOA. CL*21 -00733 * MOVE WRK-DOES-TRACE-NOB TO WRK-TEMP-TRACE-NOB. CL*12 -00734 MOVE WRK-TEMP-TRACE-NOA TO WRK-FAC6-DOES-TRACE-NO. CL*21 -00735 DTSBX426 -00736 DISPLAY 'TRACE-NO -TEMP ' WRK-TEMP-TRACE-NO DTSBX426 -00737 DISPLAY 'TRACE-WRK-FAC6 ' WRK-FAC6-DOES-TRACE-NO CL**4 -00738 DTSBX426 -00739 IF FAC6-AMOUNT = ZEROS DTSBX426 -00740 ADD 1 TO WRK-F907-WRITE-CNT CL**8 -00741 DISPLAY ' ACH PAYMENT = ZEROS ' FAC6-AMOUNT CL**8 -00742 MOVE +2 TO RETURN-CODE. CL*37 -00743 * MOVE EFT027 TO F907-MSG-TEXT CL**8 -00744 * MOVE '027' TO F907-MSG-ID CL**8 -00745 * MOVE ZEROS TO F907-EMP-NO CL**8 -00746 * MOVE FAC6-AMOUNT TO F907-GOV1-REC CL**8 -00747 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 -00748 * GO TO P1010-EXIT. CL**8 +00717 MOVE FAC6-AMOUNT TO WRK-FAC6-AMT-DISP. CL*73 +00718 MOVE WRK-FAC6-AMT-DISP TO NTE-AMOUNT. CL*73 +00719 * MOVE ZEROS TO WRK-TEMP-TRACE-NOA. CL*21 +00720 * MOVE WRK-DOES-TRACE-NOB TO WRK-TEMP-TRACE-NOB. CL*12 +00721 MOVE WRK-TEMP-TRACE-NOA TO WRK-FAC6-DOES-TRACE-NO. CL*21 +00722 DTSBX426 +00723 DISPLAY 'TRACE-NO -TEMP ' WRK-TEMP-TRACE-NO DTSBX426 +00724 DISPLAY 'TRACE-WRK-FAC6 ' WRK-FAC6-DOES-TRACE-NO CL**4 +00725 DTSBX426 +00726 IF FAC6-AMOUNT = ZEROS DTSBX426 +00727 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00728 DISPLAY ' ACH PAYMENT = ZEROS ' FAC6-AMOUNT CL**8 +00729 MOVE +2 TO RETURN-CODE. CL*37 +00730 * MOVE EFT027 TO F907-MSG-TEXT CL**8 +00731 * MOVE '027' TO F907-MSG-ID CL**8 +00732 * MOVE ZEROS TO F907-EMP-NO CL**8 +00733 * MOVE FAC6-AMOUNT TO F907-GOV1-REC CL**8 +00734 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00735 * GO TO P1010-EXIT. CL**8 +00736 DTSBX426 +00737 IF FAC6-AMOUNT NOT NUMERIC DTSBX426 +00738 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00739 DISPLAY ' ACH PAYMENT NOT NUMERIC ' FAC6-AMOUNT CL**8 +00740 MOVE +2 TO RETURN-CODE. CL*37 +00741 * MOVE EFT028 TO F907-MSG-TEXT CL**8 +00742 * MOVE '028' TO F907-MSG-ID CL**8 +00743 * MOVE ZEROS TO F907-EMP-NO CL**8 +00744 * MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC CL**8 +00745 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00746 * GO TO P1010-EXIT. CL**8 +00747 DTSBX426 +00748 ADD WRK-FAC6-AMOUNT TO TOT-FAC6-AMOUNT. DTSBX426 00749 DTSBX426 -00750 IF FAC6-AMOUNT NOT NUMERIC DTSBX426 +00750 IF WRK-TEMP-TRACE-NO NOT NUMERIC DTSBX426 00751 ADD 1 TO WRK-F907-WRITE-CNT CL**8 -00752 DISPLAY ' ACH PAYMENT NOT NUMERIC ' FAC6-AMOUNT CL**8 +00752 DISPLAY 'TRACE-NO NOT NUMERIC ' WRK-TEMP-TRACE-NO CL**8 00753 MOVE +2 TO RETURN-CODE. CL*37 -00754 * MOVE EFT028 TO F907-MSG-TEXT CL**8 -00755 * MOVE '028' TO F907-MSG-ID CL**8 +00754 * MOVE EFT013 TO F907-MSG-TEXT CL**8 +00755 * MOVE '013' TO F907-MSG-ID CL**8 00756 * MOVE ZEROS TO F907-EMP-NO CL**8 -00757 * MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC CL**8 +00757 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 00758 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 00759 * GO TO P1010-EXIT. CL**8 00760 DTSBX426 -00761 ADD WRK-FAC6-AMOUNT TO TOT-FAC6-AMOUNT. DTSBX426 -00762 DTSBX426 -00763 IF WRK-TEMP-TRACE-NO NOT NUMERIC DTSBX426 -00764 ADD 1 TO WRK-F907-WRITE-CNT CL**8 -00765 DISPLAY 'TRACE-NO NOT NUMERIC ' WRK-TEMP-TRACE-NO CL**8 -00766 MOVE +2 TO RETURN-CODE. CL*37 -00767 * MOVE EFT013 TO F907-MSG-TEXT CL**8 -00768 * MOVE '013' TO F907-MSG-ID CL**8 -00769 * MOVE ZEROS TO F907-EMP-NO CL**8 -00770 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 -00771 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 -00772 * GO TO P1010-EXIT. CL**8 -00773 DTSBX426 -00774 IF WRK-TEMP-TRACE-NO = ZEROS DTSBX426 -00775 DISPLAY 'TRACE-NO = ZEROS ' WRK-TEMP-TRACE-NO CL**8 -00776 MOVE +2 TO RETURN-CODE. CL*37 -00777 * MOVE EFT014 TO F907-MSG-TEXT CL**8 -00778 * MOVE '014' TO F907-MSG-ID CL**8 -00779 * MOVE ZEROS TO F907-EMP-NO CL**8 -00780 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 -00781 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 -00782 * GO TO P1010-EXIT. CL**8 -00783 DTSBX426 -00784 SET MPRF-FOUND-YES-88 TO TRUE. CL135 -00785 CL123 -00786 * IF FAC6-DUTAS-EMP-NOA = 'DC' CL135 -00787 * GO TO P1010-EXIT. CL135 -00788 CL133 -00789 CL133 -00790 * DISPLAY 'ZEMP-NO: ' FAC6-DUTAS-EMP-NO CL135 -00791 CL132 -00792 * PERFORM P1070-READ-MPRF THRU P1070-EXIT. CL135 -00793 CL*65 -00794 * IF L910-NO-REC-88 CL135 -00795 * SET MPRF-FOUND-NO-88 TO TRUE CL135 -00796 * SET WRITE-T025-NO-88 TO TRUE CL135 -00797 * SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL135 -00798 * MOVE 'DTS01' TO WRK-DTS-RTN-CD CL135 -00799 * DISPLAY '***NO MPRF FOUND ON DUTAS -ERROR ' MPRF-EMP-NO. CL135 -00800 CL*65 -00801 * IF FAC6-AMOUNT = ZEROS OR MPRF-FOUND-NO-88 CL135 -00802 * SET MPAY-FOUND-NO-88 TO TRUE. CL135 -00803 P1010-EXIT. DTSBX426 -00804 EXIT. DTSBX426 -00805 DTSBX426 -00806 P1011-FAC7-EDIT. CL*10 -00807 DISPLAY ' 1011 - TYPE7 PROCESS'. CL*56 -00808 DISPLAY ' FAC7 RETURN CODE ' FAC7-RTN-CD. CL*60 -00809 CL*61 -00810 CL*56 -00811 * IF FAC7-RTN-CD = '98' CL*65 -00812 * DISPLAY ' ***** CODE 98 NO T025 WRITTEN ' MPAY-EMP-NO CL*65 -00813 * MOVE 'N' TO X425-AUTO-REV CL*65 -00814 * MOVE '*****' TO X425-AUTO-BATCH CL*65 -00815 * MOVE 'NOC' TO X425-AUTO-ITEM. CL*65 -00816 CL*87 -00817 MOVE ' DOES-ESSP ACH DEBIT RETURNS/REVERSALS ' CL113 -00818 TO HDR3-LITERAL. CL110 -00819 CL110 -00820 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL110 -00821 PERFORM P4000-PRNT-ACHD THRU P4000-EXIT. CL110 -00822 MOVE FAC7-RTN-CD TO WRK-FAC7-RTN-CD CL110 -00823 PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT. CL110 -00824 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1. CL110 -00825 ADD 1 TO WS-LINE-CNT. CL110 -00826 CL147 -00827 IF FAC7-TRANS-CD = '98' CL148 -00828 DISPLAY ' ***** CODE 98 NO T025 WRITTEN ' MPAY-EMP-NO CL147 -00829 GO TO P1011-EXIT. CL147 -00830 CL109 -00831 IF MPAY-FOUND-YES-88 CL109 -00832 DISPLAY ' MPAY SET TO TRUE ' CL111 -00833 PERFORM P1020-FIND-MPAY-INDEX THRU P1020-EXIT. CL109 -00834 CL109 -00835 CL105 -00836 IF WRK-FACH-PEND-REC-YES-88 CL*83 -00837 MOVE ' DOES-ESSP ACH DEBIT RETURNS NOT FOUND ON DUTAS' CL*87 -00838 TO HDR3-LITERAL CL*87 -00839 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT CL*90 -00840 PERFORM P4000-PRNT-ACHD THRU P4000-EXIT CL*87 -00841 MOVE WRK-DTS-RTN-CD TO WRK-FAC7-RTN-CD CL*83 -00842 PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT CL*83 -00843 WRITE ESSP-ACHR-REC FROM DETAIL-LINE-1 AFTER 1 CL*83 -00844 WRITE PEND-FACH-REC FROM FAC1-LINK-REC CL*84 -00845 WRITE PEND-FACH-REC FROM FAC6-LINK-REC CL*84 -00846 WRITE PEND-FACH-REC FROM FAC7-LINK-REC CL*84 -00847 ADD 1 TO WS-FAC7-PEN-CNT CL114 -00848 ADD 1 TO WS-LINE-CNT. CL*83 -00849 CL*83 -00850 P1011-EXIT. CL*10 -00851 EXIT. CL*10 -00852 CL*10 -00853 CL149 -00854 P1015-TRAILER-EDIT. DTSBX426 -00855 DTSBX426 -00856 DISPLAY ' 1015 - TRAILER PROCESS'. CL*49 -00857 IF WRK-TRAILER-REC-CNT > 1 DTSBX426 -00858 GO TO P1015-EXIT. DTSBX426 -00859 GO TO P1015-EXIT. CL*19 -00860 DTSBX426 -00861 * IF FAC9-BATCH-CNT = ZEROS DTSBX426 -00862 * MOVE EFT066 TO F907-MSG-TEXT DTSBX426 -00863 * MOVE '066' TO F907-MSG-ID DTSBX426 -00864 * MOVE ZEROS TO F907-EMP-NO DTSBX426 -00865 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 -00866 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX426 -00867 DTSBX426 +00761 IF WRK-TEMP-TRACE-NO = ZEROS DTSBX426 +00762 DISPLAY 'TRACE-NO = ZEROS ' WRK-TEMP-TRACE-NO CL**8 +00763 MOVE +2 TO RETURN-CODE. CL*37 +00764 * MOVE EFT014 TO F907-MSG-TEXT CL**8 +00765 * MOVE '014' TO F907-MSG-ID CL**8 +00766 * MOVE ZEROS TO F907-EMP-NO CL**8 +00767 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 +00768 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00769 * GO TO P1010-EXIT. CL**8 +00770 DTSBX426 +00771 SET MPRF-FOUND-YES-88 TO TRUE. CL135 +00772 CL123 +00773 * IF FAC6-DUTAS-EMP-NOA = 'DC' CL135 +00774 * GO TO P1010-EXIT. CL135 +00775 CL133 +00776 CL133 +00777 * DISPLAY 'ZEMP-NO: ' FAC6-DUTAS-EMP-NO CL135 +00778 CL132 +00779 * PERFORM P1070-READ-MPRF THRU P1070-EXIT. CL135 +00780 CL*65 +00781 * IF L910-NO-REC-88 CL135 +00782 * SET MPRF-FOUND-NO-88 TO TRUE CL135 +00783 * SET WRITE-T025-NO-88 TO TRUE CL135 +00784 * SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL135 +00785 * MOVE 'DTS01' TO WRK-DTS-RTN-CD CL135 +00786 * DISPLAY '***NO MPRF FOUND ON DUTAS -ERROR ' MPRF-EMP-NO. CL135 +00787 CL*65 +00788 * IF FAC6-AMOUNT = ZEROS OR MPRF-FOUND-NO-88 CL135 +00789 * SET MPAY-FOUND-NO-88 TO TRUE. CL135 +00790 P1010-EXIT. DTSBX426 +00791 EXIT. DTSBX426 +00792 DTSBX426 +00793 P1011-FAC7-EDIT. CL*10 +00794 DISPLAY ' 1011 - TYPE7 PROCESS'. CL*56 +00795 DISPLAY ' FAC7 RETURN CODE ' FAC7-RTN-CD. CL*60 +00796 CL*61 +00797 CL*56 +00798 * IF FAC7-RTN-CD = '98' CL*65 +00799 * DISPLAY ' ***** CODE 98 NO T025 WRITTEN ' MPAY-EMP-NO CL*65 +00800 * MOVE 'N' TO X425-AUTO-REV CL*65 +00801 * MOVE '*****' TO X425-AUTO-BATCH CL*65 +00802 * MOVE 'NOC' TO X425-AUTO-ITEM. CL*65 +00803 CL*87 +00804 MOVE ' DOES-ESSP ACH DEBIT RETURNS/REVERSALS ' CL113 +00805 TO HDR3-LITERAL. CL110 +00806 CL110 +00807 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL110 +00808 PERFORM P4000-PRNT-ACHD THRU P4000-EXIT. CL110 +00809 MOVE FAC7-RTN-CD TO WRK-FAC7-RTN-CD CL110 +00810 PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT. CL110 +00811 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1. CL110 +00812 ADD 1 TO WS-LINE-CNT. CL110 +00813 CL147 +00814 IF FAC7-TRANS-CD = '98' CL148 +00815 DISPLAY ' ***** CODE 98 NO T025 WRITTEN ' MPAY-EMP-NO CL147 +00816 GO TO P1011-EXIT. CL147 +00817 CL109 +00818 IF MPAY-FOUND-YES-88 CL109 +00819 DISPLAY ' MPAY SET TO TRUE ' CL111 +00820 PERFORM P1020-FIND-MPAY-INDEX THRU P1020-EXIT. CL109 +00821 CL109 +00822 CL105 +00823 IF WRK-FACH-PEND-REC-YES-88 CL*83 +00824 MOVE ' DOES-ESSP ACH DEBIT RETURNS NOT FOUND ON DUTAS' CL*87 +00825 TO HDR3-LITERAL CL*87 +00826 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT CL*90 +00827 PERFORM P4000-PRNT-ACHD THRU P4000-EXIT CL*87 +00828 MOVE WRK-DTS-RTN-CD TO WRK-FAC7-RTN-CD CL*83 +00829 PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT CL*83 +00830 WRITE ESSP-ACHR-REC FROM DETAIL-LINE-1 AFTER 1 CL*83 +00831 WRITE PEND-FACH-REC FROM FAC1-LINK-REC CL*84 +00832 WRITE PEND-FACH-REC FROM FAC6-LINK-REC CL*84 +00833 WRITE PEND-FACH-REC FROM FAC7-LINK-REC CL*84 +00834 ADD 1 TO WS-FAC7-PEN-CNT CL114 +00835 ADD 1 TO WS-LINE-CNT. CL*83 +00836 CL*83 +00837 P1011-EXIT. CL*10 +00838 EXIT. CL*10 +00839 CL*10 +00840 P1015-TRAILER-EDIT. DTSBX426 +00841 DTSBX426 +00842 DISPLAY ' 1015 - TRAILER PROCESS'. CL*49 +00843 IF WRK-TRAILER-REC-CNT > 1 DTSBX426 +00844 GO TO P1015-EXIT. DTSBX426 +00845 GO TO P1015-EXIT. CL*19 +00846 DTSBX426 +00847 * IF FAC9-BATCH-CNT = ZEROS DTSBX426 +00848 * MOVE EFT066 TO F907-MSG-TEXT DTSBX426 +00849 * MOVE '066' TO F907-MSG-ID DTSBX426 +00850 * MOVE ZEROS TO F907-EMP-NO DTSBX426 +00851 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 +00852 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX426 +00853 DTSBX426 +00854 DTSBX426 +00855 * IF FAC9-BATCH-CNT NOT NUMERIC DTSBX426 +00856 * MOVE EFT064 TO F907-MSG-TEXT DTSBX426 +00857 * MOVE '064' TO F907-MSG-ID DTSBX426 +00858 * MOVE ZEROS TO F907-EMP-NO DTSBX426 +00859 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 +00860 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX426 +00861 DTSBX426 +00862 * IF WRK-FACH-READ-CNT NOT = FAC9-BATCH-CNT DTSBX426 +00863 * MOVE EFT065 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX426 +00864 * MOVE '065' TO F907-MSG-ID, R907-MSG-ID DTSBX426 +00865 * MOVE ZEROS TO F907-EMP-NO DTSBX426 +00866 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 +00867 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX426 00868 DTSBX426 -00869 * IF FAC9-BATCH-CNT NOT NUMERIC DTSBX426 -00870 * MOVE EFT064 TO F907-MSG-TEXT DTSBX426 -00871 * MOVE '064' TO F907-MSG-ID DTSBX426 -00872 * MOVE ZEROS TO F907-EMP-NO DTSBX426 -00873 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 -00874 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX426 -00875 DTSBX426 -00876 * IF WRK-FACH-READ-CNT NOT = FAC9-BATCH-CNT DTSBX426 -00877 * MOVE EFT065 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX426 -00878 * MOVE '065' TO F907-MSG-ID, R907-MSG-ID DTSBX426 -00879 * MOVE ZEROS TO F907-EMP-NO DTSBX426 -00880 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 -00881 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX426 -00882 DTSBX426 -00883 MOVE FAC9-TOT-CREDIT-AMT TO TOT-TRAILER-AMT. DTSBX426 -00884 DTSBX426 -00885 IF TOT-FAC6-AMOUNT NOT = TOT-TRAILER-AMT DTSBX426 -00886 MOVE EFT067 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX426 -00887 MOVE '067' TO F907-MSG-ID, R907-MSG-ID DTSBX426 -00888 MOVE ZEROS TO F907-EMP-NO DTSBX426 -00889 MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 -00890 DISPLAY '****ERROR TYPE6 AMT NOT = TRAILER AMT ' CL122 -00891 FAC9-TRAILER-REC. CL122 -00892 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. CL122 +00869 MOVE FAC9-TOT-CREDIT-AMT TO TOT-TRAILER-AMT. DTSBX426 +00870 DTSBX426 +00871 IF TOT-FAC6-AMOUNT NOT = TOT-TRAILER-AMT DTSBX426 +00872 MOVE EFT067 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX426 +00873 MOVE '067' TO F907-MSG-ID, R907-MSG-ID DTSBX426 +00874 MOVE ZEROS TO F907-EMP-NO DTSBX426 +00875 MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX426 +00876 DISPLAY '****ERROR TYPE6 AMT NOT = TRAILER AMT ' CL122 +00877 FAC9-TRAILER-REC. CL122 +00878 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. CL122 +00879 DTSBX426 +00880 P1015-EXIT. DTSBX426 +00881 EXIT. DTSBX426 +00882 P1020-FIND-MPAY-INDEX. CL105 +00883 DTSBX426 +00884 DISPLAY ' 1020 - PROCESS'. DTSBX426 +00885 SET MPAY-FOUND-NO-88 TO TRUE CL111 +00886 SET TRACE-NO-END-NO-88 TO TRUE. CL111 +00887 MOVE LOW-VALUES TO ITRT-KEY-AREA. DTSBX426 +00888 SET ITRT-TRT-88 TO TRUE. DTSBX426 +00889 DTSBX426 +00890 DISPLAY 'TRACE-WRK-FAC6 ' WRK-FAC6-DOES-TRACE-NO CL*46 +00891 * MOVE WRK-NUMR-TRACE-NO TO ITRT-TRACE-NO. CL*46 +00892 MOVE WRK-FAC6-DOES-TRACE-NO TO ITRT-TRACE-NO. CL*46 00893 DTSBX426 -00894 P1015-EXIT. DTSBX426 -00895 EXIT. DTSBX426 -00896 P1020-FIND-MPAY-INDEX. CL105 -00897 DTSBX426 -00898 DISPLAY ' 1020 - PROCESS'. DTSBX426 -00899 SET MPAY-FOUND-NO-88 TO TRUE CL111 -00900 SET TRACE-NO-END-NO-88 TO TRUE. CL111 -00901 MOVE LOW-VALUES TO ITRT-KEY-AREA. DTSBX426 -00902 SET ITRT-TRT-88 TO TRUE. DTSBX426 -00903 DTSBX426 -00904 DISPLAY 'TRACE-WRK-FAC6 ' WRK-FAC6-DOES-TRACE-NO CL*46 -00905 * MOVE WRK-NUMR-TRACE-NO TO ITRT-TRACE-NO. CL*46 -00906 MOVE WRK-FAC6-DOES-TRACE-NO TO ITRT-TRACE-NO. CL*46 -00907 DTSBX426 -00908 * MOVE ZEROS TO ITRT-EMP-NO CL141 -00909 * ITRT-BATCH-NO CL141 -00910 * ITRT-ITEM-NO CL141 -00911 MOVE ZEROS TO WRK-MPAY-EMP-AMT CL141 -00912 WRK-MPAY-EMP-CNT CL136 -00913 WRK-MPAY-CNT. CL136 -00914 DTSBX426 -00915 MOVE ITRT-KEY-AREA TO ISKL-KEY-AREA. DTSBX426 -00916 DTSBX426 -00917 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBX426 -00918 IF L921-NO-REC-88 DTSBX426 -00919 DISPLAY ' TRACE NO NOT FOUND ' WRK-FAC6-DOES-TRACE-NO CL*46 -00920 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 -00921 MOVE 'DTS02' TO WRK-DTS-RTN-CD CL*83 -00922 GO TO P1020-EXIT DTSBX426 -00923 ELSE DTSBX426 -00924 PERFORM P1021-FIND-MPAY-RECORD THRU P1021-EXIT UNTIL CL105 -00925 TRACE-NO-END-YES-88. CL105 -00926 P1020-EXIT. CL105 -00927 EXIT. CL105 -00928 CL105 -00929 P1021-FIND-MPAY-RECORD. CL107 -00930 CL105 -00931 DISPLAY ' 1021 - PROCESS'. CL111 -00932 ADD 1 TO WRK-MPAY-CNT. CL105 -00933 MOVE ISKL-REC TO ITRT-REC. CL105 -00934 * DISPLAY ' MMAY CNT ' WRK-MPAY-CNT. CL145 -00935 * DISPLAY ' 1TRT TRACE NO - ' ITRT-TRACE-NO CL145 -00936 * DISPLAY ' 1FAC6 TRACE NO - ' CL145 -00937 * WRK-FAC6-DOES-TRACE-NO. CL145 -00938 * DISPLAY ' TRANSACTION TYPE ' ITRT-TRAN-TYPE CL145 -00939 * DISPLAY 'ITRT EMP ' ITRT-EMP-NO. CL145 -00940 * DISPLAY 'ITRT BATCH ' ITRT-BATCH-NO CL145 -00941 * DISPLAY 'ITRT ITEM ' ITRT-ITEM-NO. CL145 -00942 DTSBX426 -00943 IF ITRT-TRACE-NO NOT = WRK-FAC6-DOES-TRACE-NO CL**4 -00944 SET TRACE-NO-END-YES-88 TO TRUE CL105 -00945 IF WRK-MPAY-CNT = 1 CL105 -00946 DISPLAY ' 1TRT TRACE NO - NOT FOUND - ' ITRT-TRACE-NO CL105 -00947 DISPLAY ' 1FAC6 TRACE NO - NOT FOUND - ' CL105 -00948 WRK-FAC6-DOES-TRACE-NO CL105 -00949 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 -00950 MOVE 'DTS02' TO WRK-DTS-RTN-CD CL*83 -00951 GO TO P1021-EXIT CL105 -00952 ELSE CL105 -00953 GO TO P1021-EXIT CL105 -00954 END-IF CL105 -00955 END-IF. CL105 -00956 CL105 -00957 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX426 -00958 MOVE ITRT-EMP-NO TO MPAY-EMP-NO. DTSBX426 -00959 MOVE ITRT-BATCH-NO TO MPAY-BATCH-NO. DTSBX426 -00960 MOVE ITRT-ITEM-NO TO MPAY-ITEM-NO. DTSBX426 -00961 SET MPAY-PAY-88 TO TRUE. DTSBX426 -00962 DTSBX426 -00963 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 -00964 DISPLAY ' MPAY EMP-' MPAY-EMP-NO. DTSBX426 -00965 DISPLAY ' MPAY BAT-' MPAY-BATCH-NO. DTSBX426 -00966 DISPLAY ' MPAY ITM-' MPAY-ITEM-NO. DTSBX426 -00967 PERFORM S910-READ THRU S910-EXIT. DTSBX426 -00968 DTSBX426 -00969 IF L910-NO-REC-88 DTSBX426 -00970 DISPLAY ' MPAY - TRACE NO NOT FOUND - ' WRK-NUMR-TRACE-NO CL*78 -00971 DISPLAY ' FAC6 - TRACE NO - ' WRK-FAC6-DOES-TRACE-NO CL*78 -00972 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 -00973 MOVE 'DTS03' TO WRK-DTS-RTN-CD CL*83 -00974 SET MPAY-FOUND-NO-88 TO TRUE DTSBX426 -00975 SET TRACE-NO-END-YES-88 TO TRUE CL105 -00976 GO TO P1021-EXIT CL105 -00977 ELSE DTSBX426 -00978 MOVE MSKL-REC TO MPAY-REC. CL*82 -00979 SET MPAY-FOUND-YES-88 TO TRUE DTSBX426 -00980 CL*82 -00981 MOVE FAC6-AMOUNT TO WRK-FAC6-AMOUNT CL*98 -00982 MOVE MPAY-REMIT-AMT TO WRK-MPAY-AMOUNT CL*98 -00983 ADD MPAY-REMIT-AMT TO WRK-MPAY-EMP-AMT CL136 -00984 MOVE FAC6-AMOUNT TO WRK-AMT-DISP1 CL*98 -00985 MOVE MPAY-REMIT-AMT TO WRK-AMT-DISP2 CL*92 -00986 MOVE MPAY-REMIT-AMT TO NTE-AMOUNT. CL140 -00987 CL*82 -00988 ADD WRK-MPAY-AMOUNT TO TOT-MPAY-AMOUNT. CL114 -00989 DISPLAY ' WF RETURN AMOUNT ' WRK-AMT-DISP1 CL*82 -00990 DISPLAY 'MPAYRETURN AMOUNT ' WRK-AMT-DISP2 CL*82 -00991 CL*82 -00992 IF MPAY-FOUND-YES-88 CL105 -00993 MOVE MPAY-EMP-NO TO WRK-FAC6-EMP-NO CL124 -00994 MOVE WRK-FAC6-EMP-NO TO FAC6-DUTAS-EMP-NO CL124 -00995 PERFORM P1070-READ-MPRF THRU P1070-EXIT CL123 -00996 PERFORM P1040-BUILD-T025-RECORD THRU P1040-EXIT CL105 -00997 PERFORM P1045-BUILD-T003-RECORD THRU P1045-EXIT CL105 -00998 IF WRITE-T025-YES-88 CL105 -00999 MOVE T025-REC TO TSKL-REC CL105 -01000 PERFORM S927-WRITE THRU S927-EXIT CL105 -01001 MOVE T003-REC TO TSKL-REC CL105 -01002 PERFORM S927-WRITE THRU S927-EXIT CL105 -01003 PERFORM P1050-WRITE-ACH-RETURN THRU P1050-EXIT CL151 -01004 ADD 1 TO WRK-T025-WRITE-CNT CL105 -01005 ADD 1 TO WRK-T003-WRITE-CNT CL105 -01006 END-IF CL105 -01007 END-IF. CL105 -01008 CL105 -01009 PERFORM S921-READ-NEXT THRU S921-EXIT. CL105 -01010 CL105 -01011 IF L921-NO-REC-88 CL105 -01012 DISPLAY ' TRACE NO NXT NOT FOUND ' WRK-FAC6-DOES-TRACE-NO CL105 -01013 SET TRACE-NO-END-YES-88 TO TRUE. CL105 -01014 CL105 -01015 P1021-EXIT. CL105 -01016 EXIT. CL105 -01017 CL105 +00894 * MOVE ZEROS TO ITRT-EMP-NO CL141 +00895 * ITRT-BATCH-NO CL141 +00896 * ITRT-ITEM-NO CL141 +00897 MOVE ZEROS TO WRK-MPAY-EMP-AMT CL141 +00898 WRK-MPAY-EMP-CNT CL136 +00899 WRK-MPAY-CNT. CL136 +00900 DTSBX426 +00901 MOVE ITRT-KEY-AREA TO ISKL-KEY-AREA. DTSBX426 +00902 DTSBX426 +00903 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBX426 +00904 IF L921-NO-REC-88 DTSBX426 +00905 DISPLAY ' TRACE NO NOT FOUND ' WRK-FAC6-DOES-TRACE-NO CL*46 +00906 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 +00907 MOVE 'DTS02' TO WRK-DTS-RTN-CD CL*83 +00908 GO TO P1020-EXIT DTSBX426 +00909 ELSE DTSBX426 +00910 PERFORM P1021-FIND-MPAY-RECORD THRU P1021-EXIT UNTIL CL105 +00911 TRACE-NO-END-YES-88. CL105 +00912 P1020-EXIT. CL105 +00913 EXIT. CL105 +00914 CL105 +00915 P1021-FIND-MPAY-RECORD. CL107 +00916 CL105 +00917 DISPLAY ' 1021 - PROCESS'. CL111 +00918 ADD 1 TO WRK-MPAY-CNT. CL105 +00919 MOVE ISKL-REC TO ITRT-REC. CL105 +00920 * DISPLAY ' MMAY CNT ' WRK-MPAY-CNT. CL145 +00921 * DISPLAY ' 1TRT TRACE NO - ' ITRT-TRACE-NO CL145 +00922 * DISPLAY ' 1FAC6 TRACE NO - ' CL145 +00923 * WRK-FAC6-DOES-TRACE-NO. CL145 +00924 * DISPLAY ' TRANSACTION TYPE ' ITRT-TRAN-TYPE CL145 +00925 * DISPLAY 'ITRT EMP ' ITRT-EMP-NO. CL145 +00926 * DISPLAY 'ITRT BATCH ' ITRT-BATCH-NO CL145 +00927 * DISPLAY 'ITRT ITEM ' ITRT-ITEM-NO. CL145 +00928 DTSBX426 +00929 IF ITRT-TRACE-NO NOT = WRK-FAC6-DOES-TRACE-NO CL**4 +00930 SET TRACE-NO-END-YES-88 TO TRUE CL105 +00931 IF WRK-MPAY-CNT = 1 CL105 +00932 DISPLAY ' 1TRT TRACE NO - NOT FOUND - ' ITRT-TRACE-NO CL105 +00933 DISPLAY ' 1FAC6 TRACE NO - NOT FOUND - ' CL105 +00934 WRK-FAC6-DOES-TRACE-NO CL105 +00935 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 +00936 MOVE 'DTS02' TO WRK-DTS-RTN-CD CL*83 +00937 GO TO P1021-EXIT CL105 +00938 ELSE CL105 +00939 GO TO P1021-EXIT CL105 +00940 END-IF CL105 +00941 END-IF. CL105 +00942 CL105 +00943 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX426 +00944 MOVE ITRT-EMP-NO TO MPAY-EMP-NO. DTSBX426 +00945 MOVE ITRT-BATCH-NO TO MPAY-BATCH-NO. DTSBX426 +00946 MOVE ITRT-ITEM-NO TO MPAY-ITEM-NO. DTSBX426 +00947 SET MPAY-PAY-88 TO TRUE. DTSBX426 +00948 DTSBX426 +00949 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 +00950 DISPLAY ' MPAY EMP-' MPAY-EMP-NO. DTSBX426 +00951 DISPLAY ' MPAY BAT-' MPAY-BATCH-NO. DTSBX426 +00952 DISPLAY ' MPAY ITM-' MPAY-ITEM-NO. DTSBX426 +00953 PERFORM S910-READ THRU S910-EXIT. DTSBX426 +00954 DTSBX426 +00955 IF L910-NO-REC-88 DTSBX426 +00956 DISPLAY ' MPAY - TRACE NO NOT FOUND - ' WRK-NUMR-TRACE-NO CL*78 +00957 DISPLAY ' FAC6 - TRACE NO - ' WRK-FAC6-DOES-TRACE-NO CL*78 +00958 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 +00959 MOVE 'DTS03' TO WRK-DTS-RTN-CD CL*83 +00960 SET MPAY-FOUND-NO-88 TO TRUE DTSBX426 +00961 SET TRACE-NO-END-YES-88 TO TRUE CL105 +00962 GO TO P1021-EXIT CL105 +00963 ELSE DTSBX426 +00964 MOVE MSKL-REC TO MPAY-REC. CL*82 +00965 SET MPAY-FOUND-YES-88 TO TRUE DTSBX426 +00966 CL*82 +00967 MOVE FAC6-AMOUNT TO WRK-FAC6-AMOUNT CL*98 +00968 MOVE MPAY-REMIT-AMT TO WRK-MPAY-AMOUNT CL*98 +00969 ADD MPAY-REMIT-AMT TO WRK-MPAY-EMP-AMT CL136 +00970 MOVE FAC6-AMOUNT TO WRK-AMT-DISP1 CL*98 +00971 MOVE MPAY-REMIT-AMT TO WRK-AMT-DISP2 CL*92 +00972 MOVE MPAY-REMIT-AMT TO NTE-AMOUNT. CL140 +00973 CL*82 +00974 ADD WRK-MPAY-AMOUNT TO TOT-MPAY-AMOUNT. CL114 +00975 DISPLAY ' WF RETURN AMOUNT ' WRK-AMT-DISP1 CL*82 +00976 DISPLAY 'MPAYRETURN AMOUNT ' WRK-AMT-DISP2 CL*82 +00977 CL*82 +00978 IF MPAY-FOUND-YES-88 CL105 +00979 MOVE MPAY-EMP-NO TO WRK-FAC6-EMP-NO CL124 +00980 MOVE WRK-FAC6-EMP-NO TO FAC6-DUTAS-EMP-NO CL124 +00981 PERFORM P1070-READ-MPRF THRU P1070-EXIT CL123 +00982 PERFORM P1040-BUILD-T025-RECORD THRU P1040-EXIT CL105 +00983 PERFORM P1045-BUILD-T003-RECORD THRU P1045-EXIT CL105 +00984 IF WRITE-T025-YES-88 CL105 +00985 MOVE T025-REC TO TSKL-REC CL105 +00986 PERFORM S927-WRITE THRU S927-EXIT CL105 +00987 MOVE T003-REC TO TSKL-REC CL105 +00988 PERFORM S927-WRITE THRU S927-EXIT CL105 +00989 ADD 1 TO WRK-T025-WRITE-CNT CL105 +00990 ADD 1 TO WRK-T003-WRITE-CNT CL105 +00991 END-IF CL105 +00992 END-IF. CL105 +00993 CL105 +00994 PERFORM S921-READ-NEXT THRU S921-EXIT. CL105 +00995 CL105 +00996 IF L921-NO-REC-88 CL105 +00997 DISPLAY ' TRACE NO NXT NOT FOUND ' WRK-FAC6-DOES-TRACE-NO CL105 +00998 SET TRACE-NO-END-YES-88 TO TRUE. CL105 +00999 CL105 +01000 P1021-EXIT. CL105 +01001 EXIT. CL105 +01002 CL105 +01003 DTSBX426 +01004 P1040-BUILD-T025-RECORD. DTSBX426 +01005 DISPLAY ' 1040 - PROCESS'. DTSBX426 +01006 SET WRITE-T025-YES-88 TO TRUE. DTSBX426 +01007 SET WRK-TOLR-NO-88 TO TRUE CL*98 +01008 MOVE LENGTH OF T025-REC TO T025-LENGTH. CL*71 +01009 DTSBX426 +01010 * IF WRK-DTSBU005-YES CL*46 +01011 PERFORM S005-FROM-SYS THRU S005-EXIT DTSBX426 +01012 MOVE L005-DATE TO WRK-CURR-DATE DTSBX426 +01013 MOVE L005-TIME TO WRK-CURR-TIME DTSBX426 +01014 * MOVE 'N' TO WRK-DTSBU005-IND. CL*46 +01015 DTSBX426 +01016 MOVE MPAY-EMP-NO TO T025-EMP-NO. DTSBX426 +01017 MOVE 'WEB PAY' TO T025-ORIGIN. CL*83 01018 DTSBX426 -01019 P1040-BUILD-T025-RECORD. DTSBX426 -01020 DISPLAY ' 1040 - PROCESS'. DTSBX426 -01021 SET WRITE-T025-YES-88 TO TRUE. DTSBX426 -01022 SET WRK-TOLR-NO-88 TO TRUE CL*98 -01023 MOVE LENGTH OF T025-REC TO T025-LENGTH. CL*71 -01024 DTSBX426 -01025 * IF WRK-DTSBU005-YES CL*46 -01026 PERFORM S005-FROM-SYS THRU S005-EXIT DTSBX426 -01027 MOVE L005-DATE TO WRK-CURR-DATE DTSBX426 -01028 MOVE L005-TIME TO WRK-CURR-TIME DTSBX426 -01029 * MOVE 'N' TO WRK-DTSBU005-IND. CL*46 -01030 DTSBX426 -01031 MOVE MPAY-EMP-NO TO T025-EMP-NO. DTSBX426 -01032 MOVE 'WEB PAY' TO T025-ORIGIN. CL*83 -01033 DTSBX426 -01034 MOVE WRK-CURR-DATE TO T025-SYS-DATE. DTSBX426 -01035 MOVE WRK-CURR-TIME TO T025-SYS-TIME. DTSBX426 -01036 CL138 -01037 IF MPAY-EMP-NO NOT = WRK-MPAY-HOLD-EMP-NO CL138 -01038 MOVE MPAY-REMIT-AMT TO WRK-MPAY-EMP-AMT CL139 -01039 MOVE ZEROS TO WRK-MPAY-EMP-CNT. CL138 -01040 CL*77 -01041 IF WRK-MPAY-EMP-CNT = 1 CL136 -01042 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 -01043 SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 -01044 MOVE 'NG' TO T025-PAY-TYPE CL136 -01045 GO TO P1040-BUILD-T025-CONT. CL136 -01046 CL136 -01047 IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT CL136 -01048 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 -01049 DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT CL136 -01050 SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 -01051 MOVE 'NG' TO T025-PAY-TYPE CL136 -01052 GO TO P1040-BUILD-T025-CONT. CL136 -01053 CL136 -01054 * IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT OR CL136 -01055 * WRK-MPAY-HOLD-EMP-NO = MPAY-EMP-NO CL136 -01056 * MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 -01057 * DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT CL136 -01058 * SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 -01059 * MOVE 'NG' TO T025-PAY-TYPE CL136 -01060 * ELSE CL136 -01061 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL106 -01062 MOVE 1 TO WRK-MPAY-EMP-CNT CL136 -01063 SET T025-NSF-PEN-CHARGE-YES-88 TO TRUE CL120 -01064 MOVE 'NG' TO T025-PAY-TYPE. CL*77 -01065 DTSBX426 -01066 P1040-BUILD-T025-CONT. CL136 -01067 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK. DTSBX426 -01068 DTSBX426 -01069 COMPUTE WRK-MPAY-REMIT-AMT = MPAY-REMIT-AMT * -1. DTSBX426 -01070 MOVE WRK-MPAY-REMIT-AMT TO T025-REMIT-AMT. DTSBX426 -01071 CL*78 -01072 MOVE MPAY-TRACE-NO TO T025-TRACE-NO. DTSBX426 -01073 MOVE WRK-RECV-DATE TO T025-RECEIVED-DATE CL*92 -01074 T025-DEPOSIT-DATE. DTSBX426 -01075 DTSBX426 -01076 SET T025-WAIVE-INT-NO-88 TO TRUE CL120 -01077 SET T025-WAIVE-LATE-PEN-NO-88 TO TRUE CL120 -01078 MOVE ZERO TO T025-APPLIC-YRQ. DTSBX426 -01079 MOVE SPACES TO T025-APPLIC-IND. DTSBX426 -01080 MOVE MPAY-BATCH-NO TO T025-APPLIC-BATCH-NO. DTSBX426 -01081 MOVE MPAY-ITEM-NO TO T025-APPLIC-ITEM-NO. DTSBX426 -01082 MOVE SPACES TO T025-RESPONSIBLE-ACTIVITY. DTSBX426 -01083 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL**3 -01084 DTSBX426 -01085 CL107 -01086 DISPLAY ' EMP PAYMENT REVERSED ' MPAY-EMP-NO CL107 -01087 DISPLAY ' WF RETURN AMOUNT ' WRK-AMT-DISP1 CL107 -01088 DISPLAY ' MPAY RETURN AMOUNT ' WRK-AMT-DISP2 CL107 -01089 DISPLAY ' PAY TYPE ' T025-PAY-TYPE. CL107 -01090 CL107 -01091 PERFORM P4300-PRNT-REVR THRU P4300-EXIT. CL110 -01092 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1. CL110 -01093 ADD 1 TO WS-LINE-CNT. CL110 -01094 CL110 -01095 DTSBX426 -01096 P1040-EXIT. DTSBX426 -01097 EXIT. DTSBX426 -01098 DTSBX426 -01099 P1045-BUILD-T003-RECORD. CL*71 -01100 CL*70 -01101 PERFORM S3000-INIT-T003 THRU S3000-EXIT. CL*70 -01102 CL*70 -01103 MOVE WRK-MNTE-SUBJECT TO MNTE-SUBJECT CL*70 -01104 CL*70 -01105 MOVE +1 TO MNTE-TEXT-CNT. CL*70 -01106 MOVE WRK-MNTE-REASON TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 -01107 DISPLAY 'MNTE-REASON: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 -01108 CL*70 -01109 ADD +1 TO MNTE-TEXT-CNT. CL*95 -01110 MOVE WRK-MNTE-TRACE-NO TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 -01111 DISPLAY 'MNTE-TRACEN: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 -01112 CL*74 -01113 ADD +1 TO MNTE-TEXT-CNT. CL*95 -01114 MOVE WRK-MNTE-DEP-DATE TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 -01115 DISPLAY 'MNTE-DEPDTE: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 -01116 CL*74 -01117 ADD +1 TO MNTE-TEXT-CNT. CL*95 -01118 MOVE WRK-MNTE-BATCH-ITEM TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 -01119 DISPLAY 'MNTE-BTHITM: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 -01120 CL*74 -01121 ADD +1 TO MNTE-TEXT-CNT. CL*95 -01122 MOVE WRK-MNTE-ACCT-NO TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 -01123 DISPLAY 'MNTE-ACCTNO: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 -01124 CL*74 -01125 ADD +1 TO MNTE-TEXT-CNT. CL*95 -01126 MOVE WRK-MNTE-AMOUNT TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 -01127 DISPLAY 'MNTE-AMOUNT: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 -01128 CL*74 -01129 * ADD +1 TO MNTE-TEXT-CNT. CL*98 -01130 * MOVE WRK-MNTE-AMOUNT TO MNTE-TEXT(MNTE-TEXT-CNT) CL*98 -01131 CL*77 -01132 IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT CL140 -01133 SET WRK-TOLR-YES-88 TO TRUE. CL106 -01134 CL106 -01135 IF WRK-TOLR-YES-88 CL*98 -01136 DISPLAY 'P1045 - TOLERATED NO FEE: ' WRK-MPAY-AMOUNT CL112 -01137 ADD +1 TO MNTE-TEXT-CNT CL*95 -01138 MOVE WRK-MNTE-NO-FEE TO MNTE-TEXT(MNTE-TEXT-CNT). CL*77 -01139 CL*77 -01140 MOVE MNTE-REC TO T003-MNTE-REC. CL*70 -01141 CL*70 -01142 P1045-EXIT. CL*70 -01143 EXIT. CL*70 -01144 P1050-WRITE-ACH-RETURN. CL151 -01145 MOVE LENGTH OF R333-REC TO R333-LENGTH CL156 -01146 MOVE MPRF-EMP-NO TO R333-EMP-NO. CL151 -01147 MOVE ZEROS TO R333-CURR-MAIL-DATE. CL155 -01148 MOVE MPRF-PRIMARY-NAME TO R333-PRIMARY-NAME CL151 -01149 MOVE NTE-TRACE-NO TO R333-ESSP-PAYMENT-ID CL151 -01150 MOVE FAC6-AMOUNT TO R333-ACH-AMOUNT CL151 -01151 MOVE NTE-ACCT-NO TO R333-ACH-ACCOUNT-NO CL154 -01152 MOVE HEADER-3A-DATE TO R333-ACH-RETURN-DATE CL155 -01153 MOVE NTE-REASON TO R333-REASON-RETURNED. CL151 -01154 CL151 -01155 MOVE ALL '?' TO R333-FMT-ADDR. CL154 -01156 CL151 -01157 SET L111-LOOKUP-TAD-88 TO TRUE. CL151 -01158 SET L111-LOOKUP-TAD-88 TO TRUE. CL151 -01159 CL151 -01160 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. CL151 -01161 CL151 -01162 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. CL151 -01163 CL151 -01164 IF L111-ADDR-FOUND-88 CL151 -01165 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE CL151 -01166 SET L112-ANCHOR-LAST-88 TO TRUE CL151 -01167 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME CL151 -01168 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA CL151 -01169 PERFORM S112-FORMAT-ADDR THRU S112-EXIT CL151 -01170 MOVE L112-MAILING-ADDRESS TO R333-FMT-ADDR. CL151 -01171 CL151 -01172 PERFORM S946-R333-WRITE THRU S946-EXIT. CL151 -01173 CL151 -01174 CL151 -01175 P1050-EXIT. CL151 -01176 EXIT. CL151 -01177 P1055-WRITE-F907. CL*70 -01178 ************************************************************** DTSBX426 -01179 * WRITE FACH ERROR RETURN FILE(F907) * DTSBX426 -01180 ************************************************************** DTSBX426 -01181 DTSBX426 -01182 DISPLAY ' 1055 - PROCESS'. DTSBX426 -01183 ADD +1 TO WRK-F907-WRITE-CNT. DTSBX426 -01184 MOVE WRK-MOD-NAME TO F907-MODULE-NAME. DTSBX426 -01185 MOVE IN-FACH-REC TO F907-GOV1-REC. DTSBX426 -01186 MOVE ZEROS TO F907-EMP-NO. DTSBX426 -01187 DTSBX426 -01188 CALL 'DTSBU946' USING F907-REC. DTSBX426 -01189 DTSBX426 -01190 DTSBX426 -01191 P1055-EXIT. DTSBX426 -01192 EXIT. DTSBX426 -01193 P4000-PRNT-ACHD. CL**7 -01194 MOVE FAC6-DUTAS-EMP-NO TO X425-EMP-NO CL**7 -01195 MOVE FAC6-DUTAS-EMP-NAME TO X425-NAME-CHECK. CL127 -01196 MOVE FAC6-BANK-ACCT-NO TO X425-ACCT-NUMBER NTE-ACCT-NO CL*71 -01197 MOVE FAC6-RECV-BANK-ID TO X425-BANK-ID. CL*38 -01198 MOVE WRK-FAC6-AMOUNT TO X425-X145-REMIT CL*72 -01199 MOVE WRK-TEMP-TRACE-NOA TO X425-X145-TRACE-NOB. CL*21 -01200 MOVE WRK-TEMP-TRACE-NOA TO NTE-TRACE-NO. CL*71 -01201 * MOVE SPACES TO X425-MESSAGE. CL*51 -01202 * IF MPAY-FOUND-YES-88 CL110 -01203 * MOVE MPAY-BATCH-NO TO X425-AUTO-BATCH NTE-BATCH-NO CL110 -01204 * MOVE MPAY-ITEM-NO TO X425-AUTO-ITEM NTE-ITEM-NO CL110 -01205 * MOVE '/' TO X425-AUTO-FILL CL110 -01206 * MOVE 'Y ' TO X425-AUTO-REV CL110 -01207 * MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9 CL110 -01208 * SET L001-FROM-FED-8 TO TRUE CL110 -01209 * PERFORM S001-DATE THRU S001-EXIT CL110 -01210 * MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE CL110 -01211 * ELSE CL110 -01212 MOVE ' ' TO X425-AUTO-FILL CL*53 -01213 MOVE 'FARGO' TO X425-AUTO-BATCH CL110 -01214 MOVE 'RTN' TO X425-AUTO-ITEM CL110 -01215 MOVE '* ' TO X425-AUTO-REV. CL110 -01216 CL*71 -01217 CL*53 -01218 P4000-EXIT. CL**7 -01219 EXIT. CL**7 -01220 P4100-PRINT-HEADER. CL**6 -01221 IF WS-LINE-CNT > 58 CL*90 -01222 ADD +1 TO WS-PAGE-CNT CL**6 -01223 MOVE WS-PAGE-CNT TO HEADER-3-PAGE CL*89 -01224 * MOVE ' -/+ ----- MONTHLY COUNT' TO HEADER-5-NAME CL*10 -01225 MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE CL*10 -01226 MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME CL*10 -01227 WRITE ESSP-ACHD-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*10 -01228 WRITE ESSP-ACHD-REC FROM HEADER-2 AFTER 1 CL*10 -01229 WRITE ESSP-ACHD-REC FROM HEADER-3 AFTER 1 CL*10 -01230 WRITE ESSP-ACHD-REC FROM HEADER-3A AFTER 1 CL*10 -01231 WRITE ESSP-ACHD-REC FROM HEADER-4 AFTER 1 CL*10 -01232 WRITE ESSP-ACHD-REC FROM HEADER-5 AFTER 1 CL*10 -01233 WRITE ESSP-ACHD-REC FROM HEADER-6 AFTER 1 CL*90 -01234 MOVE +6 TO WS-LINE-CNT. CL*90 -01235 P4100-EXIT. CL**6 -01236 EXIT. CL**6 -01237 CL**6 -01238 P4200-PRINT-HEADER. CL*90 -01239 IF WS-RETN-CNT > 58 CL*90 -01240 ADD +1 TO WS-PAGE-CNT CL*90 -01241 MOVE WS-PAGE-CNT TO HEADER-3-PAGE CL*90 -01242 * MOVE ' -/+ ----- MONTHLY COUNT' TO HEADER-5-NAME CL*90 -01243 MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE CL*90 -01244 MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME CL*90 -01245 WRITE ESSP-ACHR-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*90 -01246 WRITE ESSP-ACHR-REC FROM HEADER-2 AFTER 1 CL*90 -01247 WRITE ESSP-ACHR-REC FROM HEADER-3 AFTER 1 CL*90 -01248 WRITE ESSP-ACHR-REC FROM HEADER-3A AFTER 1 CL*90 -01249 WRITE ESSP-ACHR-REC FROM HEADER-4 AFTER 1 CL*90 -01250 WRITE ESSP-ACHR-REC FROM HEADER-5 AFTER 1 CL*90 -01251 WRITE ESSP-ACHR-REC FROM HEADER-6 AFTER 1 CL*90 -01252 MOVE +6 TO WS-RETN-CNT. CL*90 -01253 P4200-EXIT. CL*90 -01254 EXIT. CL*90 -01255 CL*90 -01256 P4300-PRNT-REVR. CL110 -01257 MOVE FAC6-DUTAS-EMP-NO TO X425-EMP-NO CL110 -01258 MOVE FAC6-DUTAS-EMP-NAME TO X425-NAME-CHECK. CL127 -01259 MOVE FAC6-BANK-ACCT-NO TO X425-ACCT-NUMBER NTE-ACCT-NO CL110 -01260 MOVE FAC6-RECV-BANK-ID TO X425-BANK-ID. CL110 -01261 MOVE WRK-MPAY-REMIT-AMT TO X425-X145-REMIT CL110 -01262 MOVE WRK-TEMP-TRACE-NOA TO X425-X145-TRACE-NOB. CL110 -01263 MOVE WRK-TEMP-TRACE-NOA TO NTE-TRACE-NO. CL110 -01264 * MOVE SPACES TO X425-MESSAGE. CL119 -01265 IF MPAY-FOUND-YES-88 CL110 -01266 MOVE MPAY-BATCH-NO TO X425-AUTO-BATCH NTE-BATCH-NO CL110 -01267 MOVE MPAY-ITEM-NO TO X425-AUTO-ITEM NTE-ITEM-NO CL110 -01268 MOVE '/' TO X425-AUTO-FILL CL110 -01269 MOVE 'Y ' TO X425-AUTO-REV CL110 -01270 MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9 CL110 -01271 SET L001-FROM-FED-8 TO TRUE CL110 -01272 PERFORM S001-DATE THRU S001-EXIT CL110 -01273 MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE CL110 -01274 ELSE CL110 -01275 MOVE ' ' TO X425-AUTO-FILL CL110 -01276 MOVE 'STAFF' TO X425-AUTO-BATCH CL110 -01277 MOVE 'REV' TO X425-AUTO-ITEM CL110 -01278 MOVE 'N ' TO X425-AUTO-REV. CL110 -01279 CL110 -01280 CL110 -01281 P4300-EXIT. CL110 -01282 EXIT. CL110 -01283 P5000-ACH-RETURN-CODE. CL*45 -01284 IF WRK-FAC7-RTN-CD = WRK-RTN-CD CL*83 -01285 GO TO P5000-EXIT. CL*45 -01286 CL*45 -01287 SET WRK-FAC7-RTN-INVALID-88 TO TRUE CL*46 -01288 CL*45 -01289 PERFORM VARYING ACH-RTN-IDX FROM 1 BY 1 CL*45 -01290 UNTIL WRK-FAC7-RTN-VALID-88 CL*46 -01291 OR ACH-RTN-IDX > ACH-RTN-CD-CNT CL*45 -01292 OR ACH-RTN-CD(ACH-RTN-IDX) = SPACE CL*45 -01293 IF WRK-FAC7-RTN-CD = CL*83 -01294 ACH-RTN-CD(ACH-RTN-IDX) CL*46 -01295 SET WRK-FAC7-RTN-VALID-88 TO TRUE CL*46 -01296 MOVE ACH-RTN-CD (ACH-RTN-IDX) TO WRK-RTN-CD CL*45 -01297 MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO X425-MESSAGE CL*57 -01298 MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO NTE-REASON CL*71 -01299 END-IF CL*45 -01300 END-PERFORM. CL*45 -01301 CL*45 -01302 IF WRK-FAC7-RTN-INVALID-88 CL*46 -01303 MOVE '???????? INVALID RETURN CODE ' TO X425-MESSAGE CL*57 -01304 GO TO P5000-EXIT. CL*45 -01305 P5000-EXIT. CL*45 -01306 EXIT. CL*45 -01307 CL*45 -01308 T0000-TERMINATE. DTSBX426 -01309 DTSBX426 -01310 IF NOT FACH-TYPE-TRAILER-88 DTSBX426 -01311 DISPLAY ' LAST RECORD IS NOT A TRAILER RECORD ' DTSBX426 -01312 DISPLAY ' ' DTSBX426 -01313 DISPLAY ' LAST RECORD ' FACH-SKELETAL-REC DTSBX426 -01314 DISPLAY ' **** ACH FILE EMPTY *****'. CL*34 -01315 DTSBX426 -01316 IF WRK-FACH-READ-CNT = 2 DTSBX426 -01317 MOVE +3 TO RETURN-CODE CL*32 -01318 DISPLAY ' *** WELLS FARGO FILE CONTAINS 2 RECS ' CL**3 -01319 DISPLAY ' *** NO REJECTED PAYMENT RECORDS *'. DTSBX426 -01320 DTSBX426 -01321 DTSBX426 -01322 * MOVE -1 TO F907-LENGTH. CL**8 -01323 * CALL 'DTSBU946' USING F907-REC. CL**8 -01324 DTSBX426 -01325 DTSBX426 -01326 DTSBX426 -01327 DISPLAY ' '. DTSBX426 -01328 DTSBX426 -01329 DISPLAY '*** DTSBX426 TERMINATION STATISTICS ***'. CL*41 -01330 DTSBX426 -01331 DISPLAY ' '. DTSBX426 -01332 DTSBX426 -01333 DISPLAY 'NUMBER OF FACH RECORDS READ : ' DTSBX426 -01334 WRK-FACH-READ-CNT. DTSBX426 -01335 DTSBX426 -01336 DISPLAY 'NUMBER IN TRAILER BATCH COUNT : ' DTSBX426 -01337 FAC9-BATCH-CNT. DTSBX426 -01338 DTSBX426 -01339 DISPLAY 'HEADERS IN FACH FILE : ' DTSBX426 -01340 WRK-HEADER-RECORDS. DTSBX426 -01341 DTSBX426 -01342 DISPLAY 'TRAILERS IN FACH FILE : ' DTSBX426 -01343 WRK-TRAILER-RECORDS. DTSBX426 -01344 DTSBX426 -01345 DISPLAY 'DETAIL RECORDS IN FACH FILE : ' DTSBX426 -01346 WRK-FAC6-RECORDS. DTSBX426 -01347 DTSBX426 -01348 DISPLAY 'NUMBER OF OTHER RECORDS IN FACH FILE: ' DTSBX426 -01349 WRK-OTHER-RECORDS. DTSBX426 -01350 DTSBX426 -01351 DISPLAY 'NUMBER OF T025 RECORDS WRITTEN : ' DTSBX426 -01352 WRK-T025-WRITE-CNT. DTSBX426 -01353 DTSBX426 -01354 DISPLAY 'NUMBER OF F907 RECORDS WRITTEN : ' DTSBX426 -01355 WRK-F907-WRITE-CNT. DTSBX426 -01356 * IF WRK-F907-WRITE-CNT > 0 CL*24 -01357 * MOVE +3 TO RETURN-CODE CL*24 -01358 * DISPLAY ' FACH INPUT FILE CONTAINS ERRORS+++' CL*24 -01359 * DISPLAY ' PROGRAM WILL ABEND ***************'. CL*24 -01360 * PERFORM S999-ABEND THRU S999-EXIT. DTSBX426 -01361 DTSBX426 -01362 IF WS-LINE-CNT > 52 OR RETURN-CODE = +3 CL*32 -01363 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*24 -01364 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1 CL*32 -01365 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-2 AFTER 3 CL*36 -01366 END-IF. CL*24 -01367 CL114 -01368 MOVE WRK-FAC6-RECORDS TO WS-FOOTING-CNT. CL*24 -01369 MOVE TOT-FAC6-AMOUNT TO WS-TOTAL-REMIT. CL*24 -01370 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1. CL*25 -01371 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-2 AFTER 1. CL*25 -01372 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1. CL*25 -01373 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1. CL*25 -01374 * WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL*25 -01375 * WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL*24 -01376 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7 AFTER 1. CL*25 -01377 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8 AFTER 1. CL*25 -01378 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3. CL117 -01379 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1. CL*25 -01380 CL*24 -01381 DISPLAY ' '. CL*24 -01382 DTSBX426 -01383 MOVE WRK-FAC6-RECORDS TO WS-FOOTING-CNT. CL114 -01384 MOVE WS-FAC7-PEN-CNT TO WS-X145-ERR-CNT WS-X145-PEN-CNT CL114 -01385 MOVE TOT-MPAY-AMOUNT TO WS-TOT-REMIT. CL114 -01386 MOVE WRK-T025-WRITE-CNT TO WS-T025-WRITE-CNT. CL115 -01387 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1. CL*88 -01388 WRITE ESSP-ACHD-REC FROM FOOTDTS-LINE-2 AFTER 1. CL117 -01389 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1. CL114 -01390 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1. CL114 -01391 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-5 AFTER 1. CL116 -01392 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-6 AFTER 1. CL116 -01393 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7 AFTER 1. CL114 -01394 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8 AFTER 1. CL114 -01395 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3. CL*88 -01396 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1. CL*88 -01397 CL*88 -01398 IF RETURN-CODE NOT = +3 CL114 -01399 WRITE ESSP-ACHD-REC FROM ZNOTE1 AFTER 2 CL114 -01400 WRITE ESSP-ACHD-REC FROM CNOTE1 AFTER 1 CL114 -01401 WRITE ESSP-ACHD-REC FROM CNOTE2 AFTER 1 CL114 -01402 WRITE ESSP-ACHD-REC FROM CNOTE3 AFTER 1 CL114 -01403 END-IF. CL114 -01404 CL*58 -01405 CL*29 -01406 CLOSE IN-FACH ESSP-ACHD-FILE PEND-FACH-FILE CL*86 -01407 ESSP-ACHR-FILE. CL*86 -01408 PERFORM S910-CLOSE THRU S910-EXIT. CL*29 -01409 PERFORM S927-CLOSE THRU S927-EXIT. CL*29 -01410 CL*29 -01411 CL*29 -01412 DTSBX426 -01413 T0000-EXIT. DTSBX426 -01414 EXIT. DTSBX426 -01415 DTSBX426 -01416 P1070-READ-MPRF. DTSBX426 -01417 DTSBX426 -01418 DTSBX426 -01419 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX426 -01420 SET MPRF-PRF-88 TO TRUE. DTSBX426 -01421 DISPLAY ' FAC6EMP ' FAC6-DUTAS-EMP-NO. CL130 -01422 DISPLAY ' MPAYEMP ' MPAY-EMP-NO. CL131 -01423 MOVE MPAY-EMP-NO TO MPRF-EMP-NO. CL131 -01424 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 -01425 DTSBX426 -01426 PERFORM S910-READ THRU S910-EXIT. DTSBX426 -01427 DTSBX426 -01428 IF L910-OK-88 DTSBX426 -01429 SET L910-OK-88 TO TRUE DTSBX426 -01430 MOVE MSKL-REC TO MPRF-REC DTSBX426 -01431 ELSE DTSBX426 -01432 DISPLAY '********NO MPRF-REC FOUND ' L910-RESULT-IND CL131 -01433 SET L910-NO-REC-88 TO TRUE DTSBX426 -01434 DISPLAY '6090 L910 NO RECORD FOUND ' DTSBX426 -01435 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX426 -01436 GO TO P1070-EXIT. DTSBX426 -01437 DTSBX426 -01438 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK CL127 -01439 WS-FAC6-DUTAS-EMP-NAME. CL129 -01440 DISPLAY ' EMP ' MPRF-PRIMARY-NAME ' ' MPRF-EMP-NO CL129 -01441 DISPLAY ' T25 ' T025-NAME-CHECK ' ' MPRF-EMP-NO CL129 -01442 MOVE WS-FAC6-DUTAS-EMP-NAMEA TO FAC6-DUTAS-EMP-NAME. CL129 -01443 P1070-EXIT. DTSBX426 -01444 EXIT. DTSBX426 -01445 DTSBX426 -01446 S3000-INIT-T003. CL*70 -01447 MOVE LOW-VALUES TO MNTE-KEY-AREA. CL*70 -01448 MOVE MPAY-EMP-NO TO MNTE-EMP-NO. CL*70 -01449 SET MNTE-NTE-88 TO TRUE. CL*70 -01450 MOVE +0 TO MNTE-PURGE-DATE. CL*70 -01451 SET MNTE-NOT-CONVERTED-88 TO TRUE. CL*70 -01452 CL*70 -01453 MOVE L005-DATE TO MNTE-ESTB-DATE CL*72 -01454 MNTE-CHNG-DATE. CL*70 -01455 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME CL*70 -01456 MNTE-DATA-ESTB-ABSTIME CL*70 -01457 MNTE-CHNG-ABSTIME. CL*70 -01458 MOVE 'WEBESSP ' TO MNTE-ESTB-OP-ID CL*70 -01459 MNTE-CHNG-OP-ID. CL*70 -01460 MOVE +0 TO MNTE-TEXT-CNT. CL*70 -01461 MOVE SPACES TO MNTE-TEXT-AREA. CL*70 -01462 CL*70 -01463 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 -01464 MOVE '003' TO T003-REC-TYPE. CL*70 -01465 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 -01466 MOVE '003' TO T003-REC-TYPE. CL*70 -01467 MOVE MPAY-EMP-NO TO T003-EMP-NO. CL*70 -01468 MOVE 'WEB PAY ' TO T003-ORIGIN. CL*70 -01469 MOVE L005-DATE TO T003-SYS-DATE. CL*72 -01470 MOVE L005-TIME TO T003-SYS-TIME. CL*72 -01471 SET T003-ADD-MNTE-88 TO TRUE. CL*70 -01472 CL*70 -01473 S3000-EXIT. CL*70 -01474 EXIT. CL*70 -01475 CL*70 -01476 DTSBX426 -01477 S001-FROM-FED-8. CL*71 -01478 SET L001-FROM-FED-8 TO TRUE. CL*71 -01479 GO TO S001-DATE. CL*71 -01480 CL*71 -01481 S001-DATE. CL*71 -01482 SKIP1 CL*71 -01483 CALL 'DTSBU001' USING L001-LINK-AREA. CL*71 -01484 S001-EXIT. CL*71 -01485 EXIT. CL*71 -01486 S005-FROM-SYS. CL*71 +01019 MOVE WRK-CURR-DATE TO T025-SYS-DATE. DTSBX426 +01020 MOVE WRK-CURR-TIME TO T025-SYS-TIME. DTSBX426 +01021 CL138 +01022 IF MPAY-EMP-NO NOT = WRK-MPAY-HOLD-EMP-NO CL138 +01023 MOVE MPAY-REMIT-AMT TO WRK-MPAY-EMP-AMT CL139 +01024 MOVE ZEROS TO WRK-MPAY-EMP-CNT. CL138 +01025 CL*77 +01026 IF WRK-MPAY-EMP-CNT = 1 CL136 +01027 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 +01028 SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 +01029 MOVE 'NG' TO T025-PAY-TYPE CL136 +01030 GO TO P1040-BUILD-T025-CONT. CL136 +01031 CL136 +01032 IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT CL136 +01033 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 +01034 DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT CL136 +01035 SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 +01036 MOVE 'NG' TO T025-PAY-TYPE CL136 +01037 GO TO P1040-BUILD-T025-CONT. CL136 +01038 CL136 +01039 * IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT OR CL136 +01040 * WRK-MPAY-HOLD-EMP-NO = MPAY-EMP-NO CL136 +01041 * MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 +01042 * DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT CL136 +01043 * SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 +01044 * MOVE 'NG' TO T025-PAY-TYPE CL136 +01045 * ELSE CL136 +01046 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL106 +01047 MOVE 1 TO WRK-MPAY-EMP-CNT CL136 +01048 SET T025-NSF-PEN-CHARGE-YES-88 TO TRUE CL120 +01049 MOVE 'NG' TO T025-PAY-TYPE. CL*77 +01050 DTSBX426 +01051 P1040-BUILD-T025-CONT. CL136 +01052 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK. DTSBX426 +01053 DTSBX426 +01054 COMPUTE WRK-MPAY-REMIT-AMT = MPAY-REMIT-AMT * -1. DTSBX426 +01055 MOVE WRK-MPAY-REMIT-AMT TO T025-REMIT-AMT. DTSBX426 +01056 CL*78 +01057 MOVE MPAY-TRACE-NO TO T025-TRACE-NO. DTSBX426 +01058 MOVE WRK-RECV-DATE TO T025-RECEIVED-DATE CL*92 +01059 T025-DEPOSIT-DATE. DTSBX426 +01060 DTSBX426 +01061 SET T025-WAIVE-INT-NO-88 TO TRUE CL120 +01062 SET T025-WAIVE-LATE-PEN-NO-88 TO TRUE CL120 +01063 MOVE ZERO TO T025-APPLIC-YRQ. DTSBX426 +01064 MOVE SPACES TO T025-APPLIC-IND. DTSBX426 +01065 MOVE MPAY-BATCH-NO TO T025-APPLIC-BATCH-NO. DTSBX426 +01066 MOVE MPAY-ITEM-NO TO T025-APPLIC-ITEM-NO. DTSBX426 +01067 MOVE SPACES TO T025-RESPONSIBLE-ACTIVITY. DTSBX426 +01068 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL**3 +01069 DTSBX426 +01070 CL107 +01071 DISPLAY ' EMP PAYMENT REVERSED ' MPAY-EMP-NO CL107 +01072 DISPLAY ' WF RETURN AMOUNT ' WRK-AMT-DISP1 CL107 +01073 DISPLAY ' MPAY RETURN AMOUNT ' WRK-AMT-DISP2 CL107 +01074 DISPLAY ' PAY TYPE ' T025-PAY-TYPE. CL107 +01075 CL107 +01076 PERFORM P4300-PRNT-REVR THRU P4300-EXIT. CL110 +01077 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1. CL110 +01078 ADD 1 TO WS-LINE-CNT. CL110 +01079 CL110 +01080 DTSBX426 +01081 P1040-EXIT. DTSBX426 +01082 EXIT. DTSBX426 +01083 DTSBX426 +01084 P1045-BUILD-T003-RECORD. CL*71 +01085 CL*70 +01086 PERFORM S3000-INIT-T003 THRU S3000-EXIT. CL*70 +01087 CL*70 +01088 MOVE WRK-MNTE-SUBJECT TO MNTE-SUBJECT CL*70 +01089 CL*70 +01090 MOVE +1 TO MNTE-TEXT-CNT. CL*70 +01091 MOVE WRK-MNTE-REASON TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01092 DISPLAY 'MNTE-REASON: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01093 CL*70 +01094 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01095 MOVE WRK-MNTE-TRACE-NO TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01096 DISPLAY 'MNTE-TRACEN: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01097 CL*74 +01098 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01099 MOVE WRK-MNTE-DEP-DATE TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01100 DISPLAY 'MNTE-DEPDTE: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01101 CL*74 +01102 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01103 MOVE WRK-MNTE-BATCH-ITEM TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01104 DISPLAY 'MNTE-BTHITM: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01105 CL*74 +01106 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01107 MOVE WRK-MNTE-ACCT-NO TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01108 DISPLAY 'MNTE-ACCTNO: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01109 CL*74 +01110 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01111 MOVE WRK-MNTE-AMOUNT TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01112 DISPLAY 'MNTE-AMOUNT: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01113 CL*74 +01114 * ADD +1 TO MNTE-TEXT-CNT. CL*98 +01115 * MOVE WRK-MNTE-AMOUNT TO MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01116 CL*77 +01117 IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT CL140 +01118 SET WRK-TOLR-YES-88 TO TRUE. CL106 +01119 CL106 +01120 IF WRK-TOLR-YES-88 CL*98 +01121 DISPLAY 'P1045 - TOLERATED NO FEE: ' WRK-MPAY-AMOUNT CL112 +01122 ADD +1 TO MNTE-TEXT-CNT CL*95 +01123 MOVE WRK-MNTE-NO-FEE TO MNTE-TEXT(MNTE-TEXT-CNT). CL*77 +01124 CL*77 +01125 MOVE MNTE-REC TO T003-MNTE-REC. CL*70 +01126 CL*70 +01127 P1045-EXIT. CL*70 +01128 EXIT. CL*70 +01129 P1055-WRITE-F907. CL*70 +01130 ************************************************************** DTSBX426 +01131 * WRITE FACH ERROR RETURN FILE(F907) * DTSBX426 +01132 ************************************************************** DTSBX426 +01133 DTSBX426 +01134 DISPLAY ' 1055 - PROCESS'. DTSBX426 +01135 ADD +1 TO WRK-F907-WRITE-CNT. DTSBX426 +01136 MOVE WRK-MOD-NAME TO F907-MODULE-NAME. DTSBX426 +01137 MOVE IN-FACH-REC TO F907-GOV1-REC. DTSBX426 +01138 MOVE ZEROS TO F907-EMP-NO. DTSBX426 +01139 DTSBX426 +01140 CALL 'DTSBU946' USING F907-REC. DTSBX426 +01141 DTSBX426 +01142 DTSBX426 +01143 P1055-EXIT. DTSBX426 +01144 EXIT. DTSBX426 +01145 P4000-PRNT-ACHD. CL**7 +01146 MOVE FAC6-DUTAS-EMP-NO TO X425-EMP-NO CL**7 +01147 MOVE FAC6-DUTAS-EMP-NAME TO X425-NAME-CHECK. CL127 +01148 MOVE FAC6-BANK-ACCT-NO TO X425-ACCT-NUMBER NTE-ACCT-NO CL*71 +01149 MOVE FAC6-RECV-BANK-ID TO X425-BANK-ID. CL*38 +01150 MOVE WRK-FAC6-AMOUNT TO X425-X145-REMIT CL*72 +01151 MOVE WRK-TEMP-TRACE-NOA TO X425-X145-TRACE-NOB. CL*21 +01152 MOVE WRK-TEMP-TRACE-NOA TO NTE-TRACE-NO. CL*71 +01153 * MOVE SPACES TO X425-MESSAGE. CL*51 +01154 * IF MPAY-FOUND-YES-88 CL110 +01155 * MOVE MPAY-BATCH-NO TO X425-AUTO-BATCH NTE-BATCH-NO CL110 +01156 * MOVE MPAY-ITEM-NO TO X425-AUTO-ITEM NTE-ITEM-NO CL110 +01157 * MOVE '/' TO X425-AUTO-FILL CL110 +01158 * MOVE 'Y ' TO X425-AUTO-REV CL110 +01159 * MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9 CL110 +01160 * SET L001-FROM-FED-8 TO TRUE CL110 +01161 * PERFORM S001-DATE THRU S001-EXIT CL110 +01162 * MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE CL110 +01163 * ELSE CL110 +01164 MOVE ' ' TO X425-AUTO-FILL CL*53 +01165 MOVE 'FARGO' TO X425-AUTO-BATCH CL110 +01166 MOVE 'RTN' TO X425-AUTO-ITEM CL110 +01167 MOVE '* ' TO X425-AUTO-REV. CL110 +01168 CL*71 +01169 CL*53 +01170 P4000-EXIT. CL**7 +01171 EXIT. CL**7 +01172 P4100-PRINT-HEADER. CL**6 +01173 IF WS-LINE-CNT > 58 CL*90 +01174 ADD +1 TO WS-PAGE-CNT CL**6 +01175 MOVE WS-PAGE-CNT TO HEADER-3-PAGE CL*89 +01176 * MOVE ' -/+ ----- MONTHLY COUNT' TO HEADER-5-NAME CL*10 +01177 MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE CL*10 +01178 MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME CL*10 +01179 WRITE ESSP-ACHD-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*10 +01180 WRITE ESSP-ACHD-REC FROM HEADER-2 AFTER 1 CL*10 +01181 WRITE ESSP-ACHD-REC FROM HEADER-3 AFTER 1 CL*10 +01182 WRITE ESSP-ACHD-REC FROM HEADER-3A AFTER 1 CL*10 +01183 WRITE ESSP-ACHD-REC FROM HEADER-4 AFTER 1 CL*10 +01184 WRITE ESSP-ACHD-REC FROM HEADER-5 AFTER 1 CL*10 +01185 WRITE ESSP-ACHD-REC FROM HEADER-6 AFTER 1 CL*90 +01186 MOVE +6 TO WS-LINE-CNT. CL*90 +01187 P4100-EXIT. CL**6 +01188 EXIT. CL**6 +01189 CL**6 +01190 P4200-PRINT-HEADER. CL*90 +01191 IF WS-RETN-CNT > 58 CL*90 +01192 ADD +1 TO WS-PAGE-CNT CL*90 +01193 MOVE WS-PAGE-CNT TO HEADER-3-PAGE CL*90 +01194 * MOVE ' -/+ ----- MONTHLY COUNT' TO HEADER-5-NAME CL*90 +01195 MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE CL*90 +01196 MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME CL*90 +01197 WRITE ESSP-ACHR-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*90 +01198 WRITE ESSP-ACHR-REC FROM HEADER-2 AFTER 1 CL*90 +01199 WRITE ESSP-ACHR-REC FROM HEADER-3 AFTER 1 CL*90 +01200 WRITE ESSP-ACHR-REC FROM HEADER-3A AFTER 1 CL*90 +01201 WRITE ESSP-ACHR-REC FROM HEADER-4 AFTER 1 CL*90 +01202 WRITE ESSP-ACHR-REC FROM HEADER-5 AFTER 1 CL*90 +01203 WRITE ESSP-ACHR-REC FROM HEADER-6 AFTER 1 CL*90 +01204 MOVE +6 TO WS-RETN-CNT. CL*90 +01205 P4200-EXIT. CL*90 +01206 EXIT. CL*90 +01207 CL*90 +01208 P4300-PRNT-REVR. CL110 +01209 MOVE FAC6-DUTAS-EMP-NO TO X425-EMP-NO CL110 +01210 MOVE FAC6-DUTAS-EMP-NAME TO X425-NAME-CHECK. CL127 +01211 MOVE FAC6-BANK-ACCT-NO TO X425-ACCT-NUMBER NTE-ACCT-NO CL110 +01212 MOVE FAC6-RECV-BANK-ID TO X425-BANK-ID. CL110 +01213 MOVE WRK-MPAY-REMIT-AMT TO X425-X145-REMIT CL110 +01214 MOVE WRK-TEMP-TRACE-NOA TO X425-X145-TRACE-NOB. CL110 +01215 MOVE WRK-TEMP-TRACE-NOA TO NTE-TRACE-NO. CL110 +01216 * MOVE SPACES TO X425-MESSAGE. CL119 +01217 IF MPAY-FOUND-YES-88 CL110 +01218 MOVE MPAY-BATCH-NO TO X425-AUTO-BATCH NTE-BATCH-NO CL110 +01219 MOVE MPAY-ITEM-NO TO X425-AUTO-ITEM NTE-ITEM-NO CL110 +01220 MOVE '/' TO X425-AUTO-FILL CL110 +01221 MOVE 'Y ' TO X425-AUTO-REV CL110 +01222 MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9 CL110 +01223 SET L001-FROM-FED-8 TO TRUE CL110 +01224 PERFORM S001-DATE THRU S001-EXIT CL110 +01225 MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE CL110 +01226 ELSE CL110 +01227 MOVE ' ' TO X425-AUTO-FILL CL110 +01228 MOVE 'STAFF' TO X425-AUTO-BATCH CL110 +01229 MOVE 'REV' TO X425-AUTO-ITEM CL110 +01230 MOVE 'N ' TO X425-AUTO-REV. CL110 +01231 CL110 +01232 CL110 +01233 P4300-EXIT. CL110 +01234 EXIT. CL110 +01235 P5000-ACH-RETURN-CODE. CL*45 +01236 IF WRK-FAC7-RTN-CD = WRK-RTN-CD CL*83 +01237 GO TO P5000-EXIT. CL*45 +01238 CL*45 +01239 SET WRK-FAC7-RTN-INVALID-88 TO TRUE CL*46 +01240 CL*45 +01241 PERFORM VARYING ACH-RTN-IDX FROM 1 BY 1 CL*45 +01242 UNTIL WRK-FAC7-RTN-VALID-88 CL*46 +01243 OR ACH-RTN-IDX > ACH-RTN-CD-CNT CL*45 +01244 OR ACH-RTN-CD(ACH-RTN-IDX) = SPACE CL*45 +01245 IF WRK-FAC7-RTN-CD = CL*83 +01246 ACH-RTN-CD(ACH-RTN-IDX) CL*46 +01247 SET WRK-FAC7-RTN-VALID-88 TO TRUE CL*46 +01248 MOVE ACH-RTN-CD (ACH-RTN-IDX) TO WRK-RTN-CD CL*45 +01249 MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO X425-MESSAGE CL*57 +01250 MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO NTE-REASON CL*71 +01251 END-IF CL*45 +01252 END-PERFORM. CL*45 +01253 CL*45 +01254 IF WRK-FAC7-RTN-INVALID-88 CL*46 +01255 MOVE '???????? INVALID RETURN CODE ' TO X425-MESSAGE CL*57 +01256 GO TO P5000-EXIT. CL*45 +01257 P5000-EXIT. CL*45 +01258 EXIT. CL*45 +01259 CL*45 +01260 T0000-TERMINATE. DTSBX426 +01261 DTSBX426 +01262 IF NOT FACH-TYPE-TRAILER-88 DTSBX426 +01263 DISPLAY ' LAST RECORD IS NOT A TRAILER RECORD ' DTSBX426 +01264 DISPLAY ' ' DTSBX426 +01265 DISPLAY ' LAST RECORD ' FACH-SKELETAL-REC DTSBX426 +01266 DISPLAY ' **** ACH FILE EMPTY *****'. CL*34 +01267 DTSBX426 +01268 IF WRK-FACH-READ-CNT = 2 DTSBX426 +01269 MOVE +3 TO RETURN-CODE CL*32 +01270 DISPLAY ' *** WELLS FARGO FILE CONTAINS 2 RECS ' CL**3 +01271 DISPLAY ' *** NO REJECTED PAYMENT RECORDS *'. DTSBX426 +01272 DTSBX426 +01273 DTSBX426 +01274 * MOVE -1 TO F907-LENGTH. CL**8 +01275 * CALL 'DTSBU946' USING F907-REC. CL**8 +01276 DTSBX426 +01277 DTSBX426 +01278 DTSBX426 +01279 DISPLAY ' '. DTSBX426 +01280 DTSBX426 +01281 DISPLAY '*** DTSBX426 TERMINATION STATISTICS ***'. CL*41 +01282 DTSBX426 +01283 DISPLAY ' '. DTSBX426 +01284 DTSBX426 +01285 DISPLAY 'NUMBER OF FACH RECORDS READ : ' DTSBX426 +01286 WRK-FACH-READ-CNT. DTSBX426 +01287 DTSBX426 +01288 DISPLAY 'NUMBER IN TRAILER BATCH COUNT : ' DTSBX426 +01289 FAC9-BATCH-CNT. DTSBX426 +01290 DTSBX426 +01291 DISPLAY 'HEADERS IN FACH FILE : ' DTSBX426 +01292 WRK-HEADER-RECORDS. DTSBX426 +01293 DTSBX426 +01294 DISPLAY 'TRAILERS IN FACH FILE : ' DTSBX426 +01295 WRK-TRAILER-RECORDS. DTSBX426 +01296 DTSBX426 +01297 DISPLAY 'DETAIL RECORDS IN FACH FILE : ' DTSBX426 +01298 WRK-FAC6-RECORDS. DTSBX426 +01299 DTSBX426 +01300 DISPLAY 'NUMBER OF OTHER RECORDS IN FACH FILE: ' DTSBX426 +01301 WRK-OTHER-RECORDS. DTSBX426 +01302 DTSBX426 +01303 DISPLAY 'NUMBER OF T025 RECORDS WRITTEN : ' DTSBX426 +01304 WRK-T025-WRITE-CNT. DTSBX426 +01305 DTSBX426 +01306 DISPLAY 'NUMBER OF F907 RECORDS WRITTEN : ' DTSBX426 +01307 WRK-F907-WRITE-CNT. DTSBX426 +01308 * IF WRK-F907-WRITE-CNT > 0 CL*24 +01309 * MOVE +3 TO RETURN-CODE CL*24 +01310 * DISPLAY ' FACH INPUT FILE CONTAINS ERRORS+++' CL*24 +01311 * DISPLAY ' PROGRAM WILL ABEND ***************'. CL*24 +01312 * PERFORM S999-ABEND THRU S999-EXIT. DTSBX426 +01313 DTSBX426 +01314 IF WS-LINE-CNT > 52 OR RETURN-CODE = +3 CL*32 +01315 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*24 +01316 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1 CL*32 +01317 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-2 AFTER 3 CL*36 +01318 END-IF. CL*24 +01319 CL114 +01320 MOVE WRK-FAC6-RECORDS TO WS-FOOTING-CNT. CL*24 +01321 MOVE TOT-FAC6-AMOUNT TO WS-TOTAL-REMIT. CL*24 +01322 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1. CL*25 +01323 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-2 AFTER 1. CL*25 +01324 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1. CL*25 +01325 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1. CL*25 +01326 * WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL*25 +01327 * WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL*24 +01328 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7 AFTER 1. CL*25 +01329 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8 AFTER 1. CL*25 +01330 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3. CL117 +01331 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1. CL*25 +01332 CL*24 +01333 DISPLAY ' '. CL*24 +01334 DTSBX426 +01335 MOVE WRK-FAC6-RECORDS TO WS-FOOTING-CNT. CL114 +01336 MOVE WS-FAC7-PEN-CNT TO WS-X145-ERR-CNT WS-X145-PEN-CNT CL114 +01337 MOVE TOT-MPAY-AMOUNT TO WS-TOT-REMIT. CL114 +01338 MOVE WRK-T025-WRITE-CNT TO WS-T025-WRITE-CNT. CL115 +01339 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1. CL*88 +01340 WRITE ESSP-ACHD-REC FROM FOOTDTS-LINE-2 AFTER 1. CL117 +01341 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1. CL114 +01342 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1. CL114 +01343 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-5 AFTER 1. CL116 +01344 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-6 AFTER 1. CL116 +01345 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7 AFTER 1. CL114 +01346 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8 AFTER 1. CL114 +01347 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3. CL*88 +01348 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1. CL*88 +01349 CL*88 +01350 IF RETURN-CODE NOT = +3 CL114 +01351 WRITE ESSP-ACHD-REC FROM ZNOTE1 AFTER 2 CL114 +01352 WRITE ESSP-ACHD-REC FROM CNOTE1 AFTER 1 CL114 +01353 WRITE ESSP-ACHD-REC FROM CNOTE2 AFTER 1 CL114 +01354 WRITE ESSP-ACHD-REC FROM CNOTE3 AFTER 1 CL114 +01355 END-IF. CL114 +01356 CL*58 +01357 CL*29 +01358 CLOSE IN-FACH ESSP-ACHD-FILE PEND-FACH-FILE CL*86 +01359 ESSP-ACHR-FILE. CL*86 +01360 PERFORM S910-CLOSE THRU S910-EXIT. CL*29 +01361 PERFORM S927-CLOSE THRU S927-EXIT. CL*29 +01362 CL*29 +01363 CL*29 +01364 DTSBX426 +01365 T0000-EXIT. DTSBX426 +01366 EXIT. DTSBX426 +01367 DTSBX426 +01368 P1070-READ-MPRF. DTSBX426 +01369 DTSBX426 +01370 DTSBX426 +01371 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX426 +01372 SET MPRF-PRF-88 TO TRUE. DTSBX426 +01373 DISPLAY ' FAC6EMP ' FAC6-DUTAS-EMP-NO. CL130 +01374 DISPLAY ' MPAYEMP ' MPAY-EMP-NO. CL131 +01375 MOVE MPAY-EMP-NO TO MPRF-EMP-NO. CL131 +01376 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 +01377 DTSBX426 +01378 PERFORM S910-READ THRU S910-EXIT. DTSBX426 +01379 DTSBX426 +01380 IF L910-OK-88 DTSBX426 +01381 SET L910-OK-88 TO TRUE DTSBX426 +01382 MOVE MSKL-REC TO MPRF-REC DTSBX426 +01383 ELSE DTSBX426 +01384 DISPLAY '********NO MPRF-REC FOUND ' L910-RESULT-IND CL131 +01385 SET L910-NO-REC-88 TO TRUE DTSBX426 +01386 DISPLAY '6090 L910 NO RECORD FOUND ' DTSBX426 +01387 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX426 +01388 GO TO P1070-EXIT. DTSBX426 +01389 DTSBX426 +01390 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK CL127 +01391 WS-FAC6-DUTAS-EMP-NAME. CL129 +01392 DISPLAY ' EMP ' MPRF-PRIMARY-NAME ' ' MPRF-EMP-NO CL129 +01393 DISPLAY ' T25 ' T025-NAME-CHECK ' ' MPRF-EMP-NO CL129 +01394 MOVE WS-FAC6-DUTAS-EMP-NAMEA TO FAC6-DUTAS-EMP-NAME. CL129 +01395 P1070-EXIT. DTSBX426 +01396 EXIT. DTSBX426 +01397 DTSBX426 +01398 S3000-INIT-T003. CL*70 +01399 MOVE LOW-VALUES TO MNTE-KEY-AREA. CL*70 +01400 MOVE MPAY-EMP-NO TO MNTE-EMP-NO. CL*70 +01401 SET MNTE-NTE-88 TO TRUE. CL*70 +01402 MOVE +0 TO MNTE-PURGE-DATE. CL*70 +01403 SET MNTE-NOT-CONVERTED-88 TO TRUE. CL*70 +01404 CL*70 +01405 MOVE L005-DATE TO MNTE-ESTB-DATE CL*72 +01406 MNTE-CHNG-DATE. CL*70 +01407 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME CL*70 +01408 MNTE-DATA-ESTB-ABSTIME CL*70 +01409 MNTE-CHNG-ABSTIME. CL*70 +01410 MOVE 'WEBESSP ' TO MNTE-ESTB-OP-ID CL*70 +01411 MNTE-CHNG-OP-ID. CL*70 +01412 MOVE +0 TO MNTE-TEXT-CNT. CL*70 +01413 MOVE SPACES TO MNTE-TEXT-AREA. CL*70 +01414 CL*70 +01415 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 +01416 MOVE '003' TO T003-REC-TYPE. CL*70 +01417 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 +01418 MOVE '003' TO T003-REC-TYPE. CL*70 +01419 MOVE MPAY-EMP-NO TO T003-EMP-NO. CL*70 +01420 MOVE 'WEB PAY ' TO T003-ORIGIN. CL*70 +01421 MOVE L005-DATE TO T003-SYS-DATE. CL*72 +01422 MOVE L005-TIME TO T003-SYS-TIME. CL*72 +01423 SET T003-ADD-MNTE-88 TO TRUE. CL*70 +01424 CL*70 +01425 S3000-EXIT. CL*70 +01426 EXIT. CL*70 +01427 CL*70 +01428 DTSBX426 +01429 S001-FROM-FED-8. CL*71 +01430 SET L001-FROM-FED-8 TO TRUE. CL*71 +01431 GO TO S001-DATE. CL*71 +01432 CL*71 +01433 S001-DATE. CL*71 +01434 SKIP1 CL*71 +01435 CALL 'DTSBU001' USING L001-LINK-AREA. CL*71 +01436 S001-EXIT. CL*71 +01437 EXIT. CL*71 +01438 S005-FROM-SYS. CL*71 +01439 DTSBX426 +01440 SET L005-FROM-SYS TO TRUE. DTSBX426 +01441 GO TO S005-ABSTIME. DTSBX426 +01442 DTSBX426 +01443 S005-ABSTIME. DTSBX426 +01444 DTSBX426 +01445 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX426 +01446 DTSBX426 +01447 S005-EXIT. DTSBX426 +01448 EXIT. DTSBX426 +01449 DTSBX426 +01450 DTSBX426 +01451 S910-OPEN-UPDATE-NO-AIX. DTSBX426 +01452 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX426 +01453 GO TO S910-MSTR-IO. DTSBX426 +01454 DTSBX426 +01455 EJECT DTSBX426 +01456 S910-OPEN-READ. DTSBX426 +01457 SET L910-OPEN-READ-88 TO TRUE. DTSBX426 +01458 GO TO S910-MSTR-IO. DTSBX426 +01459 DTSBX426 +01460 S910-READ. DTSBX426 +01461 SET L910-READ-88 TO TRUE. DTSBX426 +01462 GO TO S910-MSTR-IO. DTSBX426 +01463 DTSBX426 +01464 S910-DELETE. DTSBX426 +01465 SET L910-DELETE-88 TO TRUE. DTSBX426 +01466 GO TO S910-MSTR-IO. DTSBX426 +01467 DTSBX426 +01468 S910-WRITE. DTSBX426 +01469 SET L910-WRITE-88 TO TRUE. DTSBX426 +01470 GO TO S910-MSTR-IO. DTSBX426 +01471 DTSBX426 +01472 S910-START-BROWSE. DTSBX426 +01473 SET L910-START-BROWSE-88 TO TRUE. DTSBX426 +01474 GO TO S910-MSTR-IO. DTSBX426 +01475 DTSBX426 +01476 S910-READ-NEXT. DTSBX426 +01477 SET L910-READ-NEXT-88 TO TRUE. DTSBX426 +01478 GO TO S910-MSTR-IO. DTSBX426 +01479 DTSBX426 +01480 S910-REWRITE. DTSBX426 +01481 SET L910-REWRITE-88 TO TRUE. DTSBX426 +01482 GO TO S910-MSTR-IO. DTSBX426 +01483 DTSBX426 +01484 S910-CLOSE. DTSBX426 +01485 SET L910-CLOSE-88 TO TRUE. DTSBX426 +01486 GO TO S910-MSTR-IO. DTSBX426 01487 DTSBX426 -01488 SET L005-FROM-SYS TO TRUE. DTSBX426 -01489 GO TO S005-ABSTIME. DTSBX426 -01490 DTSBX426 -01491 S005-ABSTIME. DTSBX426 -01492 DTSBX426 -01493 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX426 -01494 DTSBX426 -01495 S005-EXIT. DTSBX426 -01496 EXIT. DTSBX426 -01497 DTSBX426 +01488 S910-MSTR-IO. DTSBX426 +01489 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX426 +01490 MSKL-REC. DTSBX426 +01491 S910-EXIT. DTSBX426 +01492 EXIT. DTSBX426 +01493 DTSBX426 +01494 SKIP3 DTSBX426 +01495 S921-OPEN-READ. DTSBX426 +01496 SET L921-OPEN-READ-88 TO TRUE. DTSBX426 +01497 GO TO S921-AIX-IO. DTSBX426 01498 DTSBX426 -01499 CL149 -01500 S111-LOOKUP-ADDR. CL149 -01501 MOVE MPRF-EMP-NO TO L111-EMP-NO. CL149 -01502 CL149 -01503 CALL 'DTSBU111' USING L111-LINK-AREA. CL149 -01504 S111-EXIT. CL149 -01505 EXIT. CL149 -01506 SKIP3 CL149 -01507 S112-FORMAT-ADDR. CL149 -01508 CALL 'DTSBU112' USING L112-LINK-AREA. CL149 -01509 S112-EXIT. CL149 -01510 EXIT. CL149 -01511 SKIP3 CL149 -01512 S910-OPEN-UPDATE-NO-AIX. CL149 -01513 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX426 -01514 GO TO S910-MSTR-IO. DTSBX426 -01515 DTSBX426 -01516 EJECT DTSBX426 -01517 S910-OPEN-READ. DTSBX426 -01518 SET L910-OPEN-READ-88 TO TRUE. DTSBX426 -01519 GO TO S910-MSTR-IO. DTSBX426 +01499 S921-READ. DTSBX426 +01500 SET L921-READ-88 TO TRUE. DTSBX426 +01501 GO TO S921-AIX-IO. DTSBX426 +01502 DTSBX426 +01503 S921-START-BROWSE. DTSBX426 +01504 SET L921-START-BROWSE-88 TO TRUE. DTSBX426 +01505 GO TO S921-AIX-IO. DTSBX426 +01506 DTSBX426 +01507 S921-READ-NEXT. DTSBX426 +01508 SET L921-READ-NEXT-88 TO TRUE. DTSBX426 +01509 GO TO S921-AIX-IO. DTSBX426 +01510 DTSBX426 +01511 S921-CLOSE. DTSBX426 +01512 SET L921-CLOSE-88 TO TRUE. DTSBX426 +01513 GO TO S921-AIX-IO. DTSBX426 +01514 DTSBX426 +01515 S921-AIX-IO. DTSBX426 +01516 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX426 +01517 ISKL-REC. DTSBX426 +01518 S921-EXIT. DTSBX426 +01519 EXIT. DTSBX426 01520 DTSBX426 -01521 S910-READ. DTSBX426 -01522 SET L910-READ-88 TO TRUE. DTSBX426 -01523 GO TO S910-MSTR-IO. DTSBX426 +01521 S927-OPEN-UPDATE. DTSBX426 +01522 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX426 +01523 GO TO S927-BTC-O. DTSBX426 01524 DTSBX426 -01525 S910-DELETE. DTSBX426 -01526 SET L910-DELETE-88 TO TRUE. DTSBX426 -01527 GO TO S910-MSTR-IO. DTSBX426 +01525 S927-WRITE. DTSBX426 +01526 SET L927-WRITE-88 TO TRUE. DTSBX426 +01527 GO TO S927-BTC-O. DTSBX426 01528 DTSBX426 -01529 S910-WRITE. DTSBX426 -01530 SET L910-WRITE-88 TO TRUE. DTSBX426 -01531 GO TO S910-MSTR-IO. DTSBX426 +01529 S927-CLOSE. DTSBX426 +01530 SET L927-CLOSE-88 TO TRUE. DTSBX426 +01531 GO TO S927-BTC-O. DTSBX426 01532 DTSBX426 -01533 S910-START-BROWSE. DTSBX426 -01534 SET L910-START-BROWSE-88 TO TRUE. DTSBX426 -01535 GO TO S910-MSTR-IO. DTSBX426 -01536 DTSBX426 -01537 S910-READ-NEXT. DTSBX426 -01538 SET L910-READ-NEXT-88 TO TRUE. DTSBX426 -01539 GO TO S910-MSTR-IO. DTSBX426 -01540 DTSBX426 -01541 S910-REWRITE. DTSBX426 -01542 SET L910-REWRITE-88 TO TRUE. DTSBX426 -01543 GO TO S910-MSTR-IO. DTSBX426 -01544 DTSBX426 -01545 S910-CLOSE. DTSBX426 -01546 SET L910-CLOSE-88 TO TRUE. DTSBX426 -01547 GO TO S910-MSTR-IO. DTSBX426 -01548 DTSBX426 -01549 S910-MSTR-IO. DTSBX426 -01550 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX426 -01551 MSKL-REC. DTSBX426 -01552 S910-EXIT. DTSBX426 -01553 EXIT. DTSBX426 -01554 DTSBX426 -01555 SKIP3 DTSBX426 -01556 S921-OPEN-READ. DTSBX426 -01557 SET L921-OPEN-READ-88 TO TRUE. DTSBX426 -01558 GO TO S921-AIX-IO. DTSBX426 -01559 DTSBX426 -01560 S921-READ. DTSBX426 -01561 SET L921-READ-88 TO TRUE. DTSBX426 -01562 GO TO S921-AIX-IO. DTSBX426 -01563 DTSBX426 -01564 S921-START-BROWSE. DTSBX426 -01565 SET L921-START-BROWSE-88 TO TRUE. DTSBX426 -01566 GO TO S921-AIX-IO. DTSBX426 -01567 DTSBX426 -01568 S921-READ-NEXT. DTSBX426 -01569 SET L921-READ-NEXT-88 TO TRUE. DTSBX426 -01570 GO TO S921-AIX-IO. DTSBX426 -01571 DTSBX426 -01572 S921-CLOSE. DTSBX426 -01573 SET L921-CLOSE-88 TO TRUE. DTSBX426 -01574 GO TO S921-AIX-IO. DTSBX426 -01575 DTSBX426 -01576 S921-AIX-IO. DTSBX426 -01577 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX426 -01578 ISKL-REC. DTSBX426 -01579 S921-EXIT. DTSBX426 -01580 EXIT. DTSBX426 -01581 DTSBX426 -01582 S927-OPEN-UPDATE. DTSBX426 -01583 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX426 -01584 GO TO S927-BTC-O. DTSBX426 -01585 DTSBX426 -01586 S927-WRITE. DTSBX426 -01587 SET L927-WRITE-88 TO TRUE. DTSBX426 -01588 GO TO S927-BTC-O. DTSBX426 -01589 DTSBX426 -01590 S927-CLOSE. DTSBX426 -01591 SET L927-CLOSE-88 TO TRUE. DTSBX426 -01592 GO TO S927-BTC-O. DTSBX426 -01593 DTSBX426 -01594 S927-BTC-O. DTSBX426 -01595 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX426 -01596 TSKL-REC. DTSBX426 -01597 S927-EXIT. DTSBX426 -01598 EXIT. DTSBX426 -01599 CL150 -01600 S946-R333-WRITE. CL150 -01601 CALL 'DTSBU946' USING R333-REC. CL150 -01602 S946-EXIT. CL150 -01603 EXIT. CL150 -01604 DTSBX426 -01605 EJECT DTSBX426 -01606 S999-ABEND. DTSBX426 -01607 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX426 -01608 S999-EXIT. DTSBX426 -01609 EXIT. DTSBX426 +01533 S927-BTC-O. DTSBX426 +01534 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX426 +01535 TSKL-REC. DTSBX426 +01536 S927-EXIT. DTSBX426 +01537 EXIT. DTSBX426 +01538 DTSBX426 +01539 EJECT DTSBX426 +01540 S999-ABEND. DTSBX426 +01541 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX426 +01542 S999-EXIT. DTSBX426 +01543 EXIT. DTSBX426 diff --git a/Batch/DTSBX430.cob b/Batch/DTSBX430.cob index fed12f1..35b633b 100644 --- a/Batch/DTSBX430.cob +++ b/Batch/DTSBX430.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 03/10/25 +00001 IDENTIFICATION DIVISION. 09/06/25 00002 PROGRAM-ID. DTSBX430. DTSBX430 -00003 AUTHOR. NGC. LV253 +00003 AUTHOR. NGC. LV254 00004 DATE-WRITTEN. APRIL 2005. DTSBX430 00005 DATE-COMPILED. DTSBX430 00006 SKIP3 DTSBX430 @@ -161,7 +161,7 @@ 00161 CL119 00162 CL*59 00163 WORKING-STORAGE SECTION. DTSBX430 -001635 77 PAN-VALET PICTURE X(24) VALUE '253DTSBX430 03/10/25'. DTSBX430 +001635 77 PAN-VALET PICTURE X(24) VALUE '254DTSBX430 09/06/25'. DTSBX430 00164 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX422 10/07/14'. DTSBX430 00165 77 PAN-VALET PICTURE X(24) VALUE '047DTSBX422 09/27/14'. DTSBX430 00166 SKIP3 DTSBX430 @@ -764,7 +764,7 @@ 00763 01 LX42-LINK-AREA. DTSBX430 00764 ++INCLUDE DTSILX42 CL112 00765 DTSBX430 -00766 PROCEDURE DIVISION USING LX42-LINK-AREA. CL253 +00766 PROCEDURE DIVISION USING LX42-LINK-AREA. CL254 00767 DTSBX430 00768 DTSBX430-MAIN. CL*47 00769 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA CL*80 diff --git a/Batch/DTSBX551.cob b/Batch/DTSBX551.cob new file mode 100644 index 0000000..3ce67a9 --- /dev/null +++ b/Batch/DTSBX551.cob @@ -0,0 +1,3118 @@ +00001 IDENTIFICATION DIVISION. 05/20/16 +00002 PROGRAM-ID. DTSBX551. DTSBX551 +00003 AUTHOR. NGC. LV223 +00004 DATE-WRITTEN. APRIL 2005. DTSBX551 +00005 DATE-COMPILED. DTSBX551 +00006 SKIP3 DTSBX551 +00007 ***** DTSBX551 +00008 * DTSBX551 +00009 * >>> PROCESSING FOR WEB REPORTS AND WAGES NEEDS TO BE DTSBX551 +00010 * >>> MODIFIED TO CREATE BATCH AND ITEM NUMBERS. THEY DTSBX551 +00011 * >>> WILL EITHER BE GROUPED INTO ACCOUNTING BATCHES DTSBX551 +00012 * >>> IN THE WEB APPLICATION, OR CONTINUE TO GO THROUGH DTSBX551 +00013 * >>> DTSBD140. DTSBX551 +00014 * DTSBX551 +00015 * FUNCTION: EDIT REPORT DATA FROM WEB APPLICATION. DTSBX551 +00016 * DTSBX551 +00017 * MODIFICATION HISTORY: DTSBX551 +00018 * DTSBX551 +00019 * 04-05-2005 INITIAL DEVELOPMENT DTSBX551 +00020 * REFERENCE RFP: WEB REPORTING DTSBX551 +00021 * DTSBX551 +00022 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSBX551 +00023 * NEW RECORD INCLUDES EMPLOYEE NAME. DTSBX551 +00024 * REFERENCE RFP: WEB REPORTING. DTSBX551 +00025 * DTSBX551 +00026 * DTSBX551 +00027 * 10-21-2009 MODIFIED TO SEPARATE REPORT PROCESSING FROM DTSBX551 +00028 * NEW WAGE-ONLY PROCESSING. P5000 CHANGED TO DTSBX551 +00029 * DETERMINE WHETHER ONLY WAGES OR WAGES DTSBX551 +00030 * ASSOCIATED WITH A REPORT ARE PRESENT. DTSBX551 +00031 * IF ONLY WAGES ARE PRESENT, COPY THE DTSBX551 +00032 * TEMPORARY WAGE FILE TO THE OUTPUT WAGE FILE. DTSBX551 +00033 * IF PROCESSING A REPORT, VERIFY THAT THE REPORTED DTSBX551 +00034 * AMOUNTS MATCH THE CALCULATED AMOUNTS, AND COPY DTSBX551 +00035 * BOTH THE REPORT AND WAGE TEMPORARY FILES DTSBX551 +00036 * TO THE OUTPUT. DTSBX551 +00037 * REFERENCE RFP: MAG MEDIA WAGE ONLY GD DTSBX551 +00038 * DTSBX551 +00039 * 06-09-2010 MODIFIED FOR IN-HOUSE CASHIERING. DTSBX551 +00040 * REFERENCE RFP: IN-HOUSE CASHIERING GD DTSBX551 +00041 * DTSBX551 +00042 * 11-10-2010 MODIFIED FOR WEB REPORTING. GD DTSBX551 +00043 * DTSBX551 +00044 * DTSBX551 +00045 * CL**9 +00046 * 10-15-2014 MODIFIED PROGRAM TO WRITE T28 RECORDS ONLY CL**9 +00047 * TO X430BTC FILE. ALSO NO WAGE RECORDS ARE CL*47 +00048 * WRITTEN TO TO THE WAGE BTC FILE DUE TO NO CL**9 +00049 * BATCH NUMBERS, WAGE RECORDS ARE NOW WRITTEN CL**9 +00050 * TO THE WAGE NAME FILE. CL**9 +00051 ***** DTSBX551 +00052 SKIP3 DTSBX551 +00053 ENVIRONMENT DIVISION. DTSBX551 +00054 CL122 +00055 CONFIGURATION SECTION. CL122 +00056 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL122 +00057 CL122 +00058 INPUT-OUTPUT SECTION. DTSBX551 +00059 DTSBX551 +00060 FILE-CONTROL. DTSBX551 +00061 DTSBX551 +00062 SELECT TEMP-BTC-FILE ASSIGN TO X451BTC CL205 +00063 FILE STATUS IS TEMP-BTC-STATUS. DTSBX551 +00064 CL*59 +00065 SELECT PEND-X140-FILE ASSIGN TO PENDX140 CL*59 +00066 FILE STATUS IS REPT-140-STATUS. CL*63 +00067 CL*59 +00068 SELECT PEND-X144-FILE ASSIGN TO PENDX144 CL*59 +00069 FILE STATUS IS WAGE-144-STATUS. CL*63 +00070 CL*59 +00071 SELECT PEND-X147-FILE ASSIGN TO PENDX147 CL208 +00072 FILE STATUS IS WAGE-144-STATUS. CL208 +00073 CL208 +00074 SELECT PEND-X145-FILE ASSIGN TO PENDX145 CL*59 +00075 FILE STATUS IS PAYT-145-STATUS. CL*63 +00076 CL*59 +00077 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSBX551 +00078 FILE STATUS IS WAGE-TEMP-STATUS. DTSBX551 +00079 DTSBX551 +00080 SELECT WAGE-FILE-OUT ASSIGN TO DTSFW4GE CL*22 +00081 FILE STATUS IS WAGE-OUT-STATUS. CL*20 +00082 DTSBX551 +00083 SELECT BATCH-XREF-FILE ASSIGN TO BX214422 DTSBX551 +00084 FILE STATUS IS BATCH-XREF-STATUS. DTSBX551 +00085 CL119 +00086 SELECT REPT-PAID-FILE ASSIGN TO X451RPT1 CL205 +00087 FILE STATUS IS REPT-STATUS. CL119 +00088 CL119 +00089 SELECT REPT-PEND-FILE ASSIGN TO X451RPT2 CL205 +00090 FILE STATUS IS REPT-STATUS. CL119 +00091 CL119 +00092 DTSBX551 +00093 DATA DIVISION. DTSBX551 +00094 DTSBX551 +00095 FILE SECTION. DTSBX551 +00096 DTSBX551 +00097 FD TEMP-BTC-FILE DTSBX551 +00098 RECORDING MODE IS V DTSBX551 +00099 BLOCK CONTAINS 0 RECORDS. DTSBX551 +00100 DTSBX551 +00101 01 TEMP-BTC-REC. DTSBX551 +00102 ++INCLUDE DTSIRVAR DTSBX551 +00103 DTSBX551 +00104 01 TSKL-REC. DTSBX551 +00105 ++INCLUDE DTSITSKL DTSBX551 +00106 DTSBX551 +00107 FD WAGE-FILE-TEMP DTSBX551 +00108 RECORDING MODE IS F DTSBX551 +00109 BLOCK CONTAINS 0 RECORDS DTSBX551 +00110 LABEL RECORDS ARE OMITTED. DTSBX551 +00111 DTSBX551 +00112 01 WAGE-TEMP-REC PIC X(128). DTSBX551 +00113 DTSBX551 +00114 FD WAGE-FILE-OUT CL*20 +00115 RECORDING MODE IS F CL*20 +00116 BLOCK CONTAINS 0 RECORDS CL*20 +00117 LABEL RECORDS ARE OMITTED. CL*20 +00118 DTSBX551 +00119 01 WAGE-OUT-REC PIC X(80). CL*20 +00120 DTSBX551 +00121 FD BATCH-XREF-FILE DTSBX551 +00122 RECORDING MODE IS F DTSBX551 +00123 BLOCK CONTAINS 0 RECORDS DTSBX551 +00124 LABEL RECORDS ARE OMITTED. DTSBX551 +00125 DTSBX551 +00126 01 BATCH-XREF-REC PIC X(30). DTSBX551 +00127 CL*11 +00128 CL*59 +00129 FD PEND-X140-FILE CL*59 +00130 RECORDING MODE IS F CL*59 +00131 BLOCK CONTAINS 0 RECORDS CL*59 +00132 LABEL RECORDS ARE OMITTED. CL*59 +00133 CL*59 +00134 01 PEND-X140-REC PIC X(512). CL*59 +00135 DTSBX551 +00136 FD PEND-X144-FILE CL*59 +00137 RECORDING MODE IS F CL*59 +00138 BLOCK CONTAINS 0 RECORDS CL*59 +00139 LABEL RECORDS ARE OMITTED. CL*59 +00140 CL*59 +00141 01 PEND-X144-REC PIC X(512). CL*59 +00142 CL*59 +00143 FD PEND-X145-FILE CL*59 +00144 RECORDING MODE IS F CL*59 +00145 BLOCK CONTAINS 0 RECORDS CL*59 +00146 LABEL RECORDS ARE OMITTED. CL*59 +00147 CL*59 +00148 01 PEND-X145-REC PIC X(512). CL*59 +00149 CL119 +00150 FD REPT-PAID-FILE CL119 +00151 RECORDING MODE IS F CL119 +00152 BLOCK CONTAINS 0 RECORDS CL119 +00153 LABEL RECORDS ARE OMITTED. CL119 +00154 CL119 +00155 01 REPT-PAID-REC PIC X(133). CL209 +00156 CL209 +00157 FD PEND-X147-FILE CL208 +00158 RECORDING MODE IS F CL208 +00159 BLOCK CONTAINS 0 RECORDS CL208 +00160 LABEL RECORDS ARE OMITTED. CL208 +00161 CL208 +00162 01 PEND-X147-REC PIC X(512). CL208 +00163 CL208 +00164 CL119 +00165 CL119 +00166 FD REPT-PEND-FILE CL119 +00167 RECORDING MODE IS F CL119 +00168 BLOCK CONTAINS 0 RECORDS CL119 +00169 LABEL RECORDS ARE OMITTED. CL119 +00170 CL119 +00171 01 REPT-PEND-REC PIC X(133). CL119 +00172 CL119 +00173 CL*59 +00174 WORKING-STORAGE SECTION. DTSBX551 +001745 77 PAN-VALET PICTURE X(24) VALUE '223DTSBX551 05/20/16'. DTSBX551 +00175 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX422 10/07/14'. DTSBX551 +00176 77 PAN-VALET PICTURE X(24) VALUE '047DTSBX422 09/27/14'. DTSBX551 +00177 SKIP3 DTSBX551 +00178 01 WRK-AREA. DTSBX551 +00179 05 W-ABEND-CD PIC S9(04) COMP VALUE 436. CL168 +00180 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX436'. CL168 +00181 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL121 +00182 05 WSP-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL163 +00183 CL121 +00184 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL121 +00185 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL121 +00186 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL121 +00187 CL133 +00188 05 WSP-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL133 +00189 05 WSP-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL133 +00190 05 WSP-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL133 +00191 CL121 +00192 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX551 +00193 88 W-PREV-REC-NULL-88 VALUE 'XXX'. CL*87 +00194 88 W-PREV-RPT-NULL-88 VALUE 'XXX'. CL*87 +00195 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX551 +00196 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX551 +00197 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX551 +00198 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX551 +00199 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX551 +00200 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX551 +00201 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX551 +00202 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX551 +00203 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX551 +00204 88 W-PREV-RPT-RPT-88 VALUE '140'. CL*86 +00205 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX551 +00206 88 W-PREV-RPT-WAGE-88 VALUE '144'. CL*86 +00207 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX551 +00208 88 W-PREV-RPT-PAY-88 VALUE '145'. CL*86 +00209 88 W-PREV-REC-BHDR-88 VALUE '149'. DTSBX551 +00210 DTSBX551 +00211 05 TEMP-BTC-STATUS PIC X(02). DTSBX551 +00212 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX551 +00213 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX551 +00214 DTSBX551 +00215 05 WAGE-TEMP-STATUS PIC X(02). DTSBX551 +00216 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX551 +00217 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX551 +00218 DTSBX551 +00219 05 WAGE-OUT-STATUS PIC X(02). DTSBX551 +00220 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX551 +00221 DTSBX551 +00222 05 BATCH-XREF-STATUS PIC X(02). DTSBX551 +00223 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX551 +00224 DTSBX551 +00225 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX551 +00226 CL*12 +00227 05 WAGE-TRANS-STATUS PIC X(02). CL*12 +00228 88 WAGE-TRANS-FILE-OK-88 VALUE '00' '97'. CL*12 +00229 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*12 +00230 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. CL*12 +00231 CL*12 +00232 05 REPT-140-STATUS PIC X(02). CL*63 +00233 88 REPT-140-OK-88 VALUE '00' '97'. CL*63 +00234 88 REPT-140--NO-REC-88 VALUE '10' '23'. CL*63 +00235 CL*61 +00236 05 WAGE-144-STATUS PIC X(02). CL*63 +00237 88 WAGE-144-OK-88 VALUE '00' '97'. CL*63 +00238 88 WAGE-144--NO-REC-88 VALUE '10' '23'. CL*63 +00239 CL*61 +00240 05 PAYT-145-STATUS PIC X(02). CL*63 +00241 88 PAYT-145-OK-88 VALUE '00' '97'. CL*64 +00242 88 PAYT-145-NO-REC-88 VALUE '10' '23'. CL*64 +00243 DTSBX551 +00244 CL119 +00245 05 REPT-STATUS PIC X(02). CL119 +00246 88 REPT-STATUS-OK-88 VALUE '00'. CL119 +00247 88 REPT-STATUS-EOF-88 VALUE '10'. CL119 +00248 CL119 +00249 05 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL*80 +00250 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL*81 +00251 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL*81 +00252 DTSBX551 +00253 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX551 +00254 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX551 +00255 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX551 +00256 DTSBX551 +00257 05 W-X145-PAYMENT-FOUND-IND PIC X(01) VALUE 'N'. CL*54 +00258 88 W-X145-PAYMENT-YES-88 VALUE 'Y'. CL*54 +00259 88 W-X145-PAYMENT-NO-88 VALUE 'N'. CL*54 +00260 CL*54 +00261 05 W-WRITE-T025-TRAN PIC X(01) VALUE 'N'. CL*73 +00262 88 W-WRITE-T025-TRAN-YES-88 VALUE 'Y'. CL*73 +00263 88 W-WRITE-T025-TRAN-NO-88 VALUE 'N'. CL*73 +00264 CL*73 +00265 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX551 +00266 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX551 +00267 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX551 +00268 DTSBX551 +00269 05 W-RPT-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX551 +00270 88 W-RPT-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX551 +00271 88 W-RPT-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX551 +00272 DTSBX551 +00273 05 W-WAGE-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX551 +00274 88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX551 +00275 88 W-WAGE-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX551 +00276 DTSBX551 +00277 05 W-ARPT-MAX PIC S9(04) COMP VALUE +100. DTSBX551 +00278 05 W-ARPT-LAST PIC S9(04) COMP VALUE +0. DTSBX551 +00279 05 RSUB PIC S9(04) COMP VALUE +0. DTSBX551 +00280 05 W-ARPT-TABLE. DTSBX551 +00281 10 W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128). DTSBX551 +00282 DTSBX551 +00283 05 W-EMP-NO PIC S9(07) COMP-3. DTSBX551 +00284 05 W-X140-DUP PIC S9(03) COMP-3 VALUE +0. CL*41 +00285 05 W-TRAN-CNT PIC S9(03) COMP-3 VALUE +0. CL*41 +00286 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSBX551 +00287 05 W-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. CL*73 +00288 05 WS-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. CL174 +00289 05 W-CURR-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX551 +00290 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX551 +00291 05 W-WAIVER-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX551 +00292 05 W-X140-REPORT-QTR PIC S9(05) COMP-3. CL*54 +00293 05 W-X145-PAYMENT-QTR PIC S9(05) COMP-3. CL*54 +00294 05 W-X144-WAGE-QTR PIC S9(05) COMP-3. CL*54 +00295 05 W-X147-WAGE-QTR PIC S9(05) COMP-3. CL208 +00296 05 WRK-REPORT-QTR PIC 9(05). CL190 +00297 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. CL191 +00298 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. CL191 +00299 10 W-X145-TRACE-NO-A PIC 9(08). CL191 +00300 10 W-X145-TRACE-NO-B PIC 9(05). CL191 +00301 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX551 +00302 05 W-EXX-WAGE PIC S9(11)V99 VALUE +0. CL222 +00303 05 W-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00304 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX551 +00305 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00306 05 WS-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00307 05 W-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00308 05 W-X145-REMITTANCE PIC S9(09)V99 VALUE +0. CL123 +00309 05 W-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00310 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00311 05 W-X145-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00312 05 W-X140-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00313 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSBX551 +00314 05 W-X145-DEPOSIT-DATE PIC S9(09) COMP-3. CL*72 +00315 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX551 +00316 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX551 +00317 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX551 +00318 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX551 +00319 05 W-WRKR-CNT-TOTAL PIC S9(07) COMP-3. CL156 +00320 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX551 +00321 05 W-SSN PIC S9(09) COMP-3. DTSBX551 +00322 05 W-EARNINGS-X PIC X(12). DTSBX551 +00323 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX551 +00324 PIC 9(09).99. DTSBX551 +00325 05 W-EARNINGS PIC S9(09)V99. DTSBX551 +00326 05 W-WORKER-NAME. DTSBX551 +00327 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX551 +00328 10 W-WRKR-MID-INIT PIC X(01). DTSBX551 +00329 10 W-WRKR-LAST-NAME PIC X(20). DTSBX551 +00330 DTSBX551 +00331 05 W-RPT-TYPE PIC X(02). DTSBX551 +00332 88 W-ORIG-88 VALUE 'OR'. DTSBX551 +00333 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX551 +00334 88 W-AUDIT-88 VALUE 'AU'. DTSBX551 +00335 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX551 +00336 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX551 +00337 88 W-ESTIM-88 VALUE 'ES'. DTSBX551 +00338 88 W-WITHDRW-88 VALUE 'WD'. DTSBX551 +00339 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX551 +00340 'FS' 'AC'. DTSBX551 +00341 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX551 +00342 'FS' 'AC' 'ES'. CL*55 +00343 CL*55 +00344 05 W-PAY-TYPE PIC X(02). CL*54 +00345 88 W-PAY-ORIG-88 VALUE 'OR'. CL*54 +00346 88 W-PAY-REG-88 VALUE 'PA'. CL*54 +00347 88 W-VALID-PAY-88 VALUE 'OR' 'PA'. CL*54 +00348 CL*54 +00349 DTSBX551 +00350 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX551 +00351 DTSBX551 +00352 05 W-MNTE-SUBJECT PIC X(40). DTSBX551 +00353 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX551 +00354 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX551 +00355 88 W-MNTE-KEY-WORD-88 VALUE DTSBX551 +00356 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX551 +00357 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX551 +00358 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX551 +00359 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX551 +00360 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX551 +00361 DTSBX551 +00362 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX551 +00363 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX551 +00364 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX551 +00365 DTSBX551 +00366 05 TSUB1 PIC S9(04) COMP. DTSBX551 +00367 05 TSUB2 PIC S9(04) COMP. DTSBX551 +00368 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX551 +00369 DTSBX551 +00370 05 W-MNTE-LINE PIC X(72). DTSBX551 +00371 DTSBX551 +00372 05 W-SLASH-DATE PIC X(10). DTSBX551 +00373 05 FILLER REDEFINES W-SLASH-DATE. DTSBX551 +00374 10 W-SLASH-DT-MM PIC X(02). DTSBX551 +00375 10 FILLER PIC X(01). DTSBX551 +00376 10 W-SLASH-DT-DD PIC X(02). DTSBX551 +00377 10 FILLER PIC X(01). DTSBX551 +00378 10 W-SLASH-DT-CCYY PIC X(04). DTSBX551 +00379 DTSBX551 +00380 05 WRK-CURR-RUN-DATE PIC 9(08). CL157 +00381 05 FILLER REDEFINES WRK-CURR-RUN-DATE. CL157 +00382 10 WRK-CURR-CCYY PIC 9(04). CL157 +00383 10 WRK-CURR-MO PIC 9(02). CL157 +00384 10 WRK-CURR-DD PIC 9(02). CL157 +00385 CL157 +00386 05 WRK-CURR-RPT-DATE. CL157 +00387 10 RPT-CURR-MO PIC 9(02). CL157 +00388 10 FILLER PIC X(01) VALUE '/'. CL157 +00389 10 RPT-CURR-DD PIC 9(02). CL157 +00390 10 FILLER PIC X(01) VALUE '/'. CL157 +00391 10 RPT-CURR-CCYY PIC 9(04). CL157 +00392 CL157 +00393 05 W-SLASH-QTR PIC X(06). DTSBX551 +00394 05 FILLER REDEFINES W-SLASH-QTR. DTSBX551 +00395 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX551 +00396 10 FILLER PIC X(01). DTSBX551 +00397 10 W-SLASH-QTR-Q PIC X(01). DTSBX551 +00398 DTSBX551 +00399 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00400 * BATCH HEADER DTSBX551 +00401 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00402 * REPORT DTSBX551 +00403 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00404 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00405 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00406 05 W-X140-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00407 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00408 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00409 * EMPLOYEE WAGES DTSBX551 +00410 05 W-X144-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00411 05 W-X144-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00412 05 W-X144-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00413 05 W-X144-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00414 05 W-X144-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00415 05 W-X144-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00416 DTSBX551 +00417 * AMENDED WAGES DELETED CL208 +00418 05 W-X147-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL208 +00419 05 W-X147-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL208 +00420 05 W-X147-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL208 +00421 05 W-X147-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL208 +00422 05 W-X147-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL208 +00423 05 W-X147-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL208 +00424 CL208 +00425 * EMPLOYER PAYMENT CL*54 +00426 05 W-X145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00427 05 W-X145-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00428 05 W-X145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00429 05 W-X145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00430 05 W-X145-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00431 05 W-X145-ZRO-CNT PIC S9(07) COMP-3 VALUE +0. CL173 +00432 05 W-X145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00433 * EMPLOYEE W4 COUNT CL*13 +00434 05 W-W4-CNT PIC S9(07) COMP-3 VALUE +0. CL*13 +00435 05 W-W2-CNT PIC S9(07) COMP-3 VALUE +0. CL208 +00436 CL*13 +00437 ** 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00438 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00439 05 W-T028-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00440 05 W-T028-WRITEE-CNT PIC S9(07) COMP-3 VALUE +0. CL102 +00441 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00442 05 W-T025-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00443 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00444 05 W-ARPT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00445 05 W-BX214-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00446 DTSBX551 +00447 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX551 +00448 05 W-X144-LENGTH PIC S9(04) COMP. DTSBX551 +00449 05 W-X145-LENGTH PIC S9(04) COMP. CL*54 +00450 05 W-X147-LENGTH PIC S9(04) COMP. CL208 +00451 DTSBX551 +00452 05 W-AMT-DISP1 PIC ----------9.99. DTSBX551 +00453 05 W-AMT-DISP2 PIC ----------9.99. DTSBX551 +00454 *RW1 DTSBX551 +00455 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX551 +00456 05 DISPLAY-CNT PIC Z(06)9. DTSBX551 +00457 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX551 +00458 *RW2 DTSBX551 +00459 DTSBX551 +00460 01 MESSAGE-AREA. DTSBX551 +00461 *** FATAL ERRORS MSG-A DTSBX551 +00462 05 MSG-A1. DTSBX551 +00463 10 FILLER PIC X(32) DTSBX551 +00464 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX551 +00465 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX551 +00466 01 HEADER-1. CL119 +00467 05 FILLER PIC X(01) VALUE SPACES. CL119 +00468 05 FILLER PIC X(49) VALUE '140R1'. CL119 +00469 05 FILLER PIC X(60) VALUE CL119 +00470 'DISTRICT OF COLUMBIA'. CL119 +00471 05 FILLER PIC X(06) VALUE 'DATE:'. CL119 +00472 05 HDR1-LRCM-SYS-DATE PIC X(10). CL160 +00473 01 HEADER-2. CL119 +00474 05 FILLER PIC X(54) VALUE SPACES. CL119 +00475 05 FILLER PIC X(56) VALUE CL119 +00476 'TAX DIVISION'. CL119 +00477 05 FILLER PIC X(06) VALUE 'TIME:'. CL119 +00478 05 HDR2-LRCM-SYS-TIME PIC X(08). CL119 +00479 CL119 +00480 01 HEADER-3. CL119 +00481 05 FILLER PIC X(01) VALUE SPACES. CL119 +00482 05 FILLER PIC X(38) VALUE CL119 +00483 'ROUTE TO: TAX ACCOUNTING STAFF'. CL119 +00484 05 HDR3-LITERAL PIC X(43) VALUE CL119 +00485 ' ESSP DAILY RPTS-PAYMTS-WAGES RELEASED '. CL170 +00486 05 FILLER PIC X(28) VALUE SPACES. CL119 +00487 05 FILLER PIC X(06) VALUE 'PAGE:'. CL119 +00488 05 HDR3-PAGE PIC ZZ,ZZ9. CL119 +00489 CL119 +00490 01 HEADER-31. CL131 +00491 05 FILLER PIC X(01) VALUE SPACES. CL131 +00492 05 FILLER PIC X(38) VALUE CL131 +00493 'ROUTE TO: TAX ACCOUNTING STAFF'. CL131 +00494 05 HDR3-LITERAL PIC X(43) VALUE CL131 +00495 ' ESSP DAILY RPTS-PAYMTS-WAGES IN ERROR '. CL170 +00496 05 FILLER PIC X(28) VALUE SPACES. CL131 +00497 05 FILLER PIC X(06) VALUE 'PAGE:'. CL131 +00498 05 HDR31-PAGE PIC ZZ,ZZ9. CL131 +00499 CL131 +00500 01 HEADER-4. CL119 +00501 05 FILLER PIC X(01) VALUE SPACES. CL119 +00502 05 FILLER PIC X(132) VALUE SPACES. CL119 +00503 01 HEADER-42. CL144 +00504 05 FILLER PIC X(02) VALUE SPACES. CL144 +00505 05 FILLER PIC X(34) VALUE CL144 +00506 ' '. CL144 +00507 05 FILLER PIC X(02) VALUE SPACES. CL144 +00508 05 FILLER PIC X(25) VALUE CL144 +00509 ' '. CL144 +00510 05 FILLER PIC X(03) VALUE SPACES. CL144 +00511 05 FILLER PIC X(43) VALUE CL153 +00512 ' ESSP-CALC TPA/EMPL DIFF'. CL160 +00513 05 FILLER PIC X(30) VALUE CL152 +00514 ' EMPLOYEES '. CL151 +00515 CL119 +00516 01 HEADER-5. CL119 +00517 05 FILLER PIC X(02) VALUE SPACES. CL126 +00518 05 FILLER PIC X(34) VALUE CL119 +00519 'EMP NO NAME QTR RECV-DATE'. CL127 +00520 05 FILLER PIC X(02) VALUE SPACES. CL126 +00521 05 FILLER PIC X(25) VALUE CL126 +00522 ' TOTAL-AMT EXCESS-AMT '. CL127 +00523 05 FILLER PIC X(03) VALUE SPACES. CL119 +00524 05 FILLER PIC X(34) VALUE CL127 +00525 ' TAX-AMT AMT-DUE PAID-AMT'. CL160 +00526 05 FILLER PIC X(02) VALUE SPACES. CL127 +00527 05 HDR5-NAME PIC X(28) VALUE CL138 +00528 '-/+ ----- MONTHLY COUNT'. CL160 +00529 CL119 +00530 01 HEADER-6. CL119 +00531 05 FILLER PIC X(01) VALUE SPACES. CL119 +00532 05 FILLER PIC X(132) VALUE SPACES. CL119 +00533 01 DETAIL-LINE-1. CL119 +00534 15 FILLER PIC X(02) VALUE SPACES. CL119 +00535 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL119 +00536 15 FILLER PIC X(02) VALUE SPACES. CL119 +00537 15 X434-NAME-CHECK PIC X(04) VALUE SPACES. CL119 +00538 15 FILLER PIC X(02) VALUE SPACES. CL119 +00539 15 X434-QTR PIC X(06). CL119 +00540 15 FILLER PIC X(02) VALUE SPACES. CL119 +00541 15 X434-RCVD-DATE PIC X(10). CL119 +00542 15 FILLER PIC X(01) VALUE SPACES. CL119 +00543 15 X434-TOT-WAGE PIC --------9.99. CL119 +00544 15 FILLER PIC X(01) VALUE SPACES. CL119 +00545 15 X434-EXC-WAGE PIC --------9.99. CL119 +00546 15 FILLER PIC X(01) VALUE SPACES. CL119 +00547 15 X434-TAX-WAGE PIC --------9.99. CL119 +00548 15 FILLER PIC X(01) VALUE SPACES. CL119 +00549 15 X434-X140-REMIT PIC -------9.99. CL156 +00550 15 FILLER PIC X(01) VALUE SPACES. CL119 +00551 15 X434-X145-REMIT PIC -------9.99. CL156 +00552 15 FILLER PIC X(01) VALUE SPACES. CL148 +00553 15 X434-DIFF PIC ------9.99. CL156 +00554 * 15 X434-MESSAGE PIC X(20). CL125 +00555 15 X434-M1-CNT PIC ZZZZZZ9. CL129 +00556 15 X434-M2-CNT PIC ZZZZZZ9. CL129 +00557 15 X434-M3-CNT PIC ZZZZZZ9. CL129 +00558 CL119 +00559 01 DETAIL-PEND-1. CL131 +00560 15 FILLER PIC X(02) VALUE SPACES. CL131 +00561 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL131 +00562 15 FILLER PIC X(02) VALUE SPACES. CL131 +00563 15 P434-NAME-CHECK PIC X(04) VALUE SPACES. CL131 +00564 15 FILLER PIC X(02) VALUE SPACES. CL131 +00565 15 P434-QTR PIC X(06). CL131 +00566 15 FILLER PIC X(02) VALUE SPACES. CL131 +00567 15 P434-RCVD-DATE PIC X(10). CL131 +00568 15 FILLER PIC X(01) VALUE SPACES. CL131 +00569 15 P434-TOT-WAGE PIC --------9.99. CL131 +00570 15 FILLER PIC X(01) VALUE SPACES. CL131 +00571 15 P434-EXC-WAGE PIC --------9.99. CL131 +00572 15 FILLER PIC X(01) VALUE SPACES. CL131 +00573 15 P434-TAX-WAGE PIC --------9.99. CL131 +00574 15 FILLER PIC X(01) VALUE SPACES. CL131 +00575 15 P434-X140-REMIT PIC --------9.99. CL131 +00576 15 FILLER PIC X(01) VALUE SPACES. CL131 +00577 15 P434-X145-REMIT PIC --------9.99. CL131 +00578 15 FILLER PIC X(02) VALUE SPACES. CL138 +00579 15 P434-MESSAGE PIC X(30). CL136 +00580 CL131 +00581 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL119 +00582 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL119 +00583 CL119 +00584 01 FOOTING-LINE-3. CL119 +00585 05 FILLER PIC X(25) VALUE SPACES. CL119 +00586 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL119 +00587 05 FILLER PIC X(02) VALUE SPACES. CL119 +00588 05 FILLER PIC X(45) VALUE CL170 +00589 'TOTAL PAYMENT RELEASED TO DUTAS '. CL179 +00590 05 FILLER PIC X(32) VALUE SPACES. CL119 +00591 CL119 +00592 01 FOOTING-LINE-4. CL153 +00593 05 FILLER PIC X(25) VALUE SPACES. CL119 +00594 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL119 +00595 05 FILLER PIC X(02) VALUE SPACES. CL119 +00596 05 FILLER PIC X(34) VALUE CL119 +00597 ' # OF PAYMENTS HAD ERRORS '. CL119 +00598 05 FILLER PIC X(32) VALUE SPACES. CL119 +00599 CL119 +00600 01 FOOTING-LINE-5. CL153 +00601 05 FILLER PIC X(25) VALUE SPACES. CL119 +00602 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL119 +00603 05 FILLER PIC X(02) VALUE SPACES. CL119 +00604 05 FILLER PIC X(40) VALUE CL130 +00605 ' # OF ZERO PAYMENTS DISCARDED '. CL176 +00606 05 FILLER PIC X(32) VALUE SPACES. CL119 +00607 01 FOOTING-LINE-6. CL153 +00608 05 FILLER PIC X(25) VALUE SPACES. CL130 +00609 05 WS-X140-RED-CNT PIC ZZ,ZZ9. CL130 +00610 05 FILLER PIC X(02) VALUE SPACES. CL130 +00611 05 FILLER PIC X(45) VALUE CL170 +00612 'TOTAL REPORT RELEASED TO DUTAS '. CL179 +00613 05 FILLER PIC X(32) VALUE SPACES. CL130 +00614 01 FOOTING-LINE-7. CL153 +00615 05 FILLER PIC X(25) VALUE SPACES. CL130 +00616 05 WS-X140-ERR-CNT PIC ZZ,ZZ9. CL130 +00617 05 FILLER PIC X(02) VALUE SPACES. CL130 +00618 05 FILLER PIC X(34) VALUE CL130 +00619 ' # OF REPORTS HAD ERRORS '. CL130 +00620 05 FILLER PIC X(32) VALUE SPACES. CL130 +00621 CL130 +00622 01 FOOTING-LINE-8. CL153 +00623 05 FILLER PIC X(25) VALUE SPACES. CL130 +00624 05 WS-X140-PEN-CNT PIC ZZ,ZZ9. CL130 +00625 05 FILLER PIC X(02) VALUE SPACES. CL130 +00626 05 FILLER PIC X(40) VALUE CL130 +00627 ' # OF REPORTS DUTAS CANNOT PROCESS '. CL176 +00628 05 FILLER PIC X(32) VALUE SPACES. CL130 +00629 CL119 +00630 01 FOOTING-LINE-9. CL153 +00631 05 FILLER PIC X(24) VALUE SPACES. CL153 +00632 05 WS-X144-RED-CNT PIC ZZZ,ZZ9. CL153 +00633 05 FILLER PIC X(02) VALUE SPACES. CL153 +00634 05 FILLER PIC X(45) VALUE CL170 +00635 'TOTAL WAGES RELEASED TO DUTAS '. CL179 +00636 05 FILLER PIC X(32) VALUE SPACES. CL153 +00637 01 FOOTING-LINE-10. CL153 +00638 05 FILLER PIC X(24) VALUE SPACES. CL153 +00639 05 WS-X144-ERR-CNT PIC ZZZ,ZZ9. CL153 +00640 05 FILLER PIC X(02) VALUE SPACES. CL153 +00641 05 FILLER PIC X(34) VALUE CL153 +00642 ' # OF WAGES HAD ERRORS '. CL153 +00643 05 FILLER PIC X(32) VALUE SPACES. CL153 +00644 CL153 +00645 01 FOOTING-LINE-11. CL153 +00646 05 FILLER PIC X(24) VALUE SPACES. CL153 +00647 05 WS-X144-PEN-CNT PIC ZZZ,ZZ9. CL153 +00648 05 FILLER PIC X(02) VALUE SPACES. CL153 +00649 05 FILLER PIC X(40) VALUE CL153 +00650 ' # OF WAGES DUTAS CANNOT PROCESS '. CL176 +00651 05 FILLER PIC X(32) VALUE SPACES. CL153 +00652 01 FOOTING-LINE-12. CL153 +00653 05 FILLER PIC X(19) VALUE SPACES. CL119 +00654 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL119 +00655 05 FILLER PIC X(02) VALUE SPACES. CL119 +00656 05 FILLER PIC X(45) VALUE CL171 +00657 ' TOTAL PAYMENTS APPLIED TO DUTAS'. CL175 +00658 05 FILLER PIC X(32) VALUE SPACES. CL119 +00659 CL119 +00660 01 FOOTING-LINE-15. CL175 +00661 05 FILLER PIC X(19) VALUE SPACES. CL174 +00662 05 WS-TOT-CREDIT PIC $$$$$$$$9.99. CL174 +00663 05 FILLER PIC X(02) VALUE SPACES. CL174 +00664 05 FILLER PIC X(45) VALUE CL174 +00665 ' TOTAL CREDITS APPLIED TO DUTAS'. CL174 +00666 05 FILLER PIC X(32) VALUE SPACES. CL174 +00667 CL174 +00668 01 FOOTING-LINE-13. CL153 +00669 05 FILLER PIC X(25) VALUE SPACES. CL119 +00670 05 FILLER PIC X(67) VALUE CL153 +00671 '*** END ESSP/DUTAS FINAL RPT/PAY/WAGE PROCESSING ***'. CL170 +00672 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL154 +00673 DTSBX551 +00674 01 T003-REC. DTSBX551 +00675 ++INCLUDE DTSIT003 DTSBX551 +00676 DTSBX551 +00677 01 T025-REC. DTSBX551 +00678 ++INCLUDE DTSIT025 DTSBX551 +00679 DTSBX551 +00680 *01 T027-REC. DTSBX551 +00681 *++INCLUDE DTSIT027 DTSBX551 +00682 DTSBX551 +00683 01 T028-REC. DTSBX551 +00684 ++INCLUDE DTSIT028 DTSBX551 +00685 DTSBX551 +00686 CL*11 +00687 01 W001-REC. DTSBX551 +00688 ++INCLUDE DTSIW001 DTSBX551 +00689 CL*11 +00690 01 WAGE-TRANS-AREA. CL*11 +00691 05 ESP-TRANSACTION-AREA PIC X(80). CL*11 +00692 ++INCLUDE EWGTRNW4 CL*11 +00693 CL208 +00694 ++INCLUDE EWGTRNW2 CL208 +00695 CL*11 +00696 DTSBX551 +00697 * ACCOUNTING BATCH HEADER DTSBX551 +00698 01 X149-REC. DTSBX551 +00699 ++INCLUDE DTSIX149 DTSBX551 +00700 DTSBX551 +00701 * REPORT DTSBX551 +00702 01 X140-REC. DTSBX551 +00703 ++INCLUDE DTSIX140 DTSBX551 +00704 DTSBX551 +00705 * EMPLOYEE WAGES DTSBX551 +00706 01 X144-REC. DTSBX551 +00707 ++INCLUDE DTSIX144 DTSBX551 +00708 DTSBX551 +00709 * EMPLOYEE AMENDED WAGES -W2 CL207 +00710 01 X147-REC. CL207 +00711 ++INCLUDE DTSIX147 CL207 +00712 CL207 +00713 * PAYMENTS CL*47 +00714 01 X145-REC. CL*47 +00715 ++INCLUDE DTSIX145 CL*47 +00716 CL*47 +00717 * BATCH - PSEUDO-BATCH XREF DTSBX551 +00718 01 X214-REC. DTSBX551 +00719 ++INCLUDE DTSIX214 DTSBX551 +00720 DTSBX551 +00721 * ERRORS DTSBX551 +00722 *01 X907-REC. DTSBX551 +00723 ***INCLUDE DTSIX907 DTSBX551 +00724 DTSBX551 +00725 01 L001-LINK-AREA. DTSBX551 +00726 ++INCLUDE DTSIL001 DTSBX551 +00727 DTSBX551 +00728 01 L003-LINK-AREA. DTSBX551 +00729 ++INCLUDE DTSIL003 DTSBX551 +00730 DTSBX551 +00731 01 L004-LINK-AREA. DTSBX551 +00732 ++INCLUDE DTSIL004 DTSBX551 +00733 DTSBX551 +00734 01 L516-LINK-AREA. DTSBX551 +00735 ++INCLUDE DTSIL516 DTSBX551 +00736 DTSBX551 +00737 01 L910-LINK-AREA. DTSBX551 +00738 ++INCLUDE DTSIL910 DTSBX551 +00739 01 MSKL-REC. DTSBX551 +00740 ++INCLUDE DTSIMSKL DTSBX551 +00741 DTSBX551 +00742 01 MHDR-REC. DTSBX551 +00743 ++INCLUDE DTSIMHDR DTSBX551 +00744 DTSBX551 +00745 01 MPRF-REC. DTSBX551 +00746 ++INCLUDE DTSIMPRF DTSBX551 +00747 DTSBX551 +00748 01 MSOL-REC. DTSBX551 +00749 ++INCLUDE DTSIMSOL DTSBX551 +00750 DTSBX551 +00751 01 MRPT-REC. CL211 +00752 ++INCLUDE DTSIMRPT CL211 +00753 DTSBX551 +00754 01 MQTR-REC. CL212 +00755 ++INCLUDE DTSIMQTR CL212 +00756 CL212 +00757 01 MOPO-REC. DTSBX551 +00758 ++INCLUDE DTSIMOPO DTSBX551 +00759 DTSBX551 +00760 01 MTAD-REC. DTSBX551 +00761 ++INCLUDE DTSIMTAD DTSBX551 +00762 DTSBX551 +00763 01 MNTE-REC. DTSBX551 +00764 ++INCLUDE DTSIMNTE DTSBX551 +00765 DTSBX551 +00766 01 L921-LINK-AREA. DTSBX551 +00767 ++INCLUDE DTSIL921 DTSBX551 +00768 SKIP3 DTSBX551 +00769 01 ISKL-REC. DTSBX551 +00770 ++INCLUDE DTSIISKL DTSBX551 +00771 SKIP3 DTSBX551 +00772 01 IEIN-REC. DTSBX551 +00773 ++INCLUDE DTSIIEIN DTSBX551 +00774 DTSBX551 +00775 01 L923-LINK-AREA. DTSBX551 +00776 ++INCLUDE DTSIL923 DTSBX551 +00777 EJECT DTSBX551 +00778 01 ASKL-REC. DTSBX551 +00779 ++INCLUDE DTSIASKL DTSBX551 +00780 EJECT DTSBX551 +00781 01 AHDR-REC. DTSBX551 +00782 ++INCLUDE DTSIAHDR DTSBX551 +00783 EJECT DTSBX551 +00784 01 ARPT-REC. DTSBX551 +00785 ++INCLUDE DTSIARPT DTSBX551 +00786 EJECT DTSBX551 +00787 01 APAY-REC. DTSBX551 +00788 ++INCLUDE DTSIAPAY DTSBX551 +00789 DTSBX551 +00790 01 L927-LINK-AREA. DTSBX551 +00791 ++INCLUDE DTSIL927 DTSBX551 +00792 DTSBX551 +00793 01 L931-LINK-AREA. DTSBX551 +00794 ++INCLUDE DTSIL931 DTSBX551 +00795 DTSBX551 +00796 01 FSKL-REC. DTSBX551 +00797 ++INCLUDE DTSIFSKL DTSBX551 +00798 DTSBX551 +00799 01 R140-REC. DTSBX551 +00800 ++INCLUDE DTSIR140 DTSBX551 +00801 DTSBX551 +00802 LINKAGE DTSBX551 +00803 SECTION. DTSBX551 +00804 DTSBX551 +00805 01 LX42-LINK-AREA. DTSBX551 +00806 ++INCLUDE DTSILX42 CL112 +00807 DTSBX551 +00808 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX551 +00809 DTSBX551 +00810 DTSBX436-MAIN. CL168 +00811 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA CL*80 +00812 MOVE LX42-RPT-ERROR-IND TO W-RPT-ERROR-IND. CL*80 +00813 CL*80 +00814 * IF W-RPT-ERROR-YES-88 CL161 +00815 * DISPLAY 'BX436 LX42 EMP REC HAS ERROR ' LX42-EMP-NO CL168 +00816 * ' ' LX42-RPT-ERROR-IND ' ' W-RPT-ERROR-IND CL161 +00817 * ELSE CL161 +00818 * DISPLAY 'BX436 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND CL168 +00819 * END-IF. CL161 +00820 CL157 +00821 EVALUATE TRUE DTSBX551 +00822 WHEN LX42-INITIALIZE-88 DTSBX551 +00823 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX551 +00824 DTSBX551 +00825 WHEN LX42-NEW-EMPLOYER-88 DTSBX551 +00826 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX551 +00827 DTSBX551 +00828 WHEN LX42-PROCESS-88 DTSBX551 +00829 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX551 +00830 DTSBX551 +00831 WHEN LX42-TERMINATE-88 DTSBX551 +00832 DISPLAY ' TERMINATE 430' CL*47 +00833 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX551 +00834 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX551 +00835 DTSBX551 +00836 END-EVALUATE. DTSBX551 +00837 CL*80 +00838 IF LX42-PROCESS-88 CL*80 +00839 MOVE W-RPT-ERROR-IND TO LX42-RPT-ERROR-IND CL*80 +00840 END-IF. CL*80 +00841 DTSBX551 +00842 DTSBX436-MAIN-EXIT. CL168 +00843 GOBACK. DTSBX551 +00844 DTSBX551 +00845 I0000-INITIATE. DTSBX551 +00846 SET W-RPT-ERROR-NO-88 TO TRUE. CL*81 +00847 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX551 +00848 DTSBX551 +00849 MOVE LENGTH OF X140-REC TO W-X140-LENGTH. DTSBX551 +00850 MOVE LENGTH OF X144-REC TO W-X144-LENGTH. DTSBX551 +00851 MOVE LENGTH OF X145-REC TO W-X145-LENGTH. CL*47 +00852 MOVE LENGTH OF X147-REC TO W-X147-LENGTH. CL208 +00853 DTSBX551 +00854 * FOR VARIABLE REPORT FILE. DTSBX551 +00855 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX551 +00856 MOVE '140' TO R140-REC-TYPE. DTSBX551 +00857 DTSBX551 +00858 MOVE LX42-CURR-RUN-DATE TO L004-DATE. DTSBX551 +00859 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX551 +00860 SUBTRACT +5 FROM L004-ABS-QTR. DTSBX551 +00861 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX551 +00862 MOVE L004-QTR-5-9 TO W-WAIVER-QTR. DTSBX551 +00863 DISPLAY 'BX451 CURR RUN DATE ' LX42-CURR-RUN-DATE. CL205 +00864 * DISPLAY 'BX436 WAIVE QTR ' W-WAIVER-QTR. CL205 +00865 DTSBX551 +00866 MOVE LX42-CURR-RUN-DATE TO WRK-CURR-RUN-DATE. CL158 +00867 MOVE WRK-CURR-CCYY TO RPT-CURR-CCYY CL158 +00868 MOVE WRK-CURR-MO TO RPT-CURR-MO CL158 +00869 MOVE WRK-CURR-DD TO RPT-CURR-DD CL158 +00870 DISPLAY 'RPT CURR RUN DATE ' WRK-CURR-RPT-DATE. CL157 +00871 MOVE WRK-CURR-RPT-DATE TO HDR1-LRCM-SYS-DATE. CL158 +00872 CL150 +00873 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX551 +00874 IF W-FATAL-ERROR-YES-88 DTSBX551 +00875 GO TO I0000-EXIT DTSBX551 +00876 END-IF. DTSBX551 +00877 DTSBX551 +00878 MOVE +0 TO W-ARPT-LAST. DTSBX551 +00879 PERFORM DTSBX551 +00880 VARYING RSUB FROM +1 BY +1 DTSBX551 +00881 UNTIL RSUB > W-ARPT-MAX DTSBX551 +00882 MOVE LOW-VALUES TO W-ARPT-ENTRY (RSUB) DTSBX551 +00883 END-PERFORM. DTSBX551 +00884 DTSBX551 +00885 I0000-EXIT. DTSBX551 +00886 EXIT. DTSBX551 +00887 DTSBX551 +00888 I2000-OPEN-FILES. DTSBX551 +00889 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX551 +00890 IF W-FATAL-ERROR-YES-88 DTSBX551 +00891 DISPLAY 'CANNOT OPEN TEMP X436BTC FILE ' CL169 +00892 TEMP-BTC-STATUS DTSBX551 +00893 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00894 END-IF. DTSBX551 +00895 DTSBX551 +00896 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBX551 +00897 IF W-FATAL-ERROR-YES-88 DTSBX551 +00898 DISPLAY 'CANNOT OPEN WAGE TEMP FILE ' DTSBX551 +00899 WAGE-TEMP-STATUS DTSBX551 +00900 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00901 END-IF. DTSBX551 +00902 DTSBX551 +00903 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. CL*20 +00904 IF W-FATAL-ERROR-YES-88 CL*20 +00905 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' CL*20 +00906 WAGE-OUT-STATUS CL*20 +00907 PERFORM S999-ABEND THRU S999-EXIT CL*20 +00908 END-IF. CL*20 +00909 DTSBX551 +00910 OPEN OUTPUT BATCH-XREF-FILE. DTSBX551 +00911 IF BATCH-XREF-OK-88 DTSBX551 +00912 NEXT SENTENCE DTSBX551 +00913 ELSE DTSBX551 +00914 DISPLAY 'CANNOT OPEN BATCH XREF FILE ' DTSBX551 +00915 BATCH-XREF-STATUS DTSBX551 +00916 PERFORM S999-ABEND THRU S999-EXIT DTSBX551 +00917 END-IF. DTSBX551 +00918 CL*12 +00919 CL*59 +00920 OPEN OUTPUT PEND-X140-FILE. CL*59 +00921 IF REPT-140-OK-88 CL*62 +00922 NEXT SENTENCE CL*59 +00923 ELSE CL*59 +00924 DISPLAY 'CANNOT OPEN AMENDS X140 FILE' CL206 +00925 REPT-140-STATUS CL*62 +00926 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00927 END-IF. CL*59 +00928 CL*59 +00929 OPEN OUTPUT PEND-X144-FILE. CL*59 +00930 IF WAGE-144-OK-88 CL*62 +00931 NEXT SENTENCE CL*59 +00932 ELSE CL*59 +00933 DISPLAY 'CANNOT OPEN AMENDS X144 FILE' CL206 +00934 WAGE-144-STATUS CL*62 +00935 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00936 END-IF. CL*59 +00937 CL*59 +00938 CL208 +00939 OPEN OUTPUT PEND-X147-FILE. CL208 +00940 IF WAGE-144-OK-88 CL208 +00941 NEXT SENTENCE CL208 +00942 ELSE CL208 +00943 DISPLAY 'CANNOT OPEN AMENDS X147 FILE' CL208 +00944 WAGE-144-STATUS CL208 +00945 PERFORM S999-ABEND THRU S999-EXIT CL208 +00946 END-IF. CL208 +00947 CL208 +00948 OPEN OUTPUT PEND-X145-FILE. CL*59 +00949 IF PAYT-145-OK-88 CL*62 +00950 NEXT SENTENCE CL*59 +00951 ELSE CL*59 +00952 DISPLAY 'CANNOT OPEN AMENDS X145 FILE' CL206 +00953 PAYT-145-STATUS CL*62 +00954 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00955 END-IF. CL*59 +00956 CL119 +00957 CL119 +00958 OPEN OUTPUT REPT-PEND-FILE. CL119 +00959 IF REPT-STATUS-OK-88 CL119 +00960 NEXT SENTENCE CL119 +00961 ELSE CL119 +00962 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' CL119 +00963 REPT-STATUS CL119 +00964 PERFORM S999-ABEND THRU S999-EXIT CL119 +00965 END-IF. CL119 +00966 DTSBX551 +00967 OPEN OUTPUT REPT-PAID-FILE. CL119 +00968 IF REPT-STATUS-OK-88 CL119 +00969 NEXT SENTENCE CL119 +00970 ELSE CL119 +00971 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' CL119 +00972 REPT-STATUS CL119 +00973 PERFORM S999-ABEND THRU S999-EXIT CL119 +00974 END-IF. CL119 +00975 CL119 +00976 I2000-EXIT. DTSBX551 +00977 EXIT. DTSBX551 +00978 DTSBX551 +00979 P0000-PROCESS. DTSBX551 +00980 CL**2 +00981 EVALUATE TRUE DTSBX551 +00982 WHEN LX42-REC-TYPE-PAY-88 CL*47 +00983 PERFORM P1000-PAYMENT THRU P1000-EXIT CL*47 +00984 DTSBX551 +00985 WHEN LX42-REC-TYPE-RPT-88 CL*47 +00986 PERFORM P2000-REPORT THRU P2000-EXIT CL*47 +00987 CL*47 +00988 WHEN LX42-REC-TYPE-WAGE-88 DTSBX551 +00989 PERFORM P3000-WAGES THRU P3000-EXIT DTSBX551 +00990 CL*47 +00991 WHEN LX42-REC-TYPE-AWAGE-88 CL207 +00992 PERFORM P3500-WAGES THRU P3500-EXIT CL209 +00993 CL207 +00994 WHEN OTHER CL*47 +00995 DISPLAY 'DTSBX451 ABENDING - INVALID RECORD TYPE ' CL206 +00996 LX42-REC-TYPE CL*47 +00997 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00998 CL*47 +00999 END-EVALUATE. DTSBX551 +01000 DTSBX551 +01001 P0000-EXIT. DTSBX551 +01002 EXIT. DTSBX551 +01003 P1000-PAYMENT. CL*47 +01004 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. CL*57 +01005 MOVE LX42-DATA-AREA TO X145-REC. CL*50 +01006 *& CL*50 +01007 MOVE X145-EMP-NO TO W-EMP-NO. CL*50 +01008 SET W-EMP-FOUND-NO-88 TO TRUE. CL*50 +01009 CL*50 +01010 ADD +1 TO W-X145-RED-CNT CL*50 +01011 DISPLAY SPACE. CL*50 +01012 DISPLAY 'BX451- NEW EMPLOYER PAYMENT ' X145-EMP-NO. CL205 +01013 * DISPLAY ' X145-KEY ' X145-EMP-NO. CL161 +01014 * DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA. CL161 +01015 CL*51 +01016 * IF LX42-X145-EMP-NO = '999999' CL169 +01017 * SET W-RPT-ERROR-YES-88 TO TRUE CL169 +01018 * MOVE SPACES TO R140-MESSAGE CL169 +01019 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +01020 * STRING CL169 +01021 * 'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS ' CL169 +01022 * DELIMITED BY SIZE CL169 +01023 * INTO R140-MESSAGE CL169 +01024 * END-STRING CL169 +01025 * MOVE R140-MESSAGE TO P434-MESSAGE CL169 +01026 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +01027 * MOVE '999999' TO LX42-X145-EMP-NO CL169 +01028 * ADD +1 TO W-X145-ERR-CNT CL169 +01029 * ADD +1 TO W-X145-PEN-CNT CL169 +01030 * WRITE PEND-X145-REC FROM X145-REC CL169 +01031 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL169 +01032 * GO TO P1000-EXIT. CL169 +01033 CL*51 +01034 CL*51 +01035 * IF LX42-REC-TYPE-PAY-88 CL169 +01036 * IF LX42-X145-KEY-AREA = X145-EMP-NO AND CL169 +01037 * LX42-X145-QTR-AREA = X145-QTR CL169 +01038 * SET W-PREV-RPT-NULL-88 TO TRUE CL169 +01039 * ADD +1 TO W-X145-DUP-CNT CL169 +01040 * DISPLAY 'X145 DUPLICATE PAYMENT RECORD ' W-EMP-NO CL161 +01041 * ' ERR IND ' W-RPT-ERROR-IND CL161 +01042 * MOVE SPACES TO R140-MESSAGE CL169 +01043 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +01044 * MOVE SPACES TO R140-MESSAGE CL169 +01045 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +01046 * STRING CL169 +01047 * ': DUPLICATE PAYMENT RECORD ----PROCESS ' CL169 +01048 * DELIMITED BY SIZE CL169 +01049 * INTO R140-MESSAGE CL169 +01050 * END-STRING CL169 +01051 * MOVE R140-MESSAGE TO P434-MESSAGE CL169 +01052 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +01053 * ELSE CL169 +01054 * MOVE X145-EMP-NO TO LX42-X145-KEY-AREA CL169 +01055 * END-IF CL169 +01056 * END-IF. CL171 +01057 CL*51 +01058 CL*51 +01059 MOVE X145-EMP-NO TO LX42-X145-EMP-NO. CL*51 +01060 MOVE X145-QTR TO LX42-X145-QTR-AREA CL*83 +01061 CL*50 +01062 * DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. CL161 +01063 * IF W-PREV-RPT-NULL-88 OR CL169 +01064 * LX42-REC-TYPE-PAY-88 CL169 +01065 * SET W-PREV-RPT-PAY-88 TO TRUE CL169 +01066 * SET W-PREV-REC-PAY-88 TO TRUE CL107 +01067 ADD +1 TO W-X145-PRO-CNT CL*50 +01068 PERFORM P1110-EDIT-PAYMENT THRU P1110-EXIT CL*51 +01069 IF W-RPT-ERROR-NO-88 CL*81 +01070 PERFORM P1112-CHECK-PAYMENT THRU P1112-EXIT CL*51 +01071 IF W-RPT-ERROR-NO-88 CL*81 +01072 * DISPLAY 'X145 PAYMENT REC PASS EDITS ' W-EMP-NO CL161 +01073 ADD +1 TO W-X145-SAV-CNT CL*51 +01074 PERFORM P1120-SAVE-PAYMENT THRU P1120-EXIT CL*51 +01075 ELSE CL*51 +01076 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01077 ADD +1 TO W-X145-ERR-CNT CL*51 +01078 ADD +1 TO W-X145-PEN-CNT CL*92 +01079 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01080 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01081 WRITE PEND-X145-REC FROM X145-REC CL199 +01082 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 CL203 +01083 END-IF CL*51 +01084 ELSE CL*49 +01085 MOVE '999999' TO LX42-X145-EMP-NO CL*50 +01086 ADD +1 TO W-X145-ERR-CNT CL*51 +01087 ADD +1 TO W-X145-PEN-CNT CL*92 +01088 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01089 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01090 WRITE PEND-X145-REC FROM X145-REC CL199 +01091 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 CL203 +01092 END-IF. CL171 +01093 CL*49 +01094 P1000-EXIT. CL*51 +01095 EXIT. CL*49 +01096 CL*49 +01097 P1110-EDIT-PAYMENT. CL*47 +01098 CL*54 +01099 MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*54 +01100 IF W-VALID-PAY-88 CL*54 +01101 NEXT SENTENCE CL*54 +01102 ELSE CL*54 +01103 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01104 MOVE SPACES TO R140-MESSAGE CL*54 +01105 MOVE W-EMP-NO TO R140-EMP-NO CL*54 +01106 STRING CL*54 +01107 ':PAY- INVALID PAYMENT TYPE ' CL144 +01108 X145-PAY-TYPE CL*54 +01109 DELIMITED BY SIZE CL*54 +01110 INTO R140-MESSAGE CL*54 +01111 END-STRING CL*54 +01112 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01113 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54 +01114 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01115 END-IF. CL*54 +01116 IF X145-QTR = SPACES CL*47 +01117 MOVE '2015/1' TO W-SLASH-QTR CL204 +01118 ELSE CL*47 +01119 MOVE X145-QTR TO W-SLASH-QTR. CL*47 +01120 CL*47 +01121 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR CL*47 +01122 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q CL*47 +01123 PERFORM S004-FROM-5 THRU S004-EXIT CL*47 +01124 IF NOT L004-VALID-QTR CL*47 +01125 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01126 MOVE SPACES TO R140-MESSAGE CL*47 +01127 MOVE W-EMP-NO TO R140-EMP-NO CL*47 +01128 STRING CL*47 +01129 ':PAY- INVALID QUARTER ' W-SLASH-QTR CL144 +01130 DELIMITED BY SIZE CL*47 +01131 INTO R140-MESSAGE CL*47 +01132 END-STRING CL*47 +01133 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*47 +01134 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01135 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01136 ELSE CL*48 +01137 MOVE L004-QTR-5-9 TO W-X145-PAYMENT-QTR CL*56 +01138 END-IF. CL*48 +01139 CL*48 +01140 * DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR CL*92 +01141 CL*53 +01142 MOVE X145-REMITTANCE TO W-X145-REMITTANCE. CL*53 +01143 * DISPLAY 'W145REMITCE ' W-X145-REMITTANCE. CL161 +01144 * DISPLAY 'X145REMITCE ' X145-REMITTANCE. CL161 +01145 CL*51 +01146 IF W-X145-REMITTANCE = ZEROS CL*56 +01147 * SET W-RPT-ERROR-YES-88 TO TRUE CL172 +01148 ADD +1 TO W-X145-ZRO-CNT CL172 +01149 MOVE SPACES TO R140-MESSAGE CL*51 +01150 MOVE W-EMP-NO TO R140-EMP-NO CL*51 +01151 * STRING CL169 +01152 * 'X430- REVIEW REMITTANCE AMOUNT= 0 ' CL169 +01153 * DELIMITED BY SIZE CL169 +01154 * INTO R140-MESSAGE CL169 +01155 * END-STRING CL169 +01156 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +01157 END-IF. CL*51 +01158 CL*51 +01159 MOVE ZEROS TO W-X145-RECEIVED-DATE CL*72 +01160 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*48 +01161 MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*48 +01162 MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*48 +01163 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*48 +01164 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*48 +01165 IF NOT L001-VALID-DATE CL*48 +01166 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01167 MOVE SPACES TO R140-MESSAGE CL*48 +01168 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01169 STRING CL*48 +01170 ':PAY- INVALID RECEIVED DATE ' CL144 +01171 ' ' X145-RCVD-DATE CL*48 +01172 DELIMITED BY SIZE CL*48 +01173 INTO R140-MESSAGE CL*48 +01174 END-STRING CL*48 +01175 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01176 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01177 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01178 ELSE CL*48 +01179 MOVE L001-FED-8-DATE-9 TO W-X145-RECEIVED-DATE CL*72 +01180 END-IF. CL*48 +01181 CL*55 +01182 P1110-EXIT. CL*55 +01183 EXIT. CL*55 +01184 CL*55 +01185 P1112-CHECK-PAYMENT. CL*51 +01186 MOVE LOW-VALUE TO MPRF-KEY-AREA. CL*48 +01187 MOVE W-EMP-NO TO MPRF-EMP-NO. CL*48 +01188 SET MPRF-PRF-88 TO TRUE. CL*48 +01189 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*48 +01190 CL*48 +01191 PERFORM S910-READ THRU S910-EXIT. CL*48 +01192 IF L910-NO-REC-88 CL*48 +01193 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01194 SET W-EMP-FOUND-NO-88 TO TRUE CL*48 +01195 MOVE SPACES TO R140-MESSAGE CL*48 +01196 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01197 STRING CL*48 +01198 ':EMP NOT ON DUTAS -CANNOT PAY ' CL144 +01199 X145-EMP-NO CL*48 +01200 DELIMITED BY SIZE CL*48 +01201 INTO R140-MESSAGE CL*48 +01202 END-STRING CL*48 +01203 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01204 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01205 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01206 ELSE CL*48 +01207 MOVE MSKL-REC TO MPRF-REC CL*48 +01208 SET W-EMP-FOUND-YES-88 TO TRUE CL*48 +01209 END-IF. CL*48 +01210 CL*48 +01211 P1112-EXIT. CL*51 +01212 EXIT. CL*48 +01213 CL*48 +01214 P1120-SAVE-PAYMENT. CL*51 +01215 IF W-X145-REMITTANCE = ZEROS CL176 +01216 GO TO P1120-EXIT. CL176 +01217 * DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO. CL161 +01218 MOVE W-X145-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL169 +01219 ADD W-X145-REMITTANCE TO W-TOT-REMIT-AMT. CL172 +01220 ADD +1 TO W-X145-SAV-CNT. CL169 +01221 PERFORM P2021-WRITE-T025 THRU P2021-EXIT. CL170 +01222 P1120-EXIT. CL176 +01223 EXIT. CL*51 +01224 CL*51 +01225 CL*48 +01226 DTSBX551 +01227 P2000-REPORT. DTSBX551 +01228 MOVE LX42-DATA-AREA TO X140-REC. DTSBX551 +01229 CL**2 +01230 * SET W-RPT-IN-PROGRESS-YES-88 TO TRUE CL*56 +01231 CL**2 +01232 MOVE X140-EMP-NO TO W-EMP-NO. DTSBX551 +01233 CL*40 +01234 ADD +1 TO W-X140-RED-CNT. CL*56 +01235 * DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE. CL161 +01236 * IF W-PREV-RPT-NULL-88 CL169 +01237 * SET W-PREV-RPT-RPT-88 TO TRUE CL169 +01238 * SET W-X145-PAYMENT-NO-88 TO TRUE CL169 +01239 * ELSE CL169 +01240 * SET W-X145-PAYMENT-YES-88 TO TRUE CL169 +01241 * END-IF. CL169 +01242 CL*52 +01243 * IF LX42-REC-TYPE-RPT-88 CL219 +01244 * IF LX42-X140-KEY-AREA = X140-EMP-NO AND CL219 +01245 * LX42-X140-QTR-AREA = X140-QUARTER CL219 +01246 * SET W-RPT-ERROR-YES-88 TO TRUE CL219 +01247 * ADD +1 TO W-X140-DUP-CNT CL219 +01248 * ADD +1 TO W-X140-PEN-CNT CL219 +01249 * DISPLAY ':ERROR-RPT DUPLICATE REPORT D ' CL219 +01250 * ' ERR IND ' W-RPT-ERROR-IND CL219 +01251 * MOVE SPACES TO R140-MESSAGE CL219 +01252 * MOVE W-EMP-NO TO R140-EMP-NO CL219 +01253 * STRING CL219 +01254 * ':RPT- DUPLICATE REPORT RECORD ' CL219 +01255 * DELIMITED BY SIZE CL219 +01256 * INTO R140-MESSAGE CL219 +01257 * END-STRING CL219 +01258 * MOVE R140-MESSAGE TO P434-MESSAGE CL219 +01259 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL219 +01260 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL219 +01261 * WRITE PEND-X140-REC FROM X140-REC CL219 +01262 * MOVE '999999' TO LX42-X140-EMP-NO CL219 +01263 * GO TO P2000-EXIT CL219 +01264 * ELSE CL219 +01265 * MOVE X140-EMP-NO TO LX42-X140-KEY-AREA CL219 +01266 * END-IF CL219 +01267 * END-IF. CL219 +01268 CL*40 +01269 SET W-RPT-ERROR-NO-88 TO TRUE CL180 +01270 MOVE X140-EMP-NO TO LX42-X140-EMP-NO. CL**3 +01271 MOVE X140-QUARTER TO LX42-X140-QTR-AREA CL*80 +01272 SET W-EMP-FOUND-NO-88 TO TRUE. DTSBX551 +01273 CL*51 +01274 * IF LX42-X145-EMP-NO = '999999' CL169 +01275 * SET W-RPT-ERROR-YES-88 TO TRUE CL169 +01276 * MOVE SPACES TO R140-MESSAGE CL169 +01277 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +01278 * STRING CL169 +01279 * ':PAY RECORD INVALID -RPT BYPASSED ' CL169 +01280 * DELIMITED BY SIZE CL169 +01281 ** INTO R140-MESSAGE CL169 +01282 * END-STRING CL169 +01283 * MOVE '999999' TO LX42-X140-EMP-NO CL169 +01284 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +01285 * ADD +1 TO W-X140-PEN-CNT CL169 +01286 * WRITE PEND-X140-REC FROM X140-REC CL169 +01287 * MOVE R140-MESSAGE TO P434-MESSAGE CL169 +01288 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL169 +01289 * GO TO P2000-EXIT. CL169 +01290 CL*40 +01291 SET W-PREV-RPT-RPT-88 TO TRUE. CL*84 +01292 DTSBX551 +01293 DTSBX551 +01294 PERFORM P2010-EDIT-REPORT THRU P2010-EXIT DTSBX551 +01295 CL**3 +01296 IF W-RPT-ERROR-YES-88 CL*81 +01297 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01298 DISPLAY ' REPORT HAS ERRORS - DATA ERRORS' CL196 +01299 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01300 CL**3 +01301 PERFORM P2012-CHECK-MPRF THRU P2012-EXIT CL**3 +01302 IF W-RPT-ERROR-YES-88 CL*81 +01303 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01304 DISPLAY ' REPORT HAS ERRORS - MPRF ERRORS' CL196 +01305 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01306 CL**3 +01307 PERFORM P2013-CHECK-MQTR THRU P2013-EXIT CL212 +01308 IF W-RPT-ERROR-YES-88 CL*81 +01309 MOVE '999999' TO LX42-X140-EMP-NO CL*60 +01310 DISPLAY ' REPORT HAS ERRORS - CANNOT-AMEND' CL210 +01311 GO TO P2000-EDIT-REPORT-CONTINUE. CL*60 +01312 CL*32 +01313 P2000-EDIT-REPORT-CONTINUE. CL*32 +01314 IF W-RPT-ERROR-YES-88 CL*81 +01315 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01316 MOVE SPACES TO R140-MESSAGE CL196 +01317 MOVE W-EMP-NO TO R140-EMP-NO CL*32 +01318 STRING CL196 +01319 ': REPORT CONTAINS ERRORS CANNOT AMEND ' CL210 +01320 ' ' X140-QUARTER CL196 +01321 DELIMITED BY SIZE CL196 +01322 INTO R140-MESSAGE CL196 +01323 END-STRING CL196 +01324 PERFORM S946-WRITE-R140 THRU S946-EXIT CL181 +01325 ADD +1 TO W-X140-PEN-CNT CL181 +01326 WRITE PEND-X140-REC FROM X140-REC CL181 +01327 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL181 +01328 MOVE R140-MESSAGE TO P434-MESSAGE CL181 +01329 GO TO P2000-EXIT. CL*32 +01330 CL**3 +01331 PERFORM P2020-SAVE-EXT-REPORT THRU P2020-EXIT. CL**3 +01332 ADD +1 TO W-X140-SAV-CNT. CL*93 +01333 CL*67 +01334 DTSBX551 +01335 P2000-EXIT. DTSBX551 +01336 EXIT. DTSBX551 +01337 DTSBX551 +01338 P2010-EDIT-REPORT. DTSBX551 +01339 MOVE X140-QUARTER TO W-SLASH-QTR. DTSBX551 +01340 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX551 +01341 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX551 +01342 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX551 +01343 IF NOT L004-VALID-QTR DTSBX551 +01344 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01345 MOVE SPACES TO R140-MESSAGE DTSBX551 +01346 MOVE W-EMP-NO TO R140-EMP-NO DTSBX551 +01347 STRING DTSBX551 +01348 ':RPT- INVALID QUARTER ' CL144 +01349 X140-QUARTER DTSBX551 +01350 DELIMITED BY SIZE DTSBX551 +01351 INTO R140-MESSAGE DTSBX551 +01352 END-STRING DTSBX551 +01353 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01354 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX551 +01355 ELSE DTSBX551 +01356 MOVE L004-QTR-5-9 TO W-X140-REPORT-QTR CL*56 +01357 END-IF. DTSBX551 +01358 DTSBX551 +01359 MOVE X140-REPORT-TYPE TO W-RPT-TYPE. DTSBX551 +01360 IF NOT W-RPT-TYPE-VALID-88 DTSBX551 +01361 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01362 MOVE SPACES TO R140-MESSAGE DTSBX551 +01363 MOVE W-EMP-NO TO R140-EMP-NO DTSBX551 +01364 STRING DTSBX551 +01365 'ERROR-RPT INVALID REPORT TYPE ' CL144 +01366 X140-REPORT-TYPE CL**2 +01367 DELIMITED BY SIZE DTSBX551 +01368 INTO R140-MESSAGE DTSBX551 +01369 END-STRING DTSBX551 +01370 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01371 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX551 +01372 END-IF. DTSBX551 +01373 CL113 +01374 IF W-RPT-TYPE NOT = 'EA' AND 'AC' CL220 +01375 SET W-RPT-ERROR-YES-88 TO TRUE CL113 +01376 MOVE SPACES TO R140-MESSAGE CL113 +01377 MOVE W-EMP-NO TO R140-EMP-NO CL113 +01378 STRING CL113 +01379 ':RPT- NOT AMENDED RPT - CANNOT PROCESS ' CL206 +01380 ' ' W-RPT-TYPE CL116 +01381 DELIMITED BY SIZE CL113 +01382 INTO R140-MESSAGE CL113 +01383 END-STRING CL113 +01384 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01385 PERFORM S946-WRITE-R140 THRU S946-EXIT CL113 +01386 END-IF. CL113 +01387 CL113 +01388 DTSBX551 +01389 * IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR CL*82 +01390 * MOVE ZERO TO W-TOT-WAGE CL*82 +01391 * MOVE W-X140-REPORT-QTR TO W-CURR-RPT-QTR CL*82 +01392 * END-IF. CL*82 +01393 MOVE X140-TOTAL-WAGES TO W-TOT-WAGE. DTSBX551 +01394 MOVE X140-TAX-WAGES TO W-TAX-WAGE. DTSBX551 +01395 MOVE X140-EXCESS-WAGES TO W-EXX-WAGE. CL222 +01396 CL*44 +01397 * IF W-EMP-NO = 177462 CL*53 +01398 * MOVE 1352.07 TO X140-REMITTANCE CL*53 +01399 * DISPLAY ' X140-RMT ' X140-REMITTANCE. CL161 +01400 DTSBX551 +01401 MOVE X140-REMITTANCE TO W-X140-REMITTANCE. CL*53 +01402 * DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE. CL161 +01403 *& DTSBX551 +01404 CL*52 +01405 * DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND. CL161 +01406 CL*68 +01407 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0 CL170 +01408 * MOVE SPACES TO R140-MESSAGE CL170 +01409 * SET W-RPT-ERROR-YES-88 TO TRUE CL170 +01410 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01411 * STRING CL170 +01412 * 'ESSP AMT DUE > 0 AND NO PAYMT ' CL170 +01413 * DELIMITED BY SIZE CL170 +01414 * INTO R140-MESSAGE CL170 +01415 * END-STRING CL170 +01416 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01417 * MOVE R140-MESSAGE TO P434-MESSAGE CL170 +01418 * GO TO P2010-EDIT-CONTINUE CL170 +01419 * END-IF. CL170 +01420 CL*52 +01421 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0 CL170 +01422 * MOVE SPACES TO R140-MESSAGE CL170 +01423 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01424 * STRING CL170 +01425 * 'X140 REMIT AMT = 0 AND NO X145 FOUND -PROCESS ' CL170 +01426 * ' ' X140-REMITTANCE CL170 +01427 * DELIMITED BY SIZE CL170 +01428 * INTO R140-MESSAGE CL170 +01429 * END-STRING CL170 +01430 * MOVE R140-MESSAGE TO P434-MESSAGE CL170 +01431 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01432 * GO TO P2010-EDIT-CONTINUE CL170 +01433 * END-IF. CL170 +01434 CL*69 +01435 * IF W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE CL170 +01436 * MOVE SPACES TO R140-MESSAGE CL170 +01437 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01438 * SET W-WRITE-T025-TRAN-YES-88 TO TRUE CL108 +01439 * STRING CL170 +01440 * 'X430 X145-PAY AMT > X140-REMIT AMT --PROCESS ' CL170 +01441 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01442 * DELIMITED BY SIZE CL170 +01443 * INTO R140-MESSAGE CL170 +01444 * END-STRING CL170 +01445 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01446 * END-IF. CL170 +01447 CL*53 +01448 * IF W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE CL170 +01449 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01450 * MOVE SPACES TO R140-MESSAGE CL170 +01451 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01452 * STRING CL170 +01453 * 'X430 X145-PAY AMT < X140-REMIT AMT ' CL170 +01454 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01455 * DELIMITED BY SIZE CL170 +01456 * INTO R140-MESSAGE CL170 +01457 * END-STRING CL170 +01458 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01459 * END-IF. CL170 +01460 CL*67 +01461 * IF W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0 CL170 +01462 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01463 * MOVE SPACES TO R140-MESSAGE CL170 +01464 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01465 * STRING CL170 +01466 * 'X430 X145-PAY AMT > 0 AND X140-REMIT AMT = 0 ' CL170 +01467 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01468 * DELIMITED BY SIZE CL170 +01469 * INTO R140-MESSAGE CL170 +01470 * END-STRING CL170 +01471 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01472 * END-IF. CL170 +01473 CL*67 +01474 * IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE CL170 +01475 * ADD 1 TO W-T028-WRITEE-CNT CL170 +01476 * SET W-RPT-ERROR-NO-88 TO TRUE CL170 +01477 * MOVE SPACES TO R140-MESSAGE CL170 +01478 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01479 * STRING CL170 +01480 * 'X430 ++++ X145-REMIT AMT = X140-REMIT AMT ' CL170 +01481 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01482 * DELIMITED BY SIZE CL170 +01483 * INTO R140-MESSAGE CL170 +01484 * END-STRING CL170 +01485 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01486 * END-IF. CL170 +01487 CL102 +01488 P2010-EDIT-CONTINUE. CL*69 +01489 * DISPLAY 'BX436 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES CL168 +01490 * ' TOT: ' X140-TOTAL-WAGES ' RMT: ' W-X140-REMITTANCE CL161 +01491 *& DTSBX551 +01492 MOVE ZERO TO W-X140-RECEIVED-DATE. CL*72 +01493 MOVE X140-RCVD-DATE TO W-SLASH-DATE. DTSBX551 +01494 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX551 +01495 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX551 +01496 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX551 +01497 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX551 +01498 IF NOT L001-VALID-DATE DTSBX551 +01499 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01500 MOVE SPACES TO R140-MESSAGE DTSBX551 +01501 MOVE W-EMP-NO TO R140-EMP-NO DTSBX551 +01502 STRING DTSBX551 +01503 ':RPT- INVALID RECEIVED DATE ' CL144 +01504 X140-RCVD-DATE CL**2 +01505 DELIMITED BY SIZE DTSBX551 +01506 INTO R140-MESSAGE DTSBX551 +01507 END-STRING DTSBX551 +01508 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01509 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX551 +01510 ELSE DTSBX551 +01511 MOVE L001-FED-8-DATE-9 TO W-X140-RECEIVED-DATE CL*72 +01512 END-IF. DTSBX551 +01513 DTSBX551 +01514 MOVE ZERO TO W-CHK-SCAN-DATE. DTSBX551 +01515 * IF X140-IN-HOUSE-88 DTSBX551 +01516 * MOVE X140-CHECK-SCAN-DT TO W-SLASH-DATE DTSBX551 +01517 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX551 +01518 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX551 +01519 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX551 +01520 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX551 +01521 * IF NOT L001-VALID-DATE DTSBX551 +01522 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01523 * MOVE SPACES TO R140-MESSAGE DTSBX551 +01524 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX551 +01525 * STRING DTSBX551 +01526 * 'REPORT: INVALID CHK SCAN DATE ' DTSBX551 +01527 * X140-CHECK-SCAN-DT DTSBX551 +01528 * DELIMITED BY SIZE DTSBX551 +01529 * INTO R140-MESSAGE DTSBX551 +01530 * END-STRING DTSBX551 +01531 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX551 +01532 ** DISPLAY R140-MESSAGE DTSBX551 +01533 * ELSE DTSBX551 +01534 * MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSBX551 +01535 * END-IF DTSBX551 +01536 * END-IF. DTSBX551 +01537 DTSBX551 +01538 MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT. DTSBX551 +01539 MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT. DTSBX551 +01540 MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT. DTSBX551 +01541 MOVE X140-WRKR-CNT-TOTAL TO W-WRKR-CNT-TOTAL. CL156 +01542 DTSBX551 +01543 DTSBX551 +01544 P2010-EXIT. DTSBX551 +01545 EXIT. DTSBX551 +01546 DTSBX551 +01547 P2012-CHECK-MPRF. CL**2 +01548 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX551 +01549 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX551 +01550 SET MPRF-PRF-88 TO TRUE. DTSBX551 +01551 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX551 +01552 DTSBX551 +01553 PERFORM S910-READ THRU S910-EXIT. DTSBX551 +01554 CL**2 +01555 IF L910-OK-88 CL**2 +01556 MOVE MSKL-REC TO MPRF-REC CL**2 +01557 MOVE W-X140-REPORT-QTR TO L516-YRQ CL*56 +01558 PERFORM S516-LIABILITY-INFO THRU S516-EXIT CL**2 +01559 IF L516-LIABLE-88 CL*57 +01560 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01561 SET W-EMP-FOUND-YES-88 TO TRUE CL*57 +01562 DISPLAY 'X430 -EMPLOYER FOUND LIAB FOR QTR ' MPRF-EMP-NO CL210 +01563 GO TO P2012-EXIT CL*57 +01564 ELSE CL*57 +01565 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01566 MOVE SPACES TO R140-MESSAGE CL**2 +01567 MOVE W-EMP-NO TO R140-EMP-NO CL**2 +01568 STRING CL**2 +01569 ':EMP NOT LIABLE FOR QTRLY RPT -CANNOT AMEND' CL210 +01570 X140-QUARTER CL**7 +01571 DELIMITED BY SIZE CL**2 +01572 INTO R140-MESSAGE CL**2 +01573 END-STRING CL**2 +01574 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01575 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 +01576 SET W-EMP-FOUND-NO-88 TO TRUE CL**2 +01577 GO TO P2012-EXIT CL*51 +01578 ELSE CL*51 +01579 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01580 MOVE SPACES TO R140-MESSAGE CL*51 +01581 MOVE W-EMP-NO TO R140-EMP-NO CL*51 +01582 STRING CL*51 +01583 ':EMP NOT FOUND ON DUTAS-CANNOT AMEND RPT' CL210 +01584 X140-EMP-NO CL*51 +01585 DELIMITED BY SIZE CL*51 +01586 INTO R140-MESSAGE CL*51 +01587 END-STRING CL*51 +01588 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01589 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*51 +01590 SET W-EMP-FOUND-NO-88 TO TRUE CL*51 +01591 END-IF. CL*51 +01592 CL**2 +01593 P2012-EXIT. CL**2 +01594 EXIT. DTSBX551 +01595 DTSBX551 +01596 CL**2 +01597 P2013-CHECK-MQTR. CL212 +01598 DISPLAY 'P2013 X140 X140 REPORT FROM ESSP- ' CL212 +01599 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL212 +01600 DISPLAY ' ' CL212 +01601 MOVE LOW-VALUE TO MQTR-KEY-AREA. CL212 +01602 MOVE W-EMP-NO TO MQTR-EMP-NO. CL212 +01603 SET MQTR-QTR-88 TO TRUE. CL212 +01604 MOVE W-X140-REPORT-QTR TO MQTR-YRQ. CL212 +01605 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL212 +01606 CL212 +01607 PERFORM S910-READ THRU S910-EXIT. CL212 +01608 CL212 +01609 IF L910-NO-REC-88 CL212 +01610 DISPLAY 'P2013 X430 NO REC FOUND ' L910-RESULT-IND CL212 +01611 ELSE CL212 +01612 IF L910-OK-88 CL212 +01613 DISPLAY 'P2013 X430 REC FOUND ' L910-RESULT-IND CL212 +01614 ELSE CL212 +01615 DISPLAY 'P2013 X430 NOT SURE ' L910-RESULT-IND. CL212 +01616 CL212 +01617 IF L910-NO-REC-88 CL212 +01618 DISPLAY 'X430 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL212 +01619 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO CL212 +01620 SET W-RPT-ERROR-YES-88 TO TRUE CL212 +01621 MOVE SPACES TO R140-MESSAGE CL212 +01622 MOVE W-EMP-NO TO R140-EMP-NO CL212 +01623 STRING CL212 +01624 'P2013 -ORIG REPORT NOT IN DUTAS - CANNOT AMEND' CL212 +01625 W-RPT-TYPE CL212 +01626 DELIMITED BY SIZE CL212 +01627 INTO R140-MESSAGE CL212 +01628 END-STRING CL212 +01629 PERFORM S946-WRITE-R140 THRU S946-EXIT CL212 +01630 SET W-EMP-FOUND-NO-88 TO TRUE CL212 +01631 GO TO P2013-EXIT. CL212 +01632 CL212 +01633 CL212 +01634 MOVE MSKL-REC TO MQTR-REC CL212 +01635 CL212 +01636 DISPLAY 'PXXXX QTR RPT FOUND ON DUTAS ' CL212 +01637 MQTR-EMP-NO ' ' MQTR-YRQ ' RPT-TYP ' MQTR-CURR-RPT-TYPE CL212 +01638 ' PUR-IND ' MQTR-PURSUED-RPT-IND CL212 +01639 ' CUT-OFF ' MQTR-MISS-RPT-CUTOFF-CD CL212 +01640 CL212 +01641 IF MQTR-CURR-MISSING-88 CL212 +01642 DISPLAY 'X430 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL212 +01643 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO CL212 +01644 SET W-RPT-ERROR-YES-88 TO TRUE CL212 +01645 MOVE SPACES TO R140-MESSAGE CL212 +01646 MOVE W-EMP-NO TO R140-EMP-NO CL212 +01647 STRING CL212 +01648 'P2013 -ORIG REPORT NOT IN DUTAS - CANNOT AMEND' CL212 +01649 W-RPT-TYPE CL212 +01650 DELIMITED BY SIZE CL212 +01651 INTO R140-MESSAGE CL212 +01652 END-STRING CL212 +01653 PERFORM S946-WRITE-R140 THRU S946-EXIT CL212 +01654 SET W-EMP-FOUND-NO-88 TO TRUE CL212 +01655 ELSE CL212 +01656 DISPLAY 'X430 RPT FOUND ON DUTAS- PROCESS AMEND ' CL212 +01657 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO CL212 +01658 SET W-RPT-ERROR-NO-88 TO TRUE CL212 +01659 MOVE SPACES TO R140-MESSAGE CL212 +01660 MOVE W-EMP-NO TO R140-EMP-NO CL212 +01661 STRING CL212 +01662 'P2013 -ORIG REPORT IN DUTAS - PROCESS AMEND' CL212 +01663 W-RPT-TYPE CL212 +01664 DELIMITED BY SIZE CL212 +01665 INTO R140-MESSAGE CL212 +01666 END-STRING CL212 +01667 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL212 +01668 CL212 +01669 P2013-EXIT. CL212 +01670 EXIT. CL212 +01671 CL212 +01672 CL212 +01673 P2113-CHECK-MRPT. CL212 +01674 DISPLAY 'P2013 X140 X140 REPORT FROM ESSP- ' CL187 +01675 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL183 +01676 DISPLAY ' ' CL183 +01677 MOVE LOW-VALUE TO MRPT-KEY-AREA. CL210 +01678 MOVE W-EMP-NO TO MRPT-EMP-NO. CL210 +01679 SET MRPT-RPT-88 TO TRUE. CL210 +01680 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL210 +01681 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL210 +01682 CL210 +01683 PERFORM S910-START-BROWSE THRU S910-EXIT. CL210 +01684 IF L910-OK-88 CL210 +01685 PERFORM P2116-SCAN-MRPT THRU P2116-EXIT CL212 +01686 UNTIL L910-NO-REC-88 CL210 +01687 ELSE CL210 +01688 DISPLAY 'X451 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL210 +01689 W-EMP-NO ' ' W-X140-REPORT-QTR CL210 +01690 DISPLAY ' ' CL210 +01691 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01692 MOVE SPACES TO R140-MESSAGE CL*35 +01693 MOVE W-EMP-NO TO R140-EMP-NO CL*35 +01694 STRING CL*35 +01695 'P2013 -ORIG REPORT NOT IN DUTAS CANNOT AMEND ' CL210 +01696 W-RPT-TYPE CL*35 +01697 DELIMITED BY SIZE CL*35 +01698 INTO R140-MESSAGE CL*35 +01699 END-STRING CL*35 +01700 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*35 +01701 SET W-EMP-FOUND-NO-88 TO TRUE CL*35 +01702 GO TO P2113-EXIT. CL212 +01703 CL*35 +01704 P2113-EXIT. CL212 +01705 EXIT. CL**2 +01706 P2116-SCAN-MRPT. CL212 +01707 MOVE MSKL-REC TO MRPT-REC. CL210 +01708 IF MRPT-YRQ = W-X140-REPORT-QTR CL210 +01709 NEXT SENTENCE CL210 +01710 ELSE CL210 +01711 IF MRPT-YRQ > W-X140-REPORT-QTR CL210 +01712 SET W-RPT-ERROR-YES-88 TO TRUE CL210 +01713 SET L910-NO-REC-88 TO TRUE CL210 +01714 GO TO P2116-EXIT CL212 +01715 ELSE CL210 +01716 GO TO P2116-READ-NEXT CL212 +01717 END-IF CL210 +01718 END-IF. CL210 +01719 CL210 +01720 IF MRPT-ESTIM-88 OR MRPT-WITHDRW-88 CL212 +01721 GO TO P2116-READ-NEXT CL212 +01722 ELSE CL212 +01723 SET W-RPT-ERROR-NO-88 TO TRUE CL212 +01724 SET L910-NO-REC-88 TO TRUE CL212 +01725 MOVE SPACES TO R140-MESSAGE CL212 +01726 MOVE W-EMP-NO TO R140-EMP-NO CL212 +01727 STRING CL212 +01728 ':ORIGINAL RPT EXIST IN DUTAS -CONVERT EMP COUNTS' CL212 +01729 X140-QUARTER CL212 +01730 DELIMITED BY SIZE CL212 +01731 INTO R140-MESSAGE CL212 +01732 END-STRING CL212 +01733 MOVE R140-MESSAGE TO P434-MESSAGE CL212 +01734 PERFORM S946-WRITE-R140 THRU S946-EXIT CL212 +01735 GO TO P2116-EXIT CL212 +01736 END-IF. CL210 +01737 CL210 +01738 P2116-READ-NEXT. CL212 +01739 PERFORM S910-READ-NEXT THRU S910-EXIT. CL210 +01740 IF L910-NO-REC-88 CL210 +01741 SET W-EMP-FOUND-NO-88 TO TRUE CL210 +01742 SET W-RPT-ERROR-YES-88 TO TRUE. CL210 +01743 P2116-EXIT. EXIT. CL212 +01744 CL210 +01745 CL**3 +01746 P2020-SAVE-EXT-REPORT. DTSBX551 +01747 * DISPLAY 'P2020-SAVE-EXT-REPORT ' CL161 +01748 ************************************************************ DTSBX551 +01749 * DUE TO CONVERSION ERROR CHECK IS MADE WHEN EMPLOYEE COUNT CL212 +01750 * IS = ALL 9. GET ORIGINAL REPORT AND MOVE EMPLOYEE COINT CL212 +01751 * TO AMEND REPORT COUNTS ZL1 9/06/15 CL212 +01752 ************************************************************ DTSBX551 +01753 IF W-1ST-MNTH-CNT = 9999999 OR CL212 +01754 W-2ND-MNTH-CNT = 9999999 OR CL212 +01755 W-3RD-MNTH-CNT = 9999999 CL212 +01756 PERFORM P2113-CHECK-MRPT THRU P2113-EXIT CL212 +01757 IF W-RPT-ERROR-YES-88 CL212 +01758 MOVE SPACES TO R140-MESSAGE CL212 +01759 DISPLAY CL213 +01760 'P2013 -FATAL ERROR REPORT NOT ON MRPT AMEND ' CL212 +01761 W-RPT-TYPE CL212 +01762 PERFORM S999-ABEND THRU S999-EXIT CL212 +01763 ELSE CL212 +01764 MOVE MRPT-1ST-MTH-EMPL-CNT TO W-1ST-MNTH-CNT CL212 +01765 MOVE MRPT-2ND-MTH-EMPL-CNT TO W-2ND-MNTH-CNT CL212 +01766 MOVE MRPT-3RD-MTH-EMPL-CNT TO W-3RD-MNTH-CNT CL212 +01767 MOVE MRPT-TOTAL-EMPL-CNT TO W-WRKR-CNT-TOTAL. CL212 +01768 CL212 +01769 CL212 +01770 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBX551 +01771 MOVE '028' TO T028-REC-TYPE. DTSBX551 +01772 DTSBX551 +01773 MOVE W-EMP-NO TO T028-EMP-NO. DTSBX551 +01774 MOVE 'WEB ESSP' TO T028-ORIGIN. DTSBX551 +01775 MOVE LX42-SYS-DATE TO T028-SYS-DATE. DTSBX551 +01776 MOVE LX42-SYS-TIME TO T028-SYS-TIME. DTSBX551 +01777 SET T028-WEB-RPT-88 TO TRUE. DTSBX551 +01778 DTSBX551 +01779 MOVE LX42-EXT-PSEUDO-BATCH TO T028-PSEUDO-BATCH-NO. DTSBX551 +01780 MOVE LX42-EXT-PSEUDO-ITEM TO T028-PSEUDO-ITEM-NO. DTSBX551 +01781 DTSBX551 +01782 MOVE W-X140-REPORT-QTR TO T028-YRQ. CL*56 +01783 IF W-EMP-FOUND-YES-88 DTSBX551 +01784 MOVE MPRF-PRIMARY-NAME (1:4) DTSBX551 +01785 TO T028-NAME-CHECK DTSBX551 +01786 ELSE DTSBX551 +01787 MOVE SPACES TO T028-NAME-CHECK DTSBX551 +01788 END-IF. DTSBX551 +01789 MOVE W-RPT-TYPE TO T028-RPT-TYPE. DTSBX551 +01790 DTSBX551 +01791 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBX551 +01792 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBX551 +01793 MOVE W-X140-RECEIVED-DATE TO T028-RECEIVED-DATE. CL189 +01794 MOVE ZEROS TO T028-DEPOSIT-DATE. CL189 +01795 DTSBX551 +01796 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSBX551 +01797 DTSBX551 +01798 IF W-EMP-FOUND-NO-88 DTSBX551 +01799 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX551 +01800 MOVE W-EXX-WAGE TO T028-EXCESS-WAGE CL222 +01801 * COMPUTE T028-EXCESS-WAGE = CL222 +01802 * (T028-TOT-WAGE - T028-TAX-WAGE) CL222 +01803 ELSE DTSBX551 +01804 IF MPRF-CLASS-SELF-INS-88 DTSBX551 +01805 MOVE ZERO TO T028-TAX-WAGE DTSBX551 +01806 T028-EXCESS-WAGE DTSBX551 +01807 ELSE DTSBX551 +01808 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX551 +01809 MOVE W-EXX-WAGE TO T028-EXCESS-WAGE CL222 +01810 * COMPUTE T028-EXCESS-WAGE = CL222 +01811 * (T028-TOT-WAGE - T028-TAX-WAGE) CL222 +01812 END-IF DTSBX551 +01813 END-IF. DTSBX551 +01814 DTSBX551 +01815 MOVE W-1ST-MNTH-CNT TO T028-1ST-MTH-EMPL-CNT. CL156 +01816 MOVE W-2ND-MNTH-CNT TO T028-2ND-MTH-EMPL-CNT. CL156 +01817 MOVE W-3RD-MNTH-CNT TO T028-3RD-MTH-EMPL-CNT. CL156 +01818 MOVE W-1ST-MNTH-CNT TO T028-TOTAL-EMPL-CNT CL221 +01819 CL221 +01820 IF W-2ND-MNTH-CNT > T028-TOTAL-EMPL-CNT CL221 +01821 MOVE W-2ND-MNTH-CNT TO T028-TOTAL-EMPL-CNT. CL221 +01822 DTSBX551 +01823 IF W-3RD-MNTH-CNT > T028-TOTAL-EMPL-CNT CL221 +01824 MOVE W-3RD-MNTH-CNT TO T028-TOTAL-EMPL-CNT. CL221 +01825 CL221 +01826 * DISPLAY ' X145 PAY AMT ' X145-REMITTANCE CL156 +01827 * DISPLAY ' X140 PAY AMT ' X140-REMITTANCE CL156 +01828 CL108 +01829 MOVE W-X145-TOT-REMIT-AMT TO W-X140-REMITTANCE CL108 +01830 MOVE ZEROS TO T028-REMIT-AMT. CL170 +01831 DTSBX551 +01832 * ADD W-X145-TOT-REMIT-AMT TO W-TOT-REMIT-AMT. CL170 +01833 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBX551 +01834 DTSBX551 +01835 MOVE ZERO TO T028-TRACE-NO. CL193 +01836 DTSBX551 +01837 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBX551 +01838 MOVE 'WEBESSP ' TO T028-RESPONSIBLE-OP-ID. DTSBX551 +01839 DTSBX551 +01840 * DISPLAY 'BX436 WEB RPT ' X140-EMP-NO ' ' X140-QUARTER. CL168 +01841 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSBX551 +01842 DTSBX551 +01843 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. CL124 +01844 CL124 +01845 DISPLAY W-EMP-NO ',' T028-TOT-WAGE CL223 +01846 ',' T028-EXCESS-WAGE CL223 +01847 ',' T028-TAX-WAGE. CL223 +01848 * ',' X140-REMITTANCE CL124 +01849 * ',' X145-REMITTANCE. CL124 +01850 CL110 +01851 IF W-X140-REMITTANCE > 0 CL100 +01852 ADD 1 TO W-T028-WRITE-CNT CL100 +01853 ELSE CL100 +01854 ADD 1 TO W-T028-WRITE-CNT CL100 +01855 ADD 1 TO W-T028-WRITEO-CNT. CL100 +01856 CL100 +01857 * IF W-WRITE-T025-TRAN-YES-88 CL108 +01858 * PERFORM P2021-WRITE-T025 THRU P2021-EXIT CL108 +01859 * ELSE CL108 +01860 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01861 MOVE SPACES TO R140-MESSAGE CL*71 +01862 MOVE W-EMP-NO TO R140-EMP-NO CL*71 +01863 STRING CL*71 +01864 'X451 -:>AMENDED REPORT ADDED TO DUTAS - ' X140-QUARTER CL206 +01865 DELIMITED BY SIZE CL*71 +01866 INTO R140-MESSAGE CL*71 +01867 END-STRING CL*71 +01868 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71 +01869 P2020-EXIT. DTSBX551 +01870 EXIT. DTSBX551 +01871 DTSBX551 +01872 P2021-WRITE-T025. CL*71 +01873 ** CL*73 +01874 **PAYMENT TRANSACTION REMIT AMT > THAN REPORT REMIT AMT, SUBTRACT CL*73 +01875 **DIFFERENCE AND WRITE A PA T025 TRANSACTION. CL*73 +01876 ** CL*73 +01877 DISPLAY 'PAYMENT OK ' X145-EMP-NO. CL*71 +01878 CL*71 +01879 MOVE LENGTH OF T025-REC TO T025-LENGTH CL*71 +01880 MOVE '025' TO T025-REC-TYPE. CL*71 +01881 CL*71 +01882 MOVE W-EMP-NO TO T025-EMP-NO. CL*71 +01883 MOVE 'WEB PAY' TO T025-ORIGIN. CL*71 +01884 MOVE LX42-SYS-DATE TO T025-SYS-DATE. CL*71 +01885 MOVE LX42-SYS-TIME TO T025-SYS-TIME. CL*71 +01886 * CL*71 +01887 MOVE W-X145-PAYMENT-QTR TO T025-APPLIC-YRQ CL190 +01888 MOVE 'PA' TO T025-PAY-TYPE CL189 +01889 CL*71 +01890 MOVE SPACES TO T025-APPLIC-IND. CL*71 +01891 MOVE ZERO TO T025-APPLIC-BATCH-NO CL*71 +01892 T025-APPLIC-ITEM-NO. CL*71 +01893 CL*71 +01894 IF W-EMP-FOUND-YES-88 CL*71 +01895 MOVE MPRF-PRIMARY-NAME (1:4) CL*71 +01896 TO T025-NAME-CHECK CL*71 +01897 ELSE CL*71 +01898 MOVE SPACES TO T025-NAME-CHECK CL*71 +01899 END-IF. CL*71 +01900 CL*71 +01901 MOVE W-X145-RECEIVED-DATE TO T025-RECEIVED-DATE CL*72 +01902 T025-DEPOSIT-DATE. CL*71 +01903 CL*71 +01904 MOVE W-X145-TOT-REMIT-AMT TO W-T025-REMIT-AMT CL170 +01905 CL*71 +01906 MOVE W-T025-REMIT-AMT TO T025-REMIT-AMT. CL*71 +01907 CL*71 +01908 CL189 +01909 IF X145-TRACE-NO > SPACES CL191 +01910 MOVE X145-TRACE-NO TO T025-TRACE-NO CL192 +01911 ELSE CL189 +01912 MOVE ZEROS TO T025-TRACE-NO. CL189 +01913 CL*71 +01914 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*71 +01915 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL*71 +01916 CL*71 +01917 * MOVE T025-REC TO TSKL-REC. CL*71 +01918 * PERFORM S927B-WRITE THRU S927B-EXIT. CL*71 +01919 CL*71 +01920 PERFORM S1033-WRITE-TEMP-T025 THRU S1033-EXIT. CL*71 +01921 ADD +1 TO W-T025-WRITE-CNT. CL*71 +01922 CL*71 +01923 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. CL177 +01924 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL203 +01925 MOVE ZEROS TO W-T025-REMIT-AMT CL*72 +01926 W-X145-TOT-REMIT-AMT CL*72 +01927 W-X140-REMITTANCE. CL*72 +01928 CL*72 +01929 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*72 +01930 CL*71 +01931 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01932 MOVE SPACES TO R140-MESSAGE CL*71 +01933 MOVE W-EMP-NO TO R140-EMP-NO CL*71 +01934 STRING CL*71 +01935 'X430 -: >>>>> PAYMENT T025 CREATED ' CL170 +01936 'REMIT AMT' CL*93 +01937 DELIMITED BY SIZE CL*71 +01938 INTO R140-MESSAGE CL*71 +01939 END-STRING CL*71 +01940 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71 +01941 P2021-EXIT. CL*71 +01942 EXIT. CL*71 +01943 CL*71 +01944 DTSBX551 +01945 P3000-WAGES. DTSBX551 +01946 MOVE LX42-DATA-AREA TO X144-REC. DTSBX551 +01947 * DISPLAY 'X144: ' X144-REC. CL161 +01948 MOVE X144-EMP-NO TO W-EMP-NO. CL*38 +01949 * CL**4 +01950 ADD +1 TO W-X144-RED-CNT CL*96 +01951 SET W-RPT-ERROR-NO-88 TO TRUE. CL147 +01952 * SET W-PREV-REC-WAGE-88 TO TRUE. CL*83 +01953 * CL**4 +01954 * DISPLAY 'LX-E ' LX42-X140-EMP-NO ' X145-E ' W-EMP-NO. CL*97 +01955 * IF LX42-X145-EMP-NO = '999999' OR CL170 +01956 * LX42-X140-EMP-NO = '999999' OR CL170 +01957 * LX42-X145-EMP-NO = SPACES OR CL170 +01958 * LX42-X140-EMP-NO = SPACES OR CL170 +01959 * W-PREV-RPT-NULL-88 CL170 +01960 * SET W-RPT-ERROR-YES-88 TO TRUE CL170 +01961 * MOVE SPACES TO R140-MESSAGE CL170 +01962 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01963 * STRING CL170 +01964 * 'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES ' CL170 +01965 * ' ' X144-QUARTER CL170 +01966 * DELIMITED BY SIZE CL170 +01967 * INTO R140-MESSAGE CL170 +01968 * END-STRING CL170 +01969 * WRITE PEND-X144-REC FROM X144-REC CL170 +01970 * ADD +1 TO W-X144-ERR-CNT CL170 +01971 * ADD +1 TO W-X144-PEN-CNT CL170 +01972 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL117 +01973 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*83 +01974 * GO TO P3000-EXIT. CL170 +01975 CL*36 +01976 * CL**4 +01977 * IF W-PREV-RPT-RPT-88 CL170 +01978 * OR W-PREV-RPT-WAGE-88 CL170 +01979 * SET W-PREV-RPT-WAGE-88 TO TRUE CL170 +01980 ADD +1 TO W-X144-PRO-CNT CL*56 +01981 PERFORM P3010-EDIT-WAGES THRU P3010-EXIT DTSBX551 +01982 IF W-RPT-ERROR-NO-88 CL*81 +01983 PERFORM P3011-WRITE-WAGES-X144 THRU P3011-EXIT DTSBX551 +01984 ADD +1 TO W-X144-SAV-CNT CL*96 +01985 ELSE CL*36 +01986 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01987 MOVE SPACES TO R140-MESSAGE CL*36 +01988 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +01989 STRING CL*36 +01990 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' CL*47 +01991 ' ' X144-SSN CL*36 +01992 DELIMITED BY SIZE CL*36 +01993 INTO R140-MESSAGE CL*36 +01994 END-STRING CL*36 +01995 ADD +1 TO W-X144-ERR-CNT CL*93 +01996 ADD +1 TO W-X144-PEN-CNT CL*96 +01997 WRITE PEND-X144-REC FROM X144-REC CL*93 +01998 PERFORM P6000-WRITE-PEND-X144 THRU P6000-EXIT CL144 +01999 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +02000 GO TO P3000-EXIT. CL170 +02001 * ELSE CL170 +02002 * SET W-RPT-ERROR-YES-88 TO TRUE CL170 +02003 * MOVE SPACES TO R140-MESSAGE CL170 +02004 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +02005 * STRING CL170 +02006 * 'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING ' CL170 +02007 * ' ' X144-SSN CL170 +02008 * DELIMITED BY SIZE CL170 +02009 * INTO R140-MESSAGE CL170 +02010 * END-STRING CL170 +02011 * WRITE PEND-X144-REC FROM X144-REC CL170 +02012 * ADD +1 TO W-X144-ERR-CNT CL170 +02013 * ADD +1 TO W-X144-PEN-CNT CL170 +02014 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL*93 +02015 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +02016 * END-IF. CL170 +02017 DTSBX551 +02018 P3000-EXIT. DTSBX551 +02019 EXIT. DTSBX551 +02020 DTSBX551 +02021 P3010-EDIT-WAGES. DTSBX551 +02022 * DISPLAY 'P3010-EDIT-WAGES ' CL*97 +02023 * DISPLAY 'X144-QUARTER ' X144-QUARTER CL*36 +02024 MOVE X144-QUARTER TO W-SLASH-QTR. DTSBX551 +02025 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX551 +02026 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX551 +02027 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX551 +02028 IF NOT L004-VALID-QTR DTSBX551 +02029 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02030 MOVE SPACES TO R140-MESSAGE DTSBX551 +02031 MOVE W-EMP-NO TO R140-EMP-NO DTSBX551 +02032 STRING DTSBX551 +02033 ': WAGE RECORD HAS INVALID QUARTER ' CL144 +02034 X144-QUARTER ' ' X144-SSN CL*36 +02035 DELIMITED BY SIZE DTSBX551 +02036 INTO R140-MESSAGE DTSBX551 +02037 END-STRING DTSBX551 +02038 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02039 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX551 +02040 ELSE CL*13 +02041 MOVE L004-QTR-5-9 TO W-X144-WAGE-QTR CL*53 +02042 END-IF. DTSBX551 +02043 CL*15 +02044 * IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR CL164 +02045 * SET W-RPT-ERROR-YES-88 TO TRUE CL164 +02046 * MOVE SPACES TO R140-MESSAGE CL164 +02047 * MOVE W-EMP-NO TO R140-EMP-NO CL164 +02048 * MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR CL164 +02049 * STRING CL164 +02050 * ':WAGE QTR NOT = RPT QTR ' CL164 +02051 * X144-QUARTER ' ' WRK-REPORT-QTR CL164 +02052 * DELIMITED BY SIZE CL164 +02053 * INTO R140-MESSAGE CL164 +02054 * END-STRING CL164 +02055 * MOVE R140-MESSAGE TO P434-MESSAGE CL164 +02056 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL164 +02057 * END-IF. CL164 +02058 DTSBX551 +02059 IF X144-SSN NOT NUMERIC DTSBX551 +02060 * DISPLAY 'X144-SSN ' X144-SSN CL*36 +02061 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02062 MOVE SPACES TO R140-MESSAGE DTSBX551 +02063 MOVE W-EMP-NO TO R140-EMP-NO DTSBX551 +02064 STRING DTSBX551 +02065 ':WAGE RECORD NON-NUMERIC SSN ' CL144 +02066 X144-SSN DTSBX551 +02067 DELIMITED BY SIZE DTSBX551 +02068 INTO R140-MESSAGE DTSBX551 +02069 END-STRING DTSBX551 +02070 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02071 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX551 +02072 ELSE DTSBX551 +02073 MOVE X144-SSN TO W-SSN DTSBX551 +02074 END-IF. DTSBX551 +02075 DTSBX551 +02076 IF X144-SSN = ZEROS CL*53 +02077 * DISPLAY 'X144-SSN ' X144-SSN CL*53 +02078 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02079 MOVE SPACES TO R140-MESSAGE CL*53 +02080 MOVE W-EMP-NO TO R140-EMP-NO CL*53 +02081 STRING CL*53 +02082 ':WAGE RECORD SSN = ZEROS ' CL144 +02083 X144-SSN CL*53 +02084 DELIMITED BY SIZE CL*53 +02085 INTO R140-MESSAGE CL*53 +02086 END-STRING CL*53 +02087 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02088 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*53 +02089 ELSE CL*53 +02090 MOVE X144-SSN TO W-SSN CL*53 +02091 END-IF. CL*53 +02092 CL*53 +02093 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME CL161 +02094 * ' FN: ' X144-FIRST-NAME. CL161 +02095 * IF X144-LAST-NAME = SPACES CL214 +02096 * SET W-RPT-ERROR-YES-88 TO TRUE CL164 +02097 * MOVE SPACES TO R140-MESSAGE CL214 +02098 * MOVE W-EMP-NO TO R140-EMP-NO CL214 +02099 * STRING CL214 +02100 * ':WARNING-SSN LNAME IS BLANK ' CL214 +02101 * X144-SSN CL214 +02102 * DELIMITED BY SIZE CL214 +02103 * INTO R140-MESSAGE CL214 +02104 * END-STRING CL214 +02105 * MOVE R140-MESSAGE TO P434-MESSAGE CL214 +02106 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL214 +02107 * END-IF. CL214 +02108 CL*36 +02109 * IF X144-FIRST-NAME = SPACES CL214 +02110 * SET W-RPT-ERROR-YES-88 TO TRUE CL164 +02111 * MOVE SPACES TO R140-MESSAGE CL214 +02112 * MOVE W-EMP-NO TO R140-EMP-NO CL214 +02113 * STRING CL214 +02114 * ':WARNING - SSN FNAME IS BLANK ' CL214 +02115 * X144-SSN CL214 +02116 * DELIMITED BY SIZE CL214 +02117 * INTO R140-MESSAGE CL214 +02118 * END-STRING CL214 +02119 * MOVE R140-MESSAGE TO P434-MESSAGE CL214 +02120 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL214 +02121 * END-IF. CL214 +02122 CL*36 +02123 * IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR DTSBX551 +02124 * MOVE ZERO TO W-WRKR-TOT-WAGE DTSBX551 +02125 * MOVE W-WAGE-QTR TO W-CURR-WAGE-QTR DTSBX551 +02126 * END-IF. DTSBX551 +02127 DTSBX551 +02128 * MOVE X144-EARNINGS TO W-EARNINGS-X. DTSBX551 +02129 * MOVE W-EARNINGS-9 TO W-EARNINGS. DTSBX551 +02130 * ADD W-EARNINGS TO W-WRKR-TOT-WAGE. DTSBX551 +02131 * DISPLAY 'X144-LAST-NAME ' X144-LAST-NAME DTSBX551 +02132 * MOVE X144-LAST-NAME TO W-WRKR-LAST-NAME. DTSBX551 +02133 * MOVE X144-FIRST-NAME TO W-WRKR-FIRST-NAME. DTSBX551 +02134 * MOVE X144-MID-INIT TO W-WRKR-MID-INIT. DTSBX551 +02135 DTSBX551 +02136 P3010-EXIT. DTSBX551 +02137 EXIT. DTSBX551 +02138 DTSBX551 +02139 P3011-WRITE-WAGES-X144. DTSBX551 +02140 DTSBX551 +02141 ************************************************************** CL*11 +02142 * WRITE W4 WAGES FOR DOCS CL*11 +02143 ************************************************************** CL*11 +02144 * CL*11 +02145 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. CL*11 +02146 MOVE X144-SSN TO W4-SSN. CL*11 +02147 MOVE 'W4' TO W4-TRAN-ID. CL*11 +02148 MOVE '00044001' TO W4-TRAN-OPER-ID. CL*11 +02149 MOVE LX42-CURR-RUN-DATE TO W4-DATE-ENTERED. CL218 +02150 MOVE ZEROS TO W4-TIME-ENTERED. CL*11 +02151 MOVE X144-LAST-NAME (1:3) TO W4-NAME-CHECK. CL*11 +02152 MOVE W-X144-WAGE-QTR TO W4-QUARTER. CL118 +02153 MOVE X144-EARNINGS TO W4-QUARTER-EARNINGS. CL*11 +02154 MOVE 2 TO W4-AFFI-CODE. CL*11 +02155 MOVE X144-EMP-NO TO W4-ACCOUNT. CL*11 +02156 MOVE MPRF-PRIMARY-NAME (1:4) TO W4-EMP-NAME. CL*11 +02157 CL*11 +02158 * MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. CL*20 +02159 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +02160 CL*11 +02161 * WRITE WAGE-TRANS-REC. CL*20 +02162 WRITE WAGE-OUT-REC. CL*20 +02163 CL*11 +02164 IF WAGE-TEMP-STATUS-OK-88 CL*32 +02165 ADD +1 TO W-W4-CNT CL*11 +02166 * DISPLAY 'WRITE W4 ' W4-ACCOUNT ' ' W4-QUARTER CL*36 +02167 * ' ' W4-SSN CL*36 +02168 ELSE CL*11 +02169 DISPLAY 'ERROR WRITING W4- WAGE FILE ' CL*36 +02170 WAGE-TEMP-STATUS CL*32 +02171 END-IF. CL*11 +02172 CL*11 +02173 CL*11 +02174 P3011-EXIT. CL*25 +02175 EXIT. DTSBX551 +02176 CL207 +02177 P3500-WAGES. CL207 +02178 MOVE LX42-DATA-AREA TO X147-REC. CL207 +02179 * DISPLAY 'X144: ' X144-REC. CL207 +02180 MOVE X147-EMP-NO TO W-EMP-NO. CL207 +02181 * CL207 +02182 ADD +1 TO W-X147-RED-CNT CL207 +02183 SET W-RPT-ERROR-NO-88 TO TRUE. CL207 +02184 CL207 +02185 ADD +1 TO W-X147-PRO-CNT CL207 +02186 PERFORM P3510-EDIT-WAGES THRU P3510-EXIT CL207 +02187 IF W-RPT-ERROR-NO-88 CL207 +02188 PERFORM P3511-WRITE-WAGES-X147 THRU P3511-EXIT CL207 +02189 ADD +1 TO W-X147-SAV-CNT CL207 +02190 ELSE CL207 +02191 SET W-RPT-ERROR-YES-88 TO TRUE CL207 +02192 MOVE SPACES TO R140-MESSAGE CL207 +02193 MOVE W-EMP-NO TO R140-EMP-NO CL207 +02194 STRING CL207 +02195 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' CL207 +02196 ' ' X147-SSN CL207 +02197 DELIMITED BY SIZE CL207 +02198 INTO R140-MESSAGE CL207 +02199 END-STRING CL207 +02200 ADD +1 TO W-X147-ERR-CNT CL207 +02201 ADD +1 TO W-X147-PEN-CNT CL207 +02202 WRITE PEND-X147-REC FROM X147-REC CL208 +02203 PERFORM P7000-WRITE-PEND-X147 THRU P7000-EXIT CL208 +02204 PERFORM S946-WRITE-R140 THRU S946-EXIT CL207 +02205 GO TO P3500-EXIT. CL207 +02206 CL207 +02207 P3500-EXIT. CL207 +02208 EXIT. CL207 +02209 CL207 +02210 P3510-EDIT-WAGES. CL207 +02211 * DISPLAY 'P3010-EDIT-WAGES ' CL207 +02212 * DISPLAY 'X144-QUARTER ' X144-QUARTER CL207 +02213 MOVE X147-QUARTER TO W-SLASH-QTR. CL208 +02214 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. CL207 +02215 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. CL207 +02216 PERFORM S004-FROM-5 THRU S004-EXIT. CL207 +02217 IF NOT L004-VALID-QTR CL207 +02218 SET W-RPT-ERROR-YES-88 TO TRUE CL207 +02219 MOVE SPACES TO R140-MESSAGE CL207 +02220 MOVE W-EMP-NO TO R140-EMP-NO CL207 +02221 STRING CL207 +02222 ': WAGE RECORD HAS INVALID QUARTER ' CL207 +02223 X147-QUARTER ' ' X147-SSN CL208 +02224 DELIMITED BY SIZE CL207 +02225 INTO R140-MESSAGE CL207 +02226 END-STRING CL207 +02227 MOVE R140-MESSAGE TO P434-MESSAGE CL207 +02228 PERFORM S946-WRITE-R140 THRU S946-EXIT CL207 +02229 ELSE CL207 +02230 MOVE L004-QTR-5-9 TO W-X147-WAGE-QTR CL208 +02231 END-IF. CL207 +02232 CL207 +02233 CL207 +02234 IF X147-SSN NOT NUMERIC CL208 +02235 * DISPLAY 'X144-SSN ' X144-SSN CL207 +02236 SET W-RPT-ERROR-YES-88 TO TRUE CL207 +02237 MOVE SPACES TO R140-MESSAGE CL207 +02238 MOVE W-EMP-NO TO R140-EMP-NO CL207 +02239 STRING CL207 +02240 ':WAGE RECORD NON-NUMERIC SSN ' CL207 +02241 X147-SSN CL208 +02242 DELIMITED BY SIZE CL207 +02243 INTO R140-MESSAGE CL207 +02244 END-STRING CL207 +02245 MOVE R140-MESSAGE TO P434-MESSAGE CL207 +02246 PERFORM S946-WRITE-R140 THRU S946-EXIT CL207 +02247 ELSE CL207 +02248 MOVE X147-SSN TO W-SSN CL208 +02249 END-IF. CL207 +02250 CL207 +02251 IF X147-SSN = ZEROS CL208 +02252 * DISPLAY 'X147-SSN ' X147-SSN CL208 +02253 SET W-RPT-ERROR-YES-88 TO TRUE CL207 +02254 MOVE SPACES TO R140-MESSAGE CL207 +02255 MOVE W-EMP-NO TO R140-EMP-NO CL207 +02256 STRING CL207 +02257 ':WAGE RECORD SSN = ZEROS ' CL207 +02258 X147-SSN CL208 +02259 DELIMITED BY SIZE CL207 +02260 INTO R140-MESSAGE CL207 +02261 END-STRING CL207 +02262 MOVE R140-MESSAGE TO P434-MESSAGE CL207 +02263 PERFORM S946-WRITE-R140 THRU S946-EXIT CL207 +02264 ELSE CL207 +02265 MOVE X147-SSN TO W-SSN CL208 +02266 END-IF. CL207 +02267 CL207 +02268 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME CL207 +02269 * ' FN: ' X144-FIRST-NAME. CL207 +02270 CL207 +02271 P3510-EXIT. CL207 +02272 EXIT. CL207 +02273 CL207 +02274 P3511-WRITE-WAGES-X147. CL207 +02275 CL207 +02276 ************************************************************** CL207 +02277 * WRITE W2 WAGES FOR DOCS CL207 +02278 ************************************************************** CL207 +02279 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. CL207 +02280 MOVE X147-SSN TO W2-SSN. CL207 +02281 MOVE 'W2' TO W2-TRAN-ID. CL207 +02282 MOVE '00044001' TO W2-OPER-ID. CL209 +02283 MOVE LX42-CURR-RUN-DATE TO W2-DATE-ENTERED. CL218 +02284 MOVE ZEROS TO W2-TIME-ENTERED. CL207 +02285 MOVE 3 TO W2-OP-CAUSE. CL209 +02286 MOVE SPACES TO W2-NAME. CL209 +02287 MOVE W-X147-WAGE-QTR TO W2-QTR. CL217 +02288 MOVE X147-EMP-NO TO W2-ACCOUNT-NUMBER CL209 +02289 CL207 +02290 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL208 +02291 CL207 +02292 WRITE WAGE-OUT-REC. CL207 +02293 CL207 +02294 IF WAGE-TEMP-STATUS-OK-88 CL207 +02295 ADD +1 TO W-W2-CNT CL207 +02296 * DISPLAY 'WRITE W2 ' W4-ACCOUNT ' ' W2-QUARTER CL207 +02297 * ' ' W2-SSN CL207 +02298 ELSE CL207 +02299 DISPLAY 'ERROR WRITING W2- WAGE FILE ' CL207 +02300 WAGE-TEMP-STATUS CL207 +02301 END-IF. CL207 +02302 CL207 +02303 CL207 +02304 P3511-EXIT. CL207 +02305 EXIT. CL207 +02306 P4000-WRITE-X434-PAID-REPT. CL119 +02307 CL119 +02308 MOVE X140-EMP-NO TO X434-EMP-NO CL119 +02309 MOVE X140-QUARTER TO X434-QTR CL125 +02310 * IF W-EMP-FOUND-YES-88 CL174 +02311 * MOVE MPRF-PRIMARY-NAME (1:15) CL174 +02312 * TO X434-NAME-CHECK CL174 +02313 * ELSE CL174 +02314 MOVE 'RPT' TO X434-NAME-CHECK CL174 +02315 * END-IF. CL174 +02316 CL119 +02317 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL121 +02318 MOVE T028-TOT-WAGE TO X434-TOT-WAGE CL119 +02319 MOVE T028-EXCESS-WAGE TO X434-EXC-WAGE CL119 +02320 MOVE T028-TAX-WAGE TO X434-TAX-WAGE CL119 +02321 MOVE X140-REMITTANCE TO X434-X140-REMIT CL119 +02322 WS-X140-REMITTANCE CL149 +02323 MOVE W-X140-REMITTANCE TO X434-X145-REMIT CL119 +02324 CL148 +02325 COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL149 +02326 WS-X140-REMITTANCE. CL149 +02327 CL149 +02328 MOVE W-T025-REMIT-AMT TO X434-DIFF. CL149 +02329 ADD W-T025-REMIT-AMT TO WS-T025-REMIT-AMT. CL174 +02330 CL148 +02331 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL121 +02332 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL125 +02333 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL125 +02334 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL125 +02335 CL119 +02336 * IF W-ERROR-NO-88 CL120 +02337 * MOVE 'PROCESSED' TO X434-DISPOSITION CL120 +02338 * ELSE CL120 +02339 * MOVE 'PENDING ' TO X434-DISPOSITION. CL120 +02340 * MOVE R140-MESSAGE TO X434-MESSAGE CL120 +02341 CL119 +02342 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL121 +02343 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. CL120 +02344 ADD 1 TO WS-LINE-CNT2. CL119 +02345 ADD +1 TO WS-NUMBER-ONE. CL119 +02346 CL119 +02347 CL119 +02348 P4000-EXIT. CL119 +02349 EXIT. CL119 +02350 P4100-PRINT-HEADER. CL121 +02351 IF WS-LINE-CNT GREATER 58 OR CL121 +02352 WS-LINE-CNT2 GREATER 58 CL121 +02353 MOVE +0 TO WS-LINE-CNT CL121 +02354 MOVE +0 TO WS-LINE-CNT2 CL121 +02355 ADD +1 TO WS-PAGE-CNT CL121 +02356 MOVE WS-PAGE-CNT TO HDR3-PAGE CL121 +02357 MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME CL156 +02358 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL122 +02359 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL122 +02360 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL122 +02361 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL122 +02362 WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL153 +02363 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL122 +02364 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL122 +02365 ADD +6 TO WS-LINE-CNT2. CL121 +02366 P4100-EXIT. CL121 +02367 EXIT. CL121 +02368 CL121 +02369 P4200-PRINT-HEADER. CL133 +02370 IF WSP-LINE-CNT GREATER 58 OR CL133 +02371 WSP-LINE-CNT2 GREATER 58 CL133 +02372 MOVE +0 TO WSP-LINE-CNT CL133 +02373 MOVE +0 TO WSP-LINE-CNT2 CL133 +02374 ADD +1 TO WSP-PAGE-CNT CL133 +02375 MOVE WSP-PAGE-CNT TO HDR31-PAGE CL133 +02376 MOVE ' * REASON FOR PENDING *' TO HDR5-NAME CL138 +02377 WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL133 +02378 WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1 CL133 +02379 WRITE REPT-PEND-REC FROM HEADER-31 AFTER 1 CL133 +02380 WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1 CL133 +02381 WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1 CL144 +02382 WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1 CL133 +02383 WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1 CL133 +02384 ADD +6 TO WSP-LINE-CNT2. CL133 +02385 P4200-EXIT. CL133 +02386 EXIT. CL133 +02387 CL133 +02388 DTSBX551 +02389 P5000-NEW-EMP. DTSBX551 +02390 *& DTSBX551 +02391 DISPLAY ' 5000-NEW-EMP ' W-EMP-NO ' ' W-PREV-REC-TYPE CL196 +02392 ' ERROR-IND ' W-RPT-ERROR-IND. CL196 +02393 * IF W-PREV-RPT-PAY-88 AND CL196 +02394 * W-RPT-ERROR-NO-88 CL196 +02395 * LX42-X140-EMP-NO = SPACES AND CL*85 +02396 * LX42-X145-EMP-NO = SPACES CL*85 +02397 * ADD +1 TO W-X145-PEN-CNT CL196 +02398 * WRITE PEND-X145-REC FROM X145-REC CL196 +02399 * MOVE SPACES TO R140-MESSAGE CL196 +02400 * MOVE W-EMP-NO TO R140-EMP-NO CL196 +02401 * STRING CL196 +02402 * ': NO REPORT FOR PAYMENT ' CL196 +02403 * DELIMITED BY SIZE CL196 +02404 * INTO R140-MESSAGE CL196 +02405 * END-STRING CL196 +02406 * MOVE R140-MESSAGE TO P434-MESSAGE CL196 +02407 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL196 +02408 * PERFORM S946-WRITE-R140 THRU S946-EXIT. CL196 +02409 CL*82 +02410 * DISPLAY 'BX436 P5000-NEW-RPT-PAY ' W-EMP-NO ' ' LX42-EMP-NO. CL168 +02411 DTSBX551 +02412 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX551 +02413 SET W-RPT-ERROR-NO-88 TO TRUE. CL*80 +02414 * SET W-PREV-REC-NULL-88 TO TRUE. CL107 +02415 SET W-PREV-RPT-NULL-88 TO TRUE. CL104 +02416 MOVE ZERO TO W-X140-REPORT-QTR CL*56 +02417 W-X145-PAYMENT-QTR CL*57 +02418 W-X144-WAGE-QTR CL*56 +02419 W-TOT-WAGE DTSBX551 +02420 W-TAX-WAGE DTSBX551 +02421 W-WRKR-TOT-WAGE DTSBX551 +02422 W-X145-REMITTANCE CL*53 +02423 W-X140-REMITTANCE CL*53 +02424 W-X140-RECEIVED-DATE CL*72 +02425 W-X145-DEPOSIT-DATE CL*72 +02426 W-X145-RECEIVED-DATE CL*72 +02427 W-1ST-MNTH-CNT DTSBX551 +02428 W-2ND-MNTH-CNT DTSBX551 +02429 W-3RD-MNTH-CNT DTSBX551 +02430 W-SSN DTSBX551 +02431 W-EARNINGS DTSBX551 +02432 W-EMP-WAGE-CNT DTSBX551 +02433 W-SEQ-NO CL*77 +02434 W-T025-REMIT-AMT CL*76 +02435 W-X145-TOT-REMIT-AMT CL*76 +02436 W-X140-REMITTANCE CL*83 +02437 LX42-X140-KEY-AREA CL*83 +02438 LX42-X144-KEY-AREA CL*83 +02439 LX42-X145-KEY-AREA. CL*83 +02440 CL*76 +02441 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*76 +02442 CL*76 +02443 DTSBX551 +02444 MOVE SPACES TO W-WRKR-FIRST-NAME DTSBX551 +02445 W-WRKR-LAST-NAME DTSBX551 +02446 W-WRKR-MID-INIT CL*56 +02447 W-X145-PAYMENT-FOUND-IND CL*79 +02448 LX42-X140-EMP-NO CL*79 +02449 LX42-X144-EMP-NO CL*82 +02450 LX42-X145-EMP-NO CL*82 +02451 LX42-X140-QTR-AREA CL*82 +02452 LX42-X144-QTR-AREA CL*82 +02453 P434-MESSAGE CL138 +02454 LX42-X145-QTR-AREA. CL*82 +02455 CL*53 +02456 INITIALIZE X140-REC DTSBX551 +02457 X144-REC CL*47 +02458 X145-REC. CL*47 +02459 CL*48 +02460 *& CL*88 +02461 * DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE CL161 +02462 * ' W-RROR-IND ' W-RPT-ERROR-IND CL161 +02463 * 'LX-W-RROR-IND ' W-RPT-ERROR-IND. CL161 +02464 P5000-EXIT. CL*25 +02465 EXIT. DTSBX551 +02466 DTSBX551 +02467 P6000-WRITE-PEND-X145. CL132 +02468 CL133 +02469 MOVE X145-EMP-NO TO P434-EMP-NO CL133 +02470 MOVE X145-QTR TO P434-QTR CL134 +02471 * IF W-EMP-FOUND-YES-88 CL135 +02472 * MOVE MPRF-PRIMARY-NAME (1:15) CL135 +02473 * TO P434-NAME-CHECK CL136 +02474 * ELSE CL135 +02475 MOVE 'PAY' TO P434-NAME-CHECK CL135 +02476 * END-IF. CL135 +02477 CL133 +02478 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL133 +02479 MOVE ZEROS TO P434-TOT-WAGE CL134 +02480 MOVE ZEROS TO P434-EXC-WAGE CL133 +02481 * MOVE ZEROS TO P434-EXC-WAGE CL134 +02482 MOVE ZEROS TO P434-TAX-WAGE CL133 +02483 MOVE ZEROS TO P434-X140-REMIT CL133 +02484 MOVE W-X145-TOT-REMIT-AMT TO P434-X145-REMIT CL135 +02485 CL133 +02486 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL133 +02487 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL133 +02488 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL133 +02489 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL133 +02490 CL133 +02491 * IF W-ERROR-NO-88 CL133 +02492 * MOVE 'PROCESSED' TO X434-DISPOSITION CL133 +02493 * ELSE CL133 +02494 * MOVE 'PENDING ' TO X434-DISPOSITION. CL133 +02495 * MOVE R140-MESSAGE TO P434-MESSAGE CL135 +02496 CL133 +02497 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL176 +02498 ADD 1 TO WS-LINE-CNT2. CL176 +02499 ADD +1 TO WS-NUMBER-ONE. CL176 +02500 GO TO P6000-EXIT. CL133 +02501 CL132 +02502 P6000-WRITE-PEND-X140. CL132 +02503 CL132 +02504 MOVE X140-EMP-NO TO P434-EMP-NO CL132 +02505 MOVE X140-QUARTER TO P434-QTR CL132 +02506 * IF W-EMP-FOUND-YES-88 CL135 +02507 * MOVE MPRF-PRIMARY-NAME (1:15) CL135 +02508 * TO P434-NAME-CHECK CL135 +02509 * ELSE CL135 +02510 MOVE 'RPT' TO P434-NAME-CHECK CL135 +02511 * END-IF. CL135 +02512 CL132 +02513 MOVE X140-RCVD-DATE TO P434-RCVD-DATE CL132 +02514 MOVE X140-TOTAL-WAGES TO P434-TOT-WAGE CL132 +02515 MOVE ZEROS TO P434-EXC-WAGE CL141 +02516 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL141 +02517 MOVE X140-TAX-WAGES TO P434-TAX-WAGE CL132 +02518 MOVE X140-REMITTANCE TO P434-X140-REMIT CL132 +02519 MOVE ZEROS TO P434-X145-REMIT CL138 +02520 CL132 +02521 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL132 +02522 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL132 +02523 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL132 +02524 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL132 +02525 CL132 +02526 * IF W-ERROR-NO-88 CL132 +02527 * MOVE 'PROCESSED' TO X434-DISPOSITION CL132 +02528 * ELSE CL132 +02529 * MOVE 'PENDING ' TO X434-DISPOSITION. CL132 +02530 * MOVE R140-MESSAGE TO P434-MESSAGE CL137 +02531 CL132 +02532 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133 +02533 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL132 +02534 ADD 1 TO WSP-LINE-CNT2. CL167 +02535 ADD +1 TO WSP-NUMBER-ONE. CL167 +02536 GO TO P6000-EXIT. CL144 +02537 CL132 +02538 P6000-WRITE-PEND-X144. CL144 +02539 CL144 +02540 MOVE X140-EMP-NO TO P434-EMP-NO CL144 +02541 MOVE X140-QUARTER TO P434-QTR CL144 +02542 * IF W-EMP-FOUND-YES-88 CL144 +02543 * MOVE MPRF-PRIMARY-NAME (1:15) CL144 +02544 * TO P434-NAME-CHECK CL144 +02545 * ELSE CL144 +02546 MOVE 'WAGE' TO P434-NAME-CHECK CL144 +02547 * END-IF. CL144 +02548 CL144 +02549 MOVE SPACES TO P434-RCVD-DATE CL144 +02550 MOVE ZEROS TO P434-TOT-WAGE CL144 +02551 MOVE ZEROS TO P434-EXC-WAGE CL144 +02552 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL144 +02553 MOVE ZEROS TO P434-TAX-WAGE CL144 +02554 MOVE ZEROS TO P434-X140-REMIT CL144 +02555 MOVE ZEROS TO P434-X145-REMIT CL144 +02556 CL144 +02557 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL144 +02558 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL144 +02559 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL144 +02560 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL144 +02561 CL144 +02562 * IF W-ERROR-NO-88 CL144 +02563 * MOVE 'PROCESSED' TO X434-DISPOSITION CL144 +02564 * ELSE CL144 +02565 * MOVE 'PENDING ' TO X434-DISPOSITION. CL144 +02566 * MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02567 CL144 +02568 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL144 +02569 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL144 +02570 ADD 1 TO WSP-LINE-CNT2. CL162 +02571 ADD +1 TO WSP-NUMBER-ONE. CL162 +02572 CL144 +02573 CL144 +02574 CL*59 +02575 P6000-EXIT. CL*59 +02576 EXIT. CL*59 +02577 CL*59 +02578 P7000-WRITE-PEND-X147. CL208 +02579 CL208 +02580 MOVE X147-EMP-NO TO P434-EMP-NO CL208 +02581 MOVE X147-QUARTER TO P434-QTR CL208 +02582 * IF W-EMP-FOUND-YES-88 CL208 +02583 * MOVE MPRF-PRIMARY-NAME (1:15) CL208 +02584 * TO P434-NAME-CHECK CL208 +02585 * ELSE CL208 +02586 MOVE 'WAGE' TO P434-NAME-CHECK CL208 +02587 * END-IF. CL208 +02588 CL208 +02589 MOVE SPACES TO P434-RCVD-DATE CL208 +02590 MOVE ZEROS TO P434-TOT-WAGE CL208 +02591 MOVE ZEROS TO P434-EXC-WAGE CL208 +02592 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL208 +02593 MOVE ZEROS TO P434-TAX-WAGE CL208 +02594 MOVE ZEROS TO P434-X140-REMIT CL208 +02595 MOVE ZEROS TO P434-X145-REMIT CL208 +02596 CL208 +02597 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL208 +02598 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL208 +02599 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL208 +02600 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL208 +02601 CL208 +02602 * IF W-ERROR-NO-88 CL208 +02603 * MOVE 'PROCESSED' TO X434-DISPOSITION CL208 +02604 * ELSE CL208 +02605 * MOVE 'PENDING ' TO X434-DISPOSITION. CL208 +02606 * MOVE R140-MESSAGE TO P434-MESSAGE CL208 +02607 CL208 +02608 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL208 +02609 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL208 +02610 ADD 1 TO WSP-LINE-CNT2. CL208 +02611 ADD +1 TO WSP-NUMBER-ONE. CL208 +02612 CL208 +02613 CL208 +02614 CL208 +02615 P7000-EXIT. CL208 +02616 EXIT. CL208 +02617 DTSBX551 +02618 T0000-TERMINATE. DTSBX551 +02619 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO CL121 +02620 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL121 +02621 END-IF. CL121 +02622 MOVE W-X145-RED-CNT TO WS-FOOTING-CNT. CL128 +02623 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL121 +02624 MOVE W-X145-ZRO-CNT TO WS-X145-PEN-CNT. CL172 +02625 MOVE W-X140-RED-CNT TO WS-X140-RED-CNT. CL130 +02626 MOVE W-X140-ERR-CNT TO WS-X140-ERR-CNT. CL130 +02627 MOVE W-X140-PEN-CNT TO WS-X140-PEN-CNT. CL130 +02628 MOVE W-X144-RED-CNT TO WS-X144-RED-CNT. CL153 +02629 MOVE W-X144-ERR-CNT TO WS-X144-ERR-CNT. CL153 +02630 MOVE W-X144-PEN-CNT TO WS-X144-PEN-CNT. CL153 +02631 MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT. CL121 +02632 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. CL121 +02633 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. CL121 +02634 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. CL121 +02635 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. CL153 +02636 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL153 +02637 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL153 +02638 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. CL153 +02639 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. CL153 +02640 WRITE REPT-PAID-REC FROM FOOTING-LINE-9 AFTER 1. CL153 +02641 WRITE REPT-PAID-REC FROM FOOTING-LINE-10 AFTER 1. CL153 +02642 WRITE REPT-PAID-REC FROM FOOTING-LINE-11 AFTER 1. CL153 +02643 WRITE REPT-PAID-REC FROM FOOTING-LINE-12 AFTER 1. CL153 +02644 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 1. CL153 +02645 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. CL153 +02646 CL121 +02647 DISPLAY ' '. DTSBX551 +02648 DTSBX551 +02649 DTSBX551 +02650 DISPLAY ' '. DTSBX551 +02651 DISPLAY '***************************************'. CL*47 +02652 DISPLAY '*** DTSBX451 TERMINATION AMENDED RPTS**'. CL206 +02653 DISPLAY '*** ESSP-CLEARING RPT/PAYMTS/WAGES ***'. CL168 +02654 DISPLAY '***************************************'. CL*47 +02655 DISPLAY ' '. DTSBX551 +02656 DTSBX551 +02657 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX551 +02658 DTSBX551 +02659 DISPLAY '***************************************'. DTSBX551 +02660 DTSBX551 +02661 CLOSE WAGE-FILE-OUT CL*20 +02662 PEND-X140-FILE CL*59 +02663 PEND-X144-FILE CL*59 +02664 PEND-X147-FILE CL208 +02665 REPT-PAID-FILE CL120 +02666 REPT-PEND-FILE CL120 +02667 PEND-X145-FILE CL120 +02668 TEMP-BTC-FILE CL*59 +02669 BATCH-XREF-FILE. CL*26 +02670 T0000-EXIT. DTSBX551 +02671 EXIT. DTSBX551 +02672 DTSBX551 +02673 DTSBX551 +02674 T2000-DISPLAY-TOTALS. DTSBX551 +02675 DISPLAY '***** QUARTERLY REPORTS ************* '. CL*92 +02676 DISPLAY 'TOTAL X140-REPORT RECORDS READ..........: ' CL*96 +02677 W-X140-RED-CNT. CL*57 +02678 CL*99 +02679 DISPLAY ' NO OF X140-REPORTS PASSED ALL EDITS....: ' CL*99 +02680 W-X140-SAV-CNT. CL*99 +02681 DTSBX551 +02682 DISPLAY ' NO OF X140-REPORTS T028 TRANS WRITTEN..: ' CL*96 +02683 W-T028-WRITE-CNT. DTSBX551 +02684 CL*99 +02685 * DISPLAY ' ##T028 TRANS WRITTEN - REMIT AMT ZERO.: ' CL206 +02686 * W-T028-WRITEO-CNT. CL206 +02687 CL*99 +02688 * DISPLAY ' #T028 TRANS WRITTEN - REMIT AMT EQUAL: ' CL206 +02689 * W-T028-WRITEE-CNT. CL206 +02690 DISPLAY ' NO OF X140-REPORTS WRITTEN TO PENDING..: ' CL*96 +02691 W-X140-PEN-CNT. CL*92 +02692 DISPLAY ' NO OF X140-REPORTS HAS ERRORS..........: ' CL*96 +02693 W-X140-ERR-CNT. CL*92 +02694 DISPLAY ' NO OF X140-REPORTS HAS DUPLICATE.......: ' CL*96 +02695 W-X140-DUP-CNT. CL*92 +02696 CL*92 +02697 DISPLAY ' '. CL*92 +02698 DISPLAY '***** QUARTERLY PAYMENTS ********* '. CL*96 +02699 DISPLAY 'TOTAL X145-PAYMENTS RECORDS READ.......: ' CL*96 +02700 W-X145-RED-CNT. CL*92 +02701 CL*92 +02702 DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: ' CL*98 +02703 W-X145-SAV-CNT. CL*92 +02704 CL*92 +02705 DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: ' CL*96 +02706 W-T025-WRITE-CNT. CL*94 +02707 CL*94 +02708 DISPLAY ' ## T025 TRANS WRITTEN-ZERO REMIT....: ' CL100 +02709 W-T025-WRITEO-CNT. CL100 +02710 CL100 +02711 DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: ' CL*96 +02712 W-X145-PEN-CNT. CL*92 +02713 DISPLAY ' NO OF X145-PAYMENTS HAS ERRORS.........: ' CL*96 +02714 W-X145-ERR-CNT. CL*92 +02715 DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: ' CL*96 +02716 W-X145-DUP-CNT. CL*92 +02717 CL*92 +02718 DISPLAY ' '. CL*92 +02719 DISPLAY '***** QUARTERLY WAGES ************* '. CL*92 +02720 DISPLAY 'TOTAL X144-WAGES RECORDS READ..........: ' CL*96 +02721 W-X144-RED-CNT. CL*92 +02722 CL*99 +02723 DISPLAY ' NO OF X144-WAGES PASSED ALL EDITS......: ' CL*99 +02724 W-X144-SAV-CNT. CL*99 +02725 CL*99 +02726 DISPLAY ' NO OF X144-WAGES W004 TRANS WRITTEN....: ' CL*96 +02727 W-W4-CNT. CL*96 +02728 CL*92 +02729 DISPLAY ' NO OF X144-WAGES WRITTEN TO PENDING....: ' CL*96 +02730 W-X144-PEN-CNT. CL*92 +02731 DISPLAY ' NO OF X144-WAGES HAS ERRORS............: ' CL*96 +02732 W-X144-ERR-CNT. CL*92 +02733 DISPLAY ' NO OF X144-WAGES HAS DUPLICATE.........: ' CL*96 +02734 W-X144-DUP-CNT. CL*92 +02735 CL*92 +02736 CL*10 +02737 DISPLAY ' '. CL208 +02738 DISPLAY '***** AMENDED WAGES DELETED ****** '. CL208 +02739 DISPLAY 'TOTAL X147-WAGES RECORDS READ..........: ' CL208 +02740 W-X147-RED-CNT. CL208 +02741 CL208 +02742 DISPLAY ' NO OF X147-WAGES PASSED ALL EDITS......: ' CL208 +02743 W-X147-SAV-CNT. CL208 +02744 CL208 +02745 DISPLAY ' NO OF X147-WAGES W004 TRANS WRITTEN....: ' CL208 +02746 W-W2-CNT. CL208 +02747 CL208 +02748 DISPLAY ' NO OF X147-WAGES WRITTEN TO PENDING....: ' CL208 +02749 W-X147-PEN-CNT. CL208 +02750 DISPLAY ' NO OF X147-WAGES HAS ERRORS............: ' CL208 +02751 W-X147-ERR-CNT. CL208 +02752 DISPLAY ' NO OF X147-WAGES HAS DUPLICATE.........: ' CL208 +02753 W-X147-DUP-CNT. CL208 +02754 CL208 +02755 CL208 +02756 DISPLAY ' '. DTSBX551 +02757 DISPLAY '***** END REPORTS/WAGES AND PAYMENTS **** '. CL*96 +02758 DTSBX551 +02759 T2000-EXIT. DTSBX551 +02760 EXIT. DTSBX551 +02761 DTSBX551 +02762 S001-FROM-FED-8. DTSBX551 +02763 SET L001-FROM-FED-8 TO TRUE. DTSBX551 +02764 GO TO S001-DATE. DTSBX551 +02765 DTSBX551 +02766 S001-FROM-CAL-8. DTSBX551 +02767 SET L001-FROM-CAL-8 TO TRUE. DTSBX551 +02768 GO TO S001-DATE. DTSBX551 +02769 DTSBX551 +02770 S001-FROM-ABS-DAY. DTSBX551 +02771 SET L001-FROM-ABS-DAY TO TRUE. DTSBX551 +02772 GO TO S001-DATE. DTSBX551 +02773 DTSBX551 +02774 S001-DATE. DTSBX551 +02775 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX551 +02776 S001-EXIT. DTSBX551 +02777 EXIT. DTSBX551 +02778 DTSBX551 +02779 S003-AGENCY-DAY. DTSBX551 +02780 SET L003-AGENCY-DAY TO TRUE. DTSBX551 +02781 GO TO S003-WORK-DAY. DTSBX551 +02782 DTSBX551 +02783 S003-WORK-DAY. DTSBX551 +02784 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX551 +02785 S003-EXIT. DTSBX551 +02786 EXIT. DTSBX551 +02787 DTSBX551 +02788 S004-FROM-5. DTSBX551 +02789 SET L004-FROM-5 TO TRUE. DTSBX551 +02790 GO TO S004-YRQ. DTSBX551 +02791 DTSBX551 +02792 S004-FROM-DATE. DTSBX551 +02793 SET L004-FROM-DATE TO TRUE. DTSBX551 +02794 GO TO S004-YRQ. DTSBX551 +02795 DTSBX551 +02796 S004-FROM-ABS. DTSBX551 +02797 SET L004-FROM-ABS TO TRUE. DTSBX551 +02798 GO TO S004-YRQ. DTSBX551 +02799 DTSBX551 +02800 S004-YRQ. DTSBX551 +02801 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX551 +02802 DTSBX551 +02803 S004-EXIT. DTSBX551 +02804 EXIT. DTSBX551 +02805 DTSBX551 +02806 S516-LIABILITY-INFO. DTSBX551 +02807 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX551 +02808 MPRF-REC. DTSBX551 +02809 S516-EXIT. DTSBX551 +02810 EXIT. DTSBX551 +02811 DTSBX551 +02812 S910-OPEN-READ. DTSBX551 +02813 SET L910-OPEN-READ-88 TO TRUE. DTSBX551 +02814 GO TO S910-MSTR-IO. DTSBX551 +02815 DTSBX551 +02816 S910-READ. DTSBX551 +02817 SET L910-READ-88 TO TRUE. DTSBX551 +02818 GO TO S910-MSTR-IO. DTSBX551 +02819 DTSBX551 +02820 S910-START-BROWSE. DTSBX551 +02821 SET L910-START-BROWSE-88 TO TRUE. DTSBX551 +02822 GO TO S910-MSTR-IO. DTSBX551 +02823 DTSBX551 +02824 S910-READ-NEXT. DTSBX551 +02825 SET L910-READ-NEXT-88 TO TRUE. DTSBX551 +02826 GO TO S910-MSTR-IO. DTSBX551 +02827 DTSBX551 +02828 S910-CLOSE. DTSBX551 +02829 SET L910-CLOSE-88 TO TRUE. DTSBX551 +02830 GO TO S910-MSTR-IO. DTSBX551 +02831 DTSBX551 +02832 S910-MSTR-IO. DTSBX551 +02833 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX551 +02834 MSKL-REC. DTSBX551 +02835 S910-EXIT. DTSBX551 +02836 EXIT. DTSBX551 +02837 DTSBX551 +02838 S921-OPEN-READ. DTSBX551 +02839 SET L921-OPEN-READ-88 TO TRUE. DTSBX551 +02840 GO TO S921-AIX-IO. DTSBX551 +02841 DTSBX551 +02842 S921-READ. DTSBX551 +02843 SET L921-READ-88 TO TRUE. DTSBX551 +02844 GO TO S921-AIX-IO. DTSBX551 +02845 DTSBX551 +02846 S921-START-BROWSE. DTSBX551 +02847 SET L921-START-BROWSE-88 TO TRUE. DTSBX551 +02848 GO TO S921-AIX-IO. DTSBX551 +02849 DTSBX551 +02850 S921-READ-NEXT. DTSBX551 +02851 SET L921-READ-NEXT-88 TO TRUE. DTSBX551 +02852 GO TO S921-AIX-IO. DTSBX551 +02853 DTSBX551 +02854 S921-CLOSE. DTSBX551 +02855 SET L921-CLOSE-88 TO TRUE. DTSBX551 +02856 GO TO S921-AIX-IO. DTSBX551 +02857 DTSBX551 +02858 S921-AIX-IO. DTSBX551 +02859 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX551 +02860 ISKL-REC. DTSBX551 +02861 S921-EXIT. DTSBX551 +02862 EXIT. DTSBX551 +02863 DTSBX551 +02864 S923-OPEN-UPDATE. DTSBX551 +02865 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX551 +02866 GO TO S923-ATC-CALL. DTSBX551 +02867 DTSBX551 +02868 S923-WRITE. DTSBX551 +02869 SET L923-WRITE-88 TO TRUE. DTSBX551 +02870 GO TO S923-ATC-CALL. DTSBX551 +02871 DTSBX551 +02872 S923-CLOSE. DTSBX551 +02873 SET L923-CLOSE-88 TO TRUE. DTSBX551 +02874 GO TO S923-ATC-CALL. DTSBX551 +02875 DTSBX551 +02876 S923-ATC-CALL. DTSBX551 +02877 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX551 +02878 ASKL-REC. DTSBX551 +02879 S923-EXIT. DTSBX551 +02880 EXIT. DTSBX551 +02881 DTSBX551 +02882 *S927A-OPEN. DTSBX551 +02883 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX551 +02884 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX551 +02885 * DTSBX551 +02886 *S927A-EXIT. DTSBX551 +02887 * EXIT. DTSBX551 +02888 DTSBX551 +02889 S927B-WRITE. DTSBX551 +02890 SET L927-WRITE-88 TO TRUE. DTSBX551 +02891 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX551 +02892 DTSBX551 +02893 S927B-EXIT. DTSBX551 +02894 EXIT. DTSBX551 +02895 DTSBX551 +02896 *S927C-CLOSE. DTSBX551 +02897 * SET L927-CLOSE-88 TO TRUE. DTSBX551 +02898 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX551 +02899 * DTSBX551 +02900 *S927C-EXIT. DTSBX551 +02901 * EXIT. DTSBX551 +02902 DTSBX551 +02903 S927Z-IO. DTSBX551 +02904 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX551 +02905 TSKL-REC. DTSBX551 +02906 S927Z-EXIT. DTSBX551 +02907 EXIT. DTSBX551 +02908 DTSBX551 +02909 S931-OPEN-READ. DTSBX551 +02910 SET L931-OPEN-READ-88 TO TRUE. DTSBX551 +02911 GO TO S931-REF-IO. DTSBX551 +02912 DTSBX551 +02913 S931-CLOSE. DTSBX551 +02914 SET L931-CLOSE-88 TO TRUE. DTSBX551 +02915 GO TO S931-REF-IO. DTSBX551 +02916 DTSBX551 +02917 S931-REF-IO. DTSBX551 +02918 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX551 +02919 FSKL-REC. DTSBX551 +02920 S931-EXIT. DTSBX551 +02921 EXIT. DTSBX551 +02922 DTSBX551 +02923 S1032-WRITE-TEMP-T028. DTSBX551 +02924 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSBX551 +02925 MOVE T028-REC TO TEMP-BTC-REC. DTSBX551 +02926 WRITE TEMP-BTC-REC. DTSBX551 +02927 IF TEMP-BTC-STATUS-OK-88 DTSBX551 +02928 NEXT SENTENCE DTSBX551 +02929 ELSE DTSBX551 +02930 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02931 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSBX551 +02932 TEMP-BTC-STATUS DTSBX551 +02933 END-IF. DTSBX551 +02934 DTSBX551 +02935 S1032-EXIT. CL**9 +02936 EXIT. DTSBX551 +02937 DTSBX551 +02938 S1033-WRITE-TEMP-T025. DTSBX551 +02939 MOVE T025-LENGTH TO VAR-CHAR-CNT. DTSBX551 +02940 MOVE T025-REC TO TEMP-BTC-REC. DTSBX551 +02941 WRITE TEMP-BTC-REC. DTSBX551 +02942 IF TEMP-BTC-STATUS-OK-88 DTSBX551 +02943 NEXT SENTENCE DTSBX551 +02944 ELSE DTSBX551 +02945 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02946 DISPLAY 'CANNOT WRITE TEMP T025: ' DTSBX551 +02947 TEMP-BTC-STATUS DTSBX551 +02948 END-IF. DTSBX551 +02949 DTSBX551 +02950 S1033-EXIT. DTSBX551 +02951 EXIT. DTSBX551 +02952 DTSBX551 +02953 S1040-OPEN-TEMP-BTC-OUT. DTSBX551 +02954 OPEN OUTPUT TEMP-BTC-FILE. DTSBX551 +02955 IF TEMP-BTC-STATUS-OK-88 DTSBX551 +02956 NEXT SENTENCE DTSBX551 +02957 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX551 +02958 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX551 +02959 ELSE DTSBX551 +02960 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +02961 DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: ' DTSBX551 +02962 TEMP-BTC-STATUS DTSBX551 +02963 END-IF. DTSBX551 +02964 DTSBX551 +02965 S1040-EXIT. DTSBX551 +02966 EXIT. DTSBX551 +02967 DTSBX551 +02968 S1050-OPEN-TEMP-BTC-IN. DTSBX551 +02969 OPEN INPUT TEMP-BTC-FILE. DTSBX551 +02970 IF TEMP-BTC-STATUS-OK-88 DTSBX551 +02971 NEXT SENTENCE DTSBX551 +02972 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX551 +02973 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX551 +02974 ELSE DTSBX551 +02975 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +02976 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBX551 +02977 TEMP-BTC-STATUS DTSBX551 +02978 END-IF. DTSBX551 +02979 DTSBX551 +02980 S1050-EXIT. DTSBX551 +02981 EXIT. DTSBX551 +02982 DTSBX551 +02983 S1060-CLOSE-TEMP-BTC. DTSBX551 +02984 CLOSE TEMP-BTC-FILE. DTSBX551 +02985 IF TEMP-BTC-STATUS-OK-88 DTSBX551 +02986 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX551 +02987 NEXT SENTENCE DTSBX551 +02988 ELSE DTSBX551 +02989 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +02990 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX551 +02991 TEMP-BTC-STATUS DTSBX551 +02992 END-IF. DTSBX551 +02993 DTSBX551 +02994 S1060-EXIT. DTSBX551 +02995 EXIT. DTSBX551 +02996 DTSBX551 +02997 S1070-READ-TEMP-BTC. DTSBX551 +02998 READ TEMP-BTC-FILE. DTSBX551 +02999 IF TEMP-BTC-STATUS-OK-88 DTSBX551 +03000 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBX551 +03001 ELSE DTSBX551 +03002 IF TEMP-BTC-STATUS-EOF-88 DTSBX551 +03003 NEXT SENTENCE DTSBX551 +03004 ELSE DTSBX551 +03005 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBX551 +03006 TEMP-BTC-STATUS DTSBX551 +03007 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +03008 END-IF DTSBX551 +03009 END-IF. DTSBX551 +03010 DTSBX551 +03011 S1070-EXIT. DTSBX551 +03012 EXIT. DTSBX551 +03013 DTSBX551 +03014 S1100-OPEN-WAGE-TEMP-OUT. DTSBX551 +03015 OPEN OUTPUT WAGE-FILE-TEMP. DTSBX551 +03016 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX551 +03017 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +03018 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSBX551 +03019 WAGE-TEMP-STATUS DTSBX551 +03020 END-IF. DTSBX551 +03021 DTSBX551 +03022 S1100-EXIT. DTSBX551 +03023 EXIT. DTSBX551 +03024 DTSBX551 +03025 S1110-CLOSE-WAGE-TEMP. DTSBX551 +03026 CLOSE WAGE-FILE-TEMP. DTSBX551 +03027 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX551 +03028 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +03029 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBX551 +03030 WAGE-TEMP-STATUS DTSBX551 +03031 END-IF. DTSBX551 +03032 DTSBX551 +03033 S1110-EXIT. DTSBX551 +03034 EXIT. DTSBX551 +03035 DTSBX551 +03036 S1120-WRITE-WAGE-TEMP. DTSBX551 +03037 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBX551 +03038 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX551 +03039 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +03040 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBX551 +03041 WAGE-TEMP-STATUS DTSBX551 +03042 END-IF. DTSBX551 +03043 DTSBX551 +03044 S1120-EXIT. DTSBX551 +03045 EXIT. DTSBX551 +03046 DTSBX551 +03047 S1130-OPEN-WAGE-TEMP-IN. DTSBX551 +03048 OPEN INPUT WAGE-FILE-TEMP. DTSBX551 +03049 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX551 +03050 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +03051 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSBX551 +03052 WAGE-TEMP-STATUS DTSBX551 +03053 END-IF. DTSBX551 +03054 DTSBX551 +03055 S1130-EXIT. DTSBX551 +03056 EXIT. DTSBX551 +03057 DTSBX551 +03058 S1140-READ-WAGE-TEMP. DTSBX551 +03059 READ WAGE-FILE-TEMP INTO W001-REC. DTSBX551 +03060 IF WAGE-TEMP-STATUS-EOF-88 DTSBX551 +03061 NEXT SENTENCE DTSBX551 +03062 ELSE DTSBX551 +03063 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX551 +03064 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX551 +03065 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSBX551 +03066 WAGE-TEMP-STATUS DTSBX551 +03067 END-IF DTSBX551 +03068 END-IF. DTSBX551 +03069 DTSBX551 +03070 S1140-EXIT. DTSBX551 +03071 EXIT. DTSBX551 +03072 DTSBX551 +03073 S1150-OPEN-WAGE-FILE-OUT. CL*20 +03074 OPEN OUTPUT WAGE-FILE-OUT. CL*20 +03075 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +03076 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +03077 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' CL*20 +03078 WAGE-OUT-STATUS CL*20 +03079 END-IF. CL*20 +03080 DTSBX551 +03081 S1150-EXIT. CL*20 +03082 EXIT. CL*20 +03083 DTSBX551 +03084 S1160-CLOSE-WAGE-OUT. CL*20 +03085 CLOSE WAGE-FILE-OUT. CL*20 +03086 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +03087 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +03088 DISPLAY 'CANNOT CLOSE WAGE FILE: ' CL*20 +03089 WAGE-OUT-STATUS CL*20 +03090 END-IF. CL*20 +03091 DTSBX551 +03092 S1160-EXIT. CL*20 +03093 EXIT. CL*20 +03094 DTSBX551 +03095 S1170-WRITE-WAGE-OUT. CL*20 +03096 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +03097 WRITE WAGE-OUT-REC. CL*20 +03098 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +03099 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +03100 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' CL*20 +03101 WAGE-OUT-STATUS CL*20 +03102 END-IF. CL*20 +03103 DTSBX551 +03104 S1170-EXIT. CL*20 +03105 EXIT. CL*20 +03106 DTSBX551 +03107 S946-WRITE-R140. DTSBX551 +03108 CALL 'DTSBU946' USING R140-REC. DTSBX551 +03109 DTSBX551 +03110 S946-EXIT. DTSBX551 +03111 EXIT. DTSBX551 +03112 DTSBX551 +03113 S999-ABEND. DTSBX551 +03114 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX551 +03115 S999-EXIT. DTSBX551 +03116 EXIT. DTSBX551 +03117 DTSBX551 diff --git a/Batch/DTSBX626.cob b/Batch/DTSBX626.cob index f709b51..24896cd 100644 --- a/Batch/DTSBX626.cob +++ b/Batch/DTSBX626.cob @@ -1,13 +1,13 @@ -00001 IDENTIFICATION DIVISION. 09/20/22 +00001 IDENTIFICATION DIVISION. 09/07/25 00002 PROGRAM-ID. DTSBX626. DTSBX626 -00003 AUTHOR. NGC. LV224 +00003 AUTHOR. NGC. LV227 00004 DATE-WRITTEN. SEPT 2013. CL**2 00005 DATE-COMPILED. DTSBX626 00006 SKIP3 DTSBX626 00007 *** CL160 00008 * FUNCTION: READ A DAILY BANK PAYMENT FILE AND THE DUTAS CL205 00009 * PAYMENT FILE RECEIVED FROM ESSP. IF THE TOTAL CL205 -00010 * AMOUNTS DONT MATCH ABEND JOB AND DO NOT SEND CL205 +00010 *RCTEST AMOUNTS DONT MATCH ABEND JOB AND DO NOT SEND CL226 00011 * PAYMENT FILE TO WELLS FARGO. CL205 00012 * 06/01/18 ZL1 CL205 00013 *** CL205 @@ -83,7 +83,7 @@ 00083 01 ESSP-ACH-TOT-REC PIC X(80). CL193 00084 DTSBX626 00085 WORKING-STORAGE SECTION. DTSBX626 -000855 77 PAN-VALET PICTURE X(24) VALUE '224DTSBX626 09/20/22'. DTSBX626 +000855 77 PAN-VALET PICTURE X(24) VALUE '227DTSBX626 09/07/25'. DTSBX626 00086 77 PAN-VALET PICTURE X(24) VALUE '216DTSBX425 01/22/04'. CL**2 00087 DTSBX626 00088 01 WRK-AREA. CL216 @@ -198,9 +198,9 @@ 00197 88 TRACE-NO-END-NO-88 VALUE 'N'. CL107 00198 CL106 00199 DTSBX626 -00200 05 WRK-MPRF-IND PIC X(01). DTSBX626 -00201 88 WRK-MPRF-OK VALUE 'Y'. DTSBX626 -00202 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX626 +00200 * 05 WRK-MPRF-IND PIC X(01). CL225 +00201 * 88 WRK-MPRF-OK VALUE 'Y'. CL225 +00202 * 88 WRK-MPRF-NO-REC VALUE 'N'. CL225 00203 DTSBX626 00204 05 WRK-MPAY-IND PIC X(01). DTSBX626 00205 88 MPAY-FOUND-YES-88 VALUE 'Y'. DTSBX626 @@ -1524,210 +1524,211 @@ 01523 MOVE ' TOTAL WELLS ACH-TPA CNT: ' TO X626-TXT CL208 01524 MOVE WRK-X145-XYZ-CNT TO X626-CNT CL205 01525 WRITE X626-REC. CL205 -01526 DISPLAY ' ' CL199 -01527 DISPLAY 'DUTAS ACH DEPOSITS RECD = ' WS-TOTAL-X145-AMT CL219 -01528 DISPLAY 'WELLS ACH DEPOSITS RECD = ' X145-ACH-REC-DEPOSIT CL219 -01529 IF WS-TOTAL-X145-AMT NOT = X145-ACH-REC-DEPOSIT CL199 -01530 * X145-ACH-REC-CNT NOT = WRK-X145-X626-CNT CL205 -01531 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++++' CL218 -01532 DISPLAY '+' CL218 -01533 DISPLAY 'DUTAS ACH DEPOSITS RECD = ' WS-TOTAL-X145-AMT CL218 -01534 DISPLAY 'WELLS ACH DEPOSITS RECD = ' X145-ACH-REC-DEPOSIT CL218 -01535 DISPLAY '+' CL218 -01536 DISPLAY '!!! ERROR RECEVIED DEPOSITS NOT MATCHING***' CL218 -01537 DISPLAY '+' CL218 -01538 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++++' CL218 -01539 * PERFORM S999-ABEND THRU S999-EXIT CL214 -01540 MOVE +05 TO RETURN-CODE CL222 -01541 DISPLAY 'RET CODE VALUE ' RETURN-CODE CL223 -01542 END-IF. CL193 -01543 CL193 -01544 DTSBX626 -01545 T0000-CONTINUE. CL209 -01546 CL*29 -01547 CLOSE ESSP-EMAIL-RPT. CL205 -01548 CLOSE ESSP-IN-X145 ESSP-OUT-X145 ESSP-ACH-TOTALS. CL193 -01549 PERFORM S910-CLOSE THRU S910-EXIT. CL*29 -01550 PERFORM S927-CLOSE THRU S927-EXIT. CL*29 -01551 CL*29 +01526 CL227 +01527 DISPLAY ' ' CL199 +01528 DISPLAY 'DUTAS ACH DEPOSITS RECD = ' WS-TOTAL-X145-AMT CL219 +01529 DISPLAY 'WELLS ACH DEPOSITS RECD = ' X145-ACH-REC-DEPOSIT CL219 +01530 IF WS-TOTAL-X145-AMT NOT = X145-ACH-REC-DEPOSIT CL199 +01531 * X145-ACH-REC-CNT NOT = WRK-X145-X626-CNT CL205 +01532 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++++' CL218 +01533 DISPLAY '+' CL218 +01534 DISPLAY 'DUTAS ACH DEPOSITS RECD = ' WS-TOTAL-X145-AMT CL218 +01535 DISPLAY 'WELLS ACH DEPOSITS RECD = ' X145-ACH-REC-DEPOSIT CL218 +01536 DISPLAY '+' CL218 +01537 DISPLAY '!!! ERROR RECEVIED DEPOSITS NOT MATCHING***' CL218 +01538 DISPLAY '+' CL218 +01539 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++++' CL218 +01540 * PERFORM S999-ABEND THRU S999-EXIT CL214 +01541 MOVE +05 TO RETURN-CODE CL222 +01542 DISPLAY 'RET CODE VALUE ' RETURN-CODE CL223 +01543 END-IF. CL193 +01544 CL193 +01545 DTSBX626 +01546 T0000-CONTINUE. CL209 +01547 CL*29 +01548 CLOSE ESSP-EMAIL-RPT. CL205 +01549 CLOSE ESSP-IN-X145 ESSP-OUT-X145 ESSP-ACH-TOTALS. CL193 +01550 PERFORM S910-CLOSE THRU S910-EXIT. CL*29 +01551 PERFORM S927-CLOSE THRU S927-EXIT. CL*29 01552 CL*29 -01553 DTSBX626 -01554 T0000-EXIT. DTSBX626 -01555 EXIT. DTSBX626 -01556 DTSBX626 -01557 P1070-READ-MPRF. DTSBX626 -01558 DTSBX626 +01553 CL*29 +01554 DTSBX626 +01555 T0000-EXIT. DTSBX626 +01556 EXIT. DTSBX626 +01557 DTSBX626 +01558 P1070-READ-MPRF. DTSBX626 01559 DTSBX626 -01560 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX626 -01561 SET MPRF-PRF-88 TO TRUE. DTSBX626 -01562 DISPLAY ' FAC6EMP ' FAC6-DUTAS-EMP-NO. CL130 -01563 DISPLAY ' MPAYEMP ' MPAY-EMP-NO. CL131 -01564 MOVE MPAY-EMP-NO TO MPRF-EMP-NO. CL131 -01565 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX626 -01566 DTSBX626 -01567 PERFORM S910-READ THRU S910-EXIT. DTSBX626 -01568 DTSBX626 -01569 IF L910-OK-88 DTSBX626 -01570 SET L910-OK-88 TO TRUE DTSBX626 -01571 MOVE MSKL-REC TO MPRF-REC DTSBX626 -01572 ELSE DTSBX626 -01573 DISPLAY '********NO MPRF-REC FOUND ' L910-RESULT-IND CL131 -01574 SET L910-NO-REC-88 TO TRUE DTSBX626 -01575 DISPLAY '6090 L910 NO RECORD FOUND ' DTSBX626 -01576 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX626 -01577 GO TO P1070-EXIT. DTSBX626 -01578 DTSBX626 -01579 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK CL127 -01580 WS-FAC6-DUTAS-EMP-NAME. CL129 -01581 DISPLAY ' EMP ' MPRF-PRIMARY-NAME ' ' MPRF-EMP-NO CL129 -01582 DISPLAY ' T25 ' T025-NAME-CHECK ' ' MPRF-EMP-NO CL129 -01583 MOVE WS-FAC6-DUTAS-EMP-NAMEA TO FAC6-DUTAS-EMP-NAME. CL129 -01584 P1070-EXIT. DTSBX626 -01585 EXIT. DTSBX626 -01586 DTSBX626 -01587 S3000-INIT-T003. CL*70 -01588 MOVE LOW-VALUES TO MNTE-KEY-AREA. CL*70 -01589 MOVE MPAY-EMP-NO TO MNTE-EMP-NO. CL*70 -01590 SET MNTE-NTE-88 TO TRUE. CL*70 -01591 MOVE +0 TO MNTE-PURGE-DATE. CL*70 -01592 SET MNTE-NOT-CONVERTED-88 TO TRUE. CL*70 -01593 CL*70 -01594 MOVE L005-DATE TO MNTE-ESTB-DATE CL*72 -01595 MNTE-CHNG-DATE. CL*70 -01596 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME CL*70 -01597 MNTE-DATA-ESTB-ABSTIME CL*70 -01598 MNTE-CHNG-ABSTIME. CL*70 -01599 MOVE 'WEBESSP ' TO MNTE-ESTB-OP-ID CL*70 -01600 MNTE-CHNG-OP-ID. CL*70 -01601 MOVE +0 TO MNTE-TEXT-CNT. CL*70 -01602 MOVE SPACES TO MNTE-TEXT-AREA. CL*70 -01603 CL*70 -01604 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 -01605 MOVE '003' TO T003-REC-TYPE. CL*70 -01606 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 -01607 MOVE '003' TO T003-REC-TYPE. CL*70 -01608 MOVE MPAY-EMP-NO TO T003-EMP-NO. CL*70 -01609 MOVE 'WEB PAY ' TO T003-ORIGIN. CL*70 -01610 MOVE L005-DATE TO T003-SYS-DATE. CL*72 -01611 MOVE L005-TIME TO T003-SYS-TIME. CL*72 -01612 SET T003-ADD-MNTE-88 TO TRUE. CL*70 -01613 CL*70 -01614 S3000-EXIT. CL*70 -01615 EXIT. CL*70 -01616 CL*70 -01617 DTSBX626 -01618 S001-FROM-FED-8. CL*71 -01619 SET L001-FROM-FED-8 TO TRUE. CL*71 -01620 GO TO S001-DATE. CL*71 -01621 CL*71 -01622 S001-DATE. CL*71 -01623 SKIP1 CL*71 -01624 CALL 'DTSBU001' USING L001-LINK-AREA. CL*71 -01625 S001-EXIT. CL*71 -01626 EXIT. CL*71 -01627 S005-FROM-SYS. CL*71 -01628 DTSBX626 -01629 SET L005-FROM-SYS TO TRUE. DTSBX626 -01630 GO TO S005-ABSTIME. DTSBX626 -01631 DTSBX626 -01632 S005-ABSTIME. DTSBX626 -01633 DTSBX626 -01634 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX626 -01635 DTSBX626 -01636 S005-EXIT. DTSBX626 -01637 EXIT. DTSBX626 -01638 DTSBX626 +01560 DTSBX626 +01561 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX626 +01562 SET MPRF-PRF-88 TO TRUE. DTSBX626 +01563 DISPLAY ' FAC6EMP ' FAC6-DUTAS-EMP-NO. CL130 +01564 DISPLAY ' MPAYEMP ' MPAY-EMP-NO. CL131 +01565 MOVE MPAY-EMP-NO TO MPRF-EMP-NO. CL131 +01566 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX626 +01567 DTSBX626 +01568 PERFORM S910-READ THRU S910-EXIT. DTSBX626 +01569 DTSBX626 +01570 IF L910-OK-88 DTSBX626 +01571 SET L910-OK-88 TO TRUE DTSBX626 +01572 MOVE MSKL-REC TO MPRF-REC DTSBX626 +01573 ELSE DTSBX626 +01574 DISPLAY '********NO MPRF-REC FOUND ' L910-RESULT-IND CL131 +01575 SET L910-NO-REC-88 TO TRUE DTSBX626 +01576 DISPLAY '6090 L910 NO RECORD FOUND ' DTSBX626 +01577 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX626 +01578 GO TO P1070-EXIT. DTSBX626 +01579 DTSBX626 +01580 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK CL127 +01581 WS-FAC6-DUTAS-EMP-NAME. CL129 +01582 DISPLAY ' EMP ' MPRF-PRIMARY-NAME ' ' MPRF-EMP-NO CL129 +01583 DISPLAY ' T25 ' T025-NAME-CHECK ' ' MPRF-EMP-NO CL129 +01584 MOVE WS-FAC6-DUTAS-EMP-NAMEA TO FAC6-DUTAS-EMP-NAME. CL129 +01585 P1070-EXIT. DTSBX626 +01586 EXIT. DTSBX626 +01587 DTSBX626 +01588 S3000-INIT-T003. CL*70 +01589 MOVE LOW-VALUES TO MNTE-KEY-AREA. CL*70 +01590 MOVE MPAY-EMP-NO TO MNTE-EMP-NO. CL*70 +01591 SET MNTE-NTE-88 TO TRUE. CL*70 +01592 MOVE +0 TO MNTE-PURGE-DATE. CL*70 +01593 SET MNTE-NOT-CONVERTED-88 TO TRUE. CL*70 +01594 CL*70 +01595 MOVE L005-DATE TO MNTE-ESTB-DATE CL*72 +01596 MNTE-CHNG-DATE. CL*70 +01597 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME CL*70 +01598 MNTE-DATA-ESTB-ABSTIME CL*70 +01599 MNTE-CHNG-ABSTIME. CL*70 +01600 MOVE 'WEBESSP ' TO MNTE-ESTB-OP-ID CL*70 +01601 MNTE-CHNG-OP-ID. CL*70 +01602 MOVE +0 TO MNTE-TEXT-CNT. CL*70 +01603 MOVE SPACES TO MNTE-TEXT-AREA. CL*70 +01604 CL*70 +01605 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 +01606 MOVE '003' TO T003-REC-TYPE. CL*70 +01607 MOVE LENGTH OF T003-REC TO T003-LENGTH CL*70 +01608 MOVE '003' TO T003-REC-TYPE. CL*70 +01609 MOVE MPAY-EMP-NO TO T003-EMP-NO. CL*70 +01610 MOVE 'WEB PAY ' TO T003-ORIGIN. CL*70 +01611 MOVE L005-DATE TO T003-SYS-DATE. CL*72 +01612 MOVE L005-TIME TO T003-SYS-TIME. CL*72 +01613 SET T003-ADD-MNTE-88 TO TRUE. CL*70 +01614 CL*70 +01615 S3000-EXIT. CL*70 +01616 EXIT. CL*70 +01617 CL*70 +01618 DTSBX626 +01619 S001-FROM-FED-8. CL*71 +01620 SET L001-FROM-FED-8 TO TRUE. CL*71 +01621 GO TO S001-DATE. CL*71 +01622 CL*71 +01623 S001-DATE. CL*71 +01624 SKIP1 CL*71 +01625 CALL 'DTSBU001' USING L001-LINK-AREA. CL*71 +01626 S001-EXIT. CL*71 +01627 EXIT. CL*71 +01628 S005-FROM-SYS. CL*71 +01629 DTSBX626 +01630 SET L005-FROM-SYS TO TRUE. DTSBX626 +01631 GO TO S005-ABSTIME. DTSBX626 +01632 DTSBX626 +01633 S005-ABSTIME. DTSBX626 +01634 DTSBX626 +01635 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX626 +01636 DTSBX626 +01637 S005-EXIT. DTSBX626 +01638 EXIT. DTSBX626 01639 DTSBX626 -01640 S910-OPEN-UPDATE-NO-AIX. DTSBX626 -01641 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX626 -01642 GO TO S910-MSTR-IO. DTSBX626 -01643 DTSBX626 -01644 EJECT DTSBX626 -01645 S910-OPEN-READ. DTSBX626 -01646 SET L910-OPEN-READ-88 TO TRUE. DTSBX626 -01647 GO TO S910-MSTR-IO. DTSBX626 -01648 DTSBX626 -01649 S910-READ. DTSBX626 -01650 SET L910-READ-88 TO TRUE. DTSBX626 -01651 GO TO S910-MSTR-IO. DTSBX626 -01652 DTSBX626 -01653 S910-DELETE. DTSBX626 -01654 SET L910-DELETE-88 TO TRUE. DTSBX626 -01655 GO TO S910-MSTR-IO. DTSBX626 -01656 DTSBX626 -01657 S910-WRITE. DTSBX626 -01658 SET L910-WRITE-88 TO TRUE. DTSBX626 -01659 GO TO S910-MSTR-IO. DTSBX626 -01660 DTSBX626 -01661 S910-START-BROWSE. DTSBX626 -01662 SET L910-START-BROWSE-88 TO TRUE. DTSBX626 -01663 GO TO S910-MSTR-IO. DTSBX626 -01664 DTSBX626 -01665 S910-READ-NEXT. DTSBX626 -01666 SET L910-READ-NEXT-88 TO TRUE. DTSBX626 -01667 GO TO S910-MSTR-IO. DTSBX626 -01668 DTSBX626 -01669 S910-REWRITE. DTSBX626 -01670 SET L910-REWRITE-88 TO TRUE. DTSBX626 -01671 GO TO S910-MSTR-IO. DTSBX626 -01672 DTSBX626 -01673 S910-CLOSE. DTSBX626 -01674 SET L910-CLOSE-88 TO TRUE. DTSBX626 -01675 GO TO S910-MSTR-IO. DTSBX626 -01676 DTSBX626 -01677 S910-MSTR-IO. DTSBX626 -01678 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX626 -01679 MSKL-REC. DTSBX626 -01680 S910-EXIT. DTSBX626 -01681 EXIT. DTSBX626 -01682 DTSBX626 -01683 SKIP3 DTSBX626 -01684 S921-OPEN-READ. DTSBX626 -01685 SET L921-OPEN-READ-88 TO TRUE. DTSBX626 -01686 GO TO S921-AIX-IO. DTSBX626 -01687 DTSBX626 -01688 S921-READ. DTSBX626 -01689 SET L921-READ-88 TO TRUE. DTSBX626 -01690 GO TO S921-AIX-IO. DTSBX626 -01691 DTSBX626 -01692 S921-START-BROWSE. DTSBX626 -01693 SET L921-START-BROWSE-88 TO TRUE. DTSBX626 -01694 GO TO S921-AIX-IO. DTSBX626 -01695 DTSBX626 -01696 S921-READ-NEXT. DTSBX626 -01697 SET L921-READ-NEXT-88 TO TRUE. DTSBX626 -01698 GO TO S921-AIX-IO. DTSBX626 -01699 DTSBX626 -01700 S921-CLOSE. DTSBX626 -01701 SET L921-CLOSE-88 TO TRUE. DTSBX626 -01702 GO TO S921-AIX-IO. DTSBX626 -01703 DTSBX626 -01704 S921-AIX-IO. DTSBX626 -01705 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX626 -01706 ISKL-REC. DTSBX626 -01707 S921-EXIT. DTSBX626 -01708 EXIT. DTSBX626 -01709 DTSBX626 -01710 S927-OPEN-UPDATE. DTSBX626 -01711 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX626 -01712 GO TO S927-BTC-O. DTSBX626 -01713 DTSBX626 -01714 S927-WRITE. DTSBX626 -01715 SET L927-WRITE-88 TO TRUE. DTSBX626 -01716 GO TO S927-BTC-O. DTSBX626 -01717 DTSBX626 -01718 S927-CLOSE. DTSBX626 -01719 SET L927-CLOSE-88 TO TRUE. DTSBX626 -01720 GO TO S927-BTC-O. DTSBX626 -01721 DTSBX626 -01722 S927-BTC-O. DTSBX626 -01723 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX626 -01724 TSKL-REC. DTSBX626 -01725 S927-EXIT. DTSBX626 -01726 EXIT. DTSBX626 -01727 DTSBX626 -01728 EJECT DTSBX626 -01729 S999-ABEND. DTSBX626 -01730 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX626 -01731 S999-EXIT. DTSBX626 -01732 EXIT. DTSBX626 +01640 DTSBX626 +01641 S910-OPEN-UPDATE-NO-AIX. DTSBX626 +01642 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX626 +01643 GO TO S910-MSTR-IO. DTSBX626 +01644 DTSBX626 +01645 EJECT DTSBX626 +01646 S910-OPEN-READ. DTSBX626 +01647 SET L910-OPEN-READ-88 TO TRUE. DTSBX626 +01648 GO TO S910-MSTR-IO. DTSBX626 +01649 DTSBX626 +01650 S910-READ. DTSBX626 +01651 SET L910-READ-88 TO TRUE. DTSBX626 +01652 GO TO S910-MSTR-IO. DTSBX626 +01653 DTSBX626 +01654 S910-DELETE. DTSBX626 +01655 SET L910-DELETE-88 TO TRUE. DTSBX626 +01656 GO TO S910-MSTR-IO. DTSBX626 +01657 DTSBX626 +01658 S910-WRITE. DTSBX626 +01659 SET L910-WRITE-88 TO TRUE. DTSBX626 +01660 GO TO S910-MSTR-IO. DTSBX626 +01661 DTSBX626 +01662 S910-START-BROWSE. DTSBX626 +01663 SET L910-START-BROWSE-88 TO TRUE. DTSBX626 +01664 GO TO S910-MSTR-IO. DTSBX626 +01665 DTSBX626 +01666 S910-READ-NEXT. DTSBX626 +01667 SET L910-READ-NEXT-88 TO TRUE. DTSBX626 +01668 GO TO S910-MSTR-IO. DTSBX626 +01669 DTSBX626 +01670 S910-REWRITE. DTSBX626 +01671 SET L910-REWRITE-88 TO TRUE. DTSBX626 +01672 GO TO S910-MSTR-IO. DTSBX626 +01673 DTSBX626 +01674 S910-CLOSE. DTSBX626 +01675 SET L910-CLOSE-88 TO TRUE. DTSBX626 +01676 GO TO S910-MSTR-IO. DTSBX626 +01677 DTSBX626 +01678 S910-MSTR-IO. DTSBX626 +01679 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX626 +01680 MSKL-REC. DTSBX626 +01681 S910-EXIT. DTSBX626 +01682 EXIT. DTSBX626 +01683 DTSBX626 +01684 SKIP3 DTSBX626 +01685 S921-OPEN-READ. DTSBX626 +01686 SET L921-OPEN-READ-88 TO TRUE. DTSBX626 +01687 GO TO S921-AIX-IO. DTSBX626 +01688 DTSBX626 +01689 S921-READ. DTSBX626 +01690 SET L921-READ-88 TO TRUE. DTSBX626 +01691 GO TO S921-AIX-IO. DTSBX626 +01692 DTSBX626 +01693 S921-START-BROWSE. DTSBX626 +01694 SET L921-START-BROWSE-88 TO TRUE. DTSBX626 +01695 GO TO S921-AIX-IO. DTSBX626 +01696 DTSBX626 +01697 S921-READ-NEXT. DTSBX626 +01698 SET L921-READ-NEXT-88 TO TRUE. DTSBX626 +01699 GO TO S921-AIX-IO. DTSBX626 +01700 DTSBX626 +01701 S921-CLOSE. DTSBX626 +01702 SET L921-CLOSE-88 TO TRUE. DTSBX626 +01703 GO TO S921-AIX-IO. DTSBX626 +01704 DTSBX626 +01705 S921-AIX-IO. DTSBX626 +01706 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX626 +01707 ISKL-REC. DTSBX626 +01708 S921-EXIT. DTSBX626 +01709 EXIT. DTSBX626 +01710 DTSBX626 +01711 S927-OPEN-UPDATE. DTSBX626 +01712 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX626 +01713 GO TO S927-BTC-O. DTSBX626 +01714 DTSBX626 +01715 S927-WRITE. DTSBX626 +01716 SET L927-WRITE-88 TO TRUE. DTSBX626 +01717 GO TO S927-BTC-O. DTSBX626 +01718 DTSBX626 +01719 S927-CLOSE. DTSBX626 +01720 SET L927-CLOSE-88 TO TRUE. DTSBX626 +01721 GO TO S927-BTC-O. DTSBX626 +01722 DTSBX626 +01723 S927-BTC-O. DTSBX626 +01724 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX626 +01725 TSKL-REC. DTSBX626 +01726 S927-EXIT. DTSBX626 +01727 EXIT. DTSBX626 +01728 DTSBX626 +01729 EJECT DTSBX626 +01730 S999-ABEND. DTSBX626 +01731 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX626 +01732 S999-EXIT. DTSBX626 +01733 EXIT. DTSBX626 diff --git a/Batch/DTSBX629.cob b/Batch/DTSBX629.cob index 0d89c05..991acd5 100644 --- a/Batch/DTSBX629.cob +++ b/Batch/DTSBX629.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 02/12/19 +00001 IDENTIFICATION DIVISION. 08/14/25 00002 PROGRAM-ID. DTSBX629. DTSBX629 -00003 LV015 +00003 LV018 00004 ******************************************************************DTSBX629 00005 * *DTSBX629 00006 * FUNCTION: *DTSBX629 @@ -73,7 +73,7 @@ 00073 * WORKING STORAGE SECTION *DTSBX629 00074 ******************************************************************DTSBX629 00075 WORKING-STORAGE SECTION. DTSBX629 -000755 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX629 02/12/19'. DTSBX629 +000755 77 PAN-VALET PICTURE X(24) VALUE '018DTSBX629 08/14/25'. DTSBX629 00076 DTSBX629 00077 01 ENDOFSEG PIC 9 VALUE ZEROES. DTSBX629 00078 DTSBX629 @@ -336,9 +336,9 @@ 00335 ++INCLUDE DTSEX140 CL228 00336 01 X144-REC. CL228 00337 ++INCLUDE DTSEX144 CL228 -00338 01 COMMON-LINKAGE-SECTION. CL228 -00339 ++INCLUDE ESPLINKB CL228 -00340 ++INCLUDE EWGLINKB CL228 +00338 *01 COMMON-LINKAGE-SECTION. CL*18 +00339 *++INCLUDE ESPLINKB CL*16 +00340 *++INCLUDE EWGLINKB CL*16 00341 ******************************************************************DTSBX629 00342 * PROCEDURE DIVISION *DTSBX629 00343 ******************************************************************DTSBX629 @@ -485,757 +485,460 @@ 00484 CL239 00485 GO TO PROC2000-UI-EXIT. CL223 00486 CL223 -00487 * IF WS-X144-SSN-FOUND = 1 CL217 -00488 * ADD 1 TO WS-TOTAL-YES-X144-SSN CL217 -00489 * DISPLAY '>+ X144 FOUND FOR X147- DELETE ' X147-SSN CL217 -00490 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 -00491 * ELSE CL217 -00492 * IF WS-X144-SSN-FOUND = 0 CL217 -00493 * ADD 1 TO WS-TOTAL-NO-X144-SSN CL217 -00494 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 -00495 * DISPLAY ' X140/144 NOT FOUND FOR X147 -VERIFY ' X147-SSN CL217 -00496 * ELSE CL217 -00497 * IF WS-X144-SSN-FOUND = 1 CL217 -00498 * ADD 1 TO WS-TOTAL-YES-X144-SSN CL217 -00499 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 -00500 * DISPLAY 'X144 FOUND FOR X147 -VER: ' X147-SSN CL217 -00501 * ELSE CL217 -00502 * ADD 1 TO WS-TOTAL-NO-X144-SSN CL217 -00503 * DISPLAY 'X140 OR X144 NOTFOUND FOR X147 -VER: ' X147-SSN. CL217 -00504 * CL217 -00505 * CL195 -00506 **** SEARCH DOCS FOR ANY CLAIM ON ESSP SSN MARKED FOR DELETION. CL195 -00507 **** IF CLAIM IS FOUND DO NOT DELETE SSN-- SEND REPORT. CL195 -00508 * CL195 -00509 MOVE 0 TO WS-CLAIM-SSN-FOUND. CL182 -00510 CL194 -00511 PERFORM PROC2700-FIND-CLAIM THRU PROC2700-EXIT. CL181 -00512 CL133 -00513 IF WS-CLAIM-SSN-FOUND = 1 CL214 -00514 IF WS-X144-SSN-FOUND = 1 CL214 -00515 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 -00516 DISPLAY ' >> CLAIM FOUND WITH X144: REPLACE WAGES ' CL205 -00517 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL201 -00518 ELSE CL214 -00519 DISPLAY ' >> CLAIM FOUND NO X144: CANNOT DELETE' CL205 -00520 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL216 -00521 PERFORM PROC2600-SAV-SSN THRU PROC2600-EXIT CL207 -00522 ADD 1 TO WS-TOTAL-NDEL CL205 -00523 ELSE CL205 -00524 IF WS-CLAIM-SSN-FOUND = 0 CL214 -00525 IF WS-X144-SSN-FOUND = 1 CL214 -00526 DISPLAY '++ CLAIM NOT FOUND REPLACE WAGES ' X147-EMP-NO CL205 -00527 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 -00528 ELSE CL214 -00529 DISPLAY '++ CLAIM NOT FOUND DELETE WAGES ' X147-EMP-NO CL205 -00530 PERFORM PROC2550-DEL-SSN THRU PROC2550-EXIT CL215 -00531 ELSE CL214 -00532 DISPLAY '++ CHECK IF STATEMENT ========= ' X147-EMP-NO. CL215 -00533 CL201 -00534 GO TO PROC2000-UI-EXIT. CL201 -00535 CL182 -00536 IF X147-SSN = WS-HOLD-X147-SSN AND CL199 -00537 X147-EMP-NO = WS-HOLD-X147-EMP-NO AND CL199 -00538 EMPLOYER-FOUND-IND = 'Y' CL199 -00539 DISPLAY ' >> CLAIM FOUND ----: CANNOT DELETE ' CL199 -00540 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 -00541 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 -00542 ADD 1 TO WS-TOTAL-NDEL CL199 -00543 GO TO PROC2000-UI-EXIT. CL199 -00544 CL*91 -00545 MOVE 0 TO ENDOFSEG. CL199 -00546 MOVE 'N' TO EMPLOYER-FOUND-IND. CL199 -00547 CL119 -00548 * PERFORM SERV2000-MASTER THRU CL201 -00549 * SERV2000-EXIT. CL201 -00550 CL119 -00551 CL119 -00552 PERFORM PROC4000-SEARCH-SEG04 THRU CL199 -00553 PROC4000-SEG04-EXIT CL199 -00554 UNTIL CL199 -00555 ENDOFSEG EQUAL 1. CL199 -00556 DTSBX629 -00557 IF EMPLOYER-FOUND-IND = 'Y' CL199 -00558 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 -00559 DISPLAY '>>> CLAIM FOUND --- CANNOT DELETE ' CL199 -00560 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 -00561 ADD 1 TO WS-TOTAL-NDEL CL199 -00562 ELSE CL*87 -00563 DISPLAY ' << EMP NOT FOUND ON DOCS -DELETE ' X147-EMP-NO CL195 -00564 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT. CL*87 -00565 CL*87 -00566 PROC2000-UI-EXIT. DTSBX629 -00567 EXIT. DTSBX629 -00568 CL146 -00569 PROC2100-FIND-SSN. CL146 -00570 * SET DBW-SEQUENTIAL-PROCESSING TO TRUE. CL146 -00571 SET DBW-RANDOM-PROCESSING TO TRUE. CL146 -00572 SET DBW-READ-SEGMENT TO TRUE. CL146 -00573 SET DBW-PROFILE-SEGMENT TO TRUE. CL146 -00574 CL146 -00575 MOVE +0 TO WRK-SEG01-SSN-FOUND CL146 -00576 MOVE X147-SSN TO DBW-SSN CL146 -00577 MOVE SPACES TO DBW-NAME CL146 -00578 CL146 -00579 PERFORM S960-SEG01 THRU S960-EXIT. CL146 -00580 CL146 -00581 IF DBW-NO-RECORD-FOUND CL146 -00582 DISPLAY '## SSN- NOT FOUND IN DOCS SEG01: ' X147-SSN CL194 -00583 GO TO PROC2100-EXIT CL146 -00584 ELSE CL146 -00585 * ADD +1 TO WRK-SEG01-READ-CNT CL149 -00586 DISPLAY '++SSN FOUND ON DOCS SEG01: ' X147-SSN ' ' WGP-SSN. CL194 -00587 *& CL146 -00588 CL146 -00589 SET DBW-RANDOM-PROCESSING TO TRUE. CL146 -00590 SET DBW-WAGE-SEGMENT TO TRUE. CL146 -00591 SET DBW-RESET-POINTERS TO TRUE. CL146 -00592 PERFORM S961-SEG02 THRU S961-EXIT. CL146 -00593 CL146 -00594 PERFORM P2150-SELECT-SSN THRU P2150-EXIT CL146 -00595 UNTIL DBW-NO-RECORD-FOUND. CL146 -00596 CL146 -00597 CL146 -00598 DTSBX629 -00599 PROC2100-EXIT. CL146 -00600 EXIT. CL146 -00601 P2150-SELECT-SSN. CL148 -00602 SET DBW-READ-SEGMENT TO TRUE. CL146 -00603 PERFORM S961-SEG02 THRU S961-EXIT. CL146 -00604 CL146 -00605 IF DBW-NO-RECORD-FOUND CL146 -00606 GO TO P2150-EXIT. CL148 -00607 CL146 -00608 * ADD +1 TO WRK-SEG02-READ-CNT. CL148 -00609 MOVE X147-YR TO WS-X147-YR CL151 -00610 MOVE X147-QTR TO WS-X147-QTR CL151 -00611 CL151 -00612 * DISPLAY 'DOCS SSN ' WGP-SSN ' ' WGD-YR-QTR CL194 -00613 * ' ' WGD-ACCOUNT-NUMBER ' ' WGD-QUARTER-EARNINGS. CL194 -00614 * DISPLAY 'ESSP SSN ' X147-SSN ' ' WS-X147-QUARTER CL194 -00615 * ' ' X147-EMP-NO. CL194 -00616 CL146 -00617 IF WGD-YR-QTR = WS-X147-QUARTER AND CL150 -00618 WGD-ACCOUNT-NUMBER = X147-EMP-NO CL148 -00619 SET DBW-NO-RECORD-FOUND TO TRUE CL153 -00620 * PERFORM P1220-BUILD-W4 THRU P1220-EXIT CL146 -00621 MOVE +1 TO WRK-SEG01-SSN-FOUND CL146 -00622 DISPLAY '++SSN FOUND IN DOCS SEG02: ' X147-SSN CL217 -00623 * PERFORM P1210-EDIT-SSN THRU P1210-EXIT CL146 -00624 * IF WRK-SSN-ERROR-NO-88 CL146 -00625 * GO TO P1200-EXIT CL146 -00626 * PERFORM P1220-BUILD-WGH THRU P1220-EXIT CL146 -00627 * END-IF CL146 -00628 END-IF. CL146 -00629 CL146 -00630 CL146 -00631 P2150-EXIT. CL148 -00632 EXIT. CL146 -00633 CL194 -00634 PROC2200-X144-SSN. CL101 +00487 * CL195 +00488 **** SEARCH DOCS FOR ANY CLAIM ON ESSP SSN MARKED FOR DELETION. CL195 +00489 **** IF CLAIM IS FOUND DO NOT DELETE SSN-- SEND REPORT. CL195 +00490 * CL195 +00491 MOVE 0 TO WS-CLAIM-SSN-FOUND. CL182 +00492 CL194 +00493 * PERFORM PROC2700-FIND-CLAIM THRU PROC2700-EXIT. CL*18 +00494 CL133 +00495 IF WS-CLAIM-SSN-FOUND = 1 CL214 +00496 IF WS-X144-SSN-FOUND = 1 CL214 +00497 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 +00498 DISPLAY ' >> CLAIM FOUND WITH X144: REPLACE WAGES ' CL205 +00499 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL201 +00500 ELSE CL214 +00501 DISPLAY ' >> CLAIM FOUND NO X144: CANNOT DELETE' CL205 +00502 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL216 +00503 PERFORM PROC2600-SAV-SSN THRU PROC2600-EXIT CL207 +00504 ADD 1 TO WS-TOTAL-NDEL CL205 +00505 ELSE CL205 +00506 IF WS-CLAIM-SSN-FOUND = 0 CL214 +00507 IF WS-X144-SSN-FOUND = 1 CL214 +00508 DISPLAY '++ CLAIM NOT FOUND REPLACE WAGES ' X147-EMP-NO CL205 +00509 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL205 +00510 ELSE CL214 +00511 DISPLAY '++ CLAIM NOT FOUND DELETE WAGES ' X147-EMP-NO CL205 +00512 PERFORM PROC2550-DEL-SSN THRU PROC2550-EXIT CL215 +00513 ELSE CL214 +00514 DISPLAY '++ CHECK IF STATEMENT ========= ' X147-EMP-NO. CL215 +00515 CL201 +00516 GO TO PROC2000-UI-EXIT. CL201 +00517 CL182 +00518 IF X147-SSN = WS-HOLD-X147-SSN AND CL199 +00519 X147-EMP-NO = WS-HOLD-X147-EMP-NO AND CL199 +00520 EMPLOYER-FOUND-IND = 'Y' CL199 +00521 DISPLAY ' >> CLAIM FOUND ----: CANNOT DELETE ' CL199 +00522 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 +00523 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 +00524 ADD 1 TO WS-TOTAL-NDEL CL199 +00525 GO TO PROC2000-UI-EXIT. CL199 +00526 CL*91 +00527 MOVE 0 TO ENDOFSEG. CL199 +00528 MOVE 'N' TO EMPLOYER-FOUND-IND. CL199 +00529 CL119 +00530 * PERFORM SERV2000-MASTER THRU CL201 +00531 * SERV2000-EXIT. CL201 +00532 CL119 +00533 CL119 +00534 * PERFORM PROC4000-SEARCH-SEG04 THRU CL*18 +00535 * PROC4000-SEG04-EXIT CL*18 +00536 * UNTIL CL*18 +00537 * ENDOFSEG EQUAL 1. CL*18 +00538 DTSBX629 +00539 IF EMPLOYER-FOUND-IND = 'Y' CL199 +00540 PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT CL199 +00541 DISPLAY '>>> CLAIM FOUND --- CANNOT DELETE ' CL199 +00542 ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER CL199 +00543 ADD 1 TO WS-TOTAL-NDEL CL199 +00544 ELSE CL*87 +00545 DISPLAY ' << EMP NOT FOUND ON DOCS -DELETE ' X147-EMP-NO CL195 +00546 PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT. CL*87 +00547 CL*87 +00548 PROC2000-UI-EXIT. DTSBX629 +00549 EXIT. DTSBX629 +00550 CL146 +00551 PROC2200-X144-SSN. CL101 +00552 CL138 +00553 READ X144SSN-IN INTO Z144-REC CL239 +00554 AT END CL138 +00555 * MOVE 0 TO WS-X144-SSN-FOUND CL218 +00556 DISPLAY '### X144 AT END ' Z144-EMP-NO CL228 +00557 GO TO PROC2200-EXIT. CL138 +00558 CL138 +00559 MOVE 0 TO WS-SAV-X147. CL138 +00560 CL159 +00561 * IF X144-SSN = 999999999 CL228 +00562 * MOVE 2 TO WS-X144-SSN-FOUND CL228 +00563 * GO TO PROC2200-EXIT. CL228 +00564 CL159 +00565 * DISPLAY '### X144 ' CL174 +00566 * X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL174 +00567 * DISPLAY '### X147 ' CL174 +00568 * X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL174 +00569 CL163 +00570 * IF X144-SSN = X147-SSN CL174 +00571 * DISPLAY '### MATCHING X144 SSN ' CL174 +00572 CL163 +00573 * DISPLAY '### X144 EMP: ' CL238 +00574 * ' ' Z144-EMP-NO ' ' Z144-QUARTER. CL238 +00575 * DISPLAY '### X147 EMP: ' CL238 +00576 * ' ' Z147-EMP-NO ' '. CL238 +00577 CL138 +00578 IF Z144-EMP-NO = Z147-EMP-NO AND Z144-QUARTER = 20181 CL237 +00579 MOVE 1 TO WS-X144-SSN-FOUND CL138 +00580 DISPLAY '### MISSING TDEC RPT FOUND: ' CL228 +00581 ' ' Z144-EMP-NO ' ' Z144-QUARTER CL235 +00582 GO TO PROC2200-EXIT. CL138 +00583 CL138 +00584 IF Z144-EMP-NO > Z147-EMP-NO CL228 +00585 MOVE 0 TO WS-X144-SSN-FOUND CL138 +00586 GO TO PROC2200-EXIT. CL138 +00587 CL138 +00588 IF Z144-EMP-NO < Z147-EMP-NO CL228 +00589 GO TO PROC2200-X144-SSN. CL138 +00590 CL138 +00591 * IF X144-QUARTER > X147-QUARTER CL226 +00592 * MOVE 0 TO WS-X144-SSN-FOUND CL226 +00593 * GO TO PROC2200-EXIT. CL226 +00594 CL157 +00595 * IF X144-QUARTER < X147-QUARTER CL226 +00596 * GO TO PROC2200-X144-SSN. CL226 +00597 CL138 +00598 CL138 +00599 * IF X144-SSN > X147-SSN CL226 +00600 * MOVE 0 TO WS-X144-SSN-FOUND CL226 +00601 * GO TO PROC2200-EXIT. CL226 +00602 CL138 +00603 * IF X144-SSN < X147-SSN CL226 +00604 * GO TO PROC2200-X144-SSN. CL226 +00605 CL138 +00606 * DISPLAY '### MATCHING X147 SSN FOUND ' CL119 +00607 * ' ' X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL119 +00608 PROC2200-EXIT. CL101 +00609 EXIT. CL101 +00610 CL101 +00611 PROC2250-X140-RPT. CL138 +00612 CL138 +00613 MOVE 0 TO WS-X140-RPT-FOUND CL239 +00614 READ X140RPT-IN INTO X140-REC CL239 +00615 AT END CL239 +00616 MOVE 0 TO WS-X140-RPT-FOUND CL239 +00617 GO TO PROC2250-EXIT. CL194 +00618 CL138 +00619 MOVE 0 TO WS-SAV-X147. CL138 +00620 CL194 +00621 MOVE X140-QUARTER-YY TO WS-X140-YR CL240 +00622 MOVE X140-QUARTER-Q TO WS-X140-QTR CL240 +00623 CL240 +00624 * DISPLAY '### TDEC ' Z144-EMP-NO ' ' Z144-QUARTER. CL*14 +00625 * DISPLAY '### ESSP ' X140-EMP-NO ' ' WS-X140-QUARTER. CL*14 +00626 * 'X144 ' X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL138 +00627 CL138 +00628 MOVE WS-X140-QUARTER TO W-X140-REPORT-QTR. CL**4 +00629 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL**4 +00630 IF X140-EMP-NO = Z144-EMP-NO CL239 +00631 AND WS-X140-QUARTER = Z144-QUARTER CL240 +00632 MOVE 1 TO WS-X140-RPT-FOUND CL138 +00633 * DISPLAY 'P2250; RPT FOUND= ' WS-X140-RPT-FOUND CL*14 +00634 GO TO PROC2250-EXIT. CL138 00635 CL138 -00636 READ X144SSN-IN INTO Z144-REC CL239 -00637 AT END CL138 -00638 * MOVE 0 TO WS-X144-SSN-FOUND CL218 -00639 DISPLAY '### X144 AT END ' Z144-EMP-NO CL228 -00640 GO TO PROC2200-EXIT. CL138 -00641 CL138 -00642 MOVE 0 TO WS-SAV-X147. CL138 -00643 CL159 -00644 * IF X144-SSN = 999999999 CL228 -00645 * MOVE 2 TO WS-X144-SSN-FOUND CL228 -00646 * GO TO PROC2200-EXIT. CL228 -00647 CL159 -00648 * DISPLAY '### X144 ' CL174 -00649 * X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL174 -00650 * DISPLAY '### X147 ' CL174 -00651 * X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL174 -00652 CL163 -00653 * IF X144-SSN = X147-SSN CL174 -00654 * DISPLAY '### MATCHING X144 SSN ' CL174 -00655 CL163 -00656 * DISPLAY '### X144 EMP: ' CL238 -00657 * ' ' Z144-EMP-NO ' ' Z144-QUARTER. CL238 -00658 * DISPLAY '### X147 EMP: ' CL238 -00659 * ' ' Z147-EMP-NO ' '. CL238 -00660 CL138 -00661 IF Z144-EMP-NO = Z147-EMP-NO AND Z144-QUARTER = 20181 CL237 -00662 MOVE 1 TO WS-X144-SSN-FOUND CL138 -00663 DISPLAY '### MISSING TDEC RPT FOUND: ' CL228 -00664 ' ' Z144-EMP-NO ' ' Z144-QUARTER CL235 -00665 GO TO PROC2200-EXIT. CL138 -00666 CL138 -00667 IF Z144-EMP-NO > Z147-EMP-NO CL228 -00668 MOVE 0 TO WS-X144-SSN-FOUND CL138 -00669 GO TO PROC2200-EXIT. CL138 -00670 CL138 -00671 IF Z144-EMP-NO < Z147-EMP-NO CL228 -00672 GO TO PROC2200-X144-SSN. CL138 -00673 CL138 -00674 * IF X144-QUARTER > X147-QUARTER CL226 -00675 * MOVE 0 TO WS-X144-SSN-FOUND CL226 -00676 * GO TO PROC2200-EXIT. CL226 -00677 CL157 -00678 * IF X144-QUARTER < X147-QUARTER CL226 -00679 * GO TO PROC2200-X144-SSN. CL226 -00680 CL138 -00681 CL138 -00682 * IF X144-SSN > X147-SSN CL226 -00683 * MOVE 0 TO WS-X144-SSN-FOUND CL226 -00684 * GO TO PROC2200-EXIT. CL226 -00685 CL138 -00686 * IF X144-SSN < X147-SSN CL226 -00687 * GO TO PROC2200-X144-SSN. CL226 -00688 CL138 -00689 * DISPLAY '### MATCHING X147 SSN FOUND ' CL119 -00690 * ' ' X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN. CL119 -00691 PROC2200-EXIT. CL101 -00692 EXIT. CL101 -00693 CL101 -00694 PROC2250-X140-RPT. CL138 -00695 CL138 -00696 MOVE 0 TO WS-X140-RPT-FOUND CL239 -00697 READ X140RPT-IN INTO X140-REC CL239 -00698 AT END CL239 -00699 MOVE 0 TO WS-X140-RPT-FOUND CL239 -00700 GO TO PROC2250-EXIT. CL194 -00701 CL138 -00702 MOVE 0 TO WS-SAV-X147. CL138 -00703 CL194 -00704 MOVE X140-QUARTER-YY TO WS-X140-YR CL240 -00705 MOVE X140-QUARTER-Q TO WS-X140-QTR CL240 -00706 CL240 -00707 * DISPLAY '### TDEC ' Z144-EMP-NO ' ' Z144-QUARTER. CL*14 -00708 * DISPLAY '### ESSP ' X140-EMP-NO ' ' WS-X140-QUARTER. CL*14 -00709 * 'X144 ' X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN. CL138 -00710 CL138 -00711 MOVE WS-X140-QUARTER TO W-X140-REPORT-QTR. CL**4 -00712 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL**4 -00713 IF X140-EMP-NO = Z144-EMP-NO CL239 -00714 AND WS-X140-QUARTER = Z144-QUARTER CL240 -00715 MOVE 1 TO WS-X140-RPT-FOUND CL138 -00716 * DISPLAY 'P2250; RPT FOUND= ' WS-X140-RPT-FOUND CL*14 -00717 GO TO PROC2250-EXIT. CL138 -00718 CL138 -00719 IF X140-EMP-NO > Z144-EMP-NO CL253 -00720 MOVE 0 TO WS-X140-RPT-FOUND CL138 -00721 GO TO PROC2250-EXIT. CL138 -00722 CL138 -00723 IF X140-EMP-NO < Z144-EMP-NO CL253 -00724 GO TO PROC2250-X140-RPT. CL143 -00725 CL138 -00726 IF WS-X140-QUARTER > Z144-QUARTER CL253 -00727 MOVE 0 TO WS-X140-RPT-FOUND CL138 -00728 GO TO PROC2250-EXIT. CL142 -00729 CL138 -00730 IF WS-X140-QUARTER < Z144-QUARTER CL253 -00731 GO TO PROC2250-X140-RPT. CL143 -00732 CL138 -00733 PROC2250-EXIT. CL138 -00734 EXIT. CL138 -00735 PROC2275-MPRF-RPT. CL**4 -00736 CL**4 -00737 MOVE 0 TO WS-X140-RPT-FOUND CL**4 -00738 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL**4 -00739 * MOVE X140-EMP-NO TO MRPT-EMP-NO. CL*15 -00740 * MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL*15 -00741 MOVE Z144-EMP-NO TO MRPT-EMP-NO. CL*15 -00742 MOVE Z144-QUARTER TO MRPT-YRQ. CL*15 -00743 MOVE ZEROS TO MRPT-BATCH-NO. CL**4 -00744 MOVE ZEROS TO MRPT-ITEM-NO CL**4 -00745 CL**4 -00746 SET MRPT-RPT-88 TO TRUE. CL**4 -00747 MOVE MRPT-REC TO MSKL-REC. CL**4 -00748 CL**4 -00749 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 -00750 IF L910-OK-88 CL**4 -00751 PERFORM P2016-SCAN-MRPT THRU P2016-EXIT CL**4 -00752 UNTIL L910-NO-REC-88 CL**4 -00753 ELSE CL**4 -00754 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 -00755 MOVE 0 TO WS-X140-RPT-FOUND CL*15 -00756 DISPLAY 'X629 RPT NOT ON DUTAS- ' CL*15 -00757 X140-EMP-NO ' ' W-X140-REPORT-QTR CL**7 -00758 DISPLAY ' ' CL**4 -00759 DISPLAY ' '. CL**4 -00760 CL**4 -00761 CL**4 -00762 PROC2275-EXIT. CL**4 -00763 EXIT. CL**4 -00764 CL**4 -00765 P2016-SCAN-MRPT. CL**4 -00766 MOVE MSKL-REC TO MRPT-REC. CL**4 -00767 IF MRPT-YRQ = Z144-QUARTER CL*15 -00768 MOVE 1 TO WS-X140-RPT-FOUND CL**4 -00769 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 -00770 SET L910-NO-REC-88 TO TRUE CL**4 -00771 GO TO P2016-EXIT CL**4 -00772 ELSE CL**4 -00773 IF MRPT-YRQ > Z144-QUARTER CL*15 -00774 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 -00775 SET L910-NO-REC-88 TO TRUE CL**4 -00776 GO TO P2016-EXIT CL**4 -00777 ELSE CL**4 -00778 GO TO P2016-READ-NEXT CL**4 -00779 END-IF CL**4 -00780 END-IF. CL**4 -00781 CL**4 -00782 * IF MRPT-ORIG-88 CL**4 -00783 * SET W-RPT-ERROR-YES-88 TO TRUE CL**4 -00784 * SET L910-NO-REC-88 TO TRUE CL**4 -00785 * MOVE SPACES TO R140-MESSAGE CL**4 -00786 * MOVE W-EMP-NO TO R140-EMP-NO CL**4 -00787 * STRING CL**4 -00788 * ':-----FAILED - RPT EXIST IN DUTAS ' CL**4 -00789 * X140-QUARTER CL**4 -00790 * DELIMITED BY SIZE CL**4 -00791 * INTO R140-MESSAGE CL**4 -00792 * END-STRING CL**4 -00793 * MOVE R140-MESSAGE TO X434-MESSAGE CL**4 -00794 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 -00795 * GO TO P2016-EXIT CL**4 -00796 * END-IF. CL**4 -00797 CL**4 -00798 CL**4 -00799 P2016-READ-NEXT. CL**4 -00800 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 -00801 IF L910-NO-REC-88 CL**4 -00802 SET W-RPT-ERROR-NO-88 TO TRUE. CL**4 -00803 P2016-EXIT. CL**4 -00804 CL**4 -00805 CL**4 -00806 CL138 -00807 CL**4 -00808 PROC2500-DEL-SSN. CL*87 -00809 CL*87 -00810 * WRITE X147-RECORD-OUTA FROM X144-REC. CL125 -00811 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 -00812 ADD 1 TO WS-TOTAL-DELQ. CL113 -00813 CL129 -00814 IF WS-SAV-X147 = 1 CL129 -00815 GO TO PROC2500-EXIT. CL129 -00816 CL129 -00817 MOVE X147-SSN TO WS-INPUT-SSN. CL126 -00818 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL244 -00819 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL244 -00820 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL244 -00821 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL244 -00822 CL126 -00823 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL244 -00824 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL244 -00825 * MOVE X147-FNAME TO WS-OUT-FNAME. CL244 -00826 * MOVE X147-LNAME TO WS-OUT-LNAME. CL244 -00827 * MOVE X147-WAGES TO WS-OUT-WAGES. CL244 -00828 * IF WS-X144-SSN-FOUND = 1 CL244 -00829 * MOVE 'Y ' TO WS-OUT-X144 CL244 -00830 * ELSE CL244 -00831 * MOVE 'N ' TO WS-OUT-X144. CL244 -00832 * IF WS-X140-RPT-FOUND = 1 CL244 -00833 * MOVE 'Y ' TO WS-OUT-X140 CL244 -00834 * ELSE CL244 -00835 * MOVE 'N ' TO WS-OUT-X140. CL244 -00836 IF WS-CLAIM-SSN-FOUND = 1 CL205 -00837 MOVE '++CLAIM FOUND WAGES REPLACED' TO WS-OUT-MESSAGE CL205 -00838 ELSE CL205 -00839 MOVE '++NO CLAIM -- WAGES REPLACED' TO WS-OUT-MESSAGE. CL205 -00840 CL126 -00841 ADD 1 TO LINE-COUNT. CL206 -00842 WRITE PRINT-RECORD FROM WS-OUTPUT. CL206 -00843 PROC2500-EXIT. CL*87 -00844 EXIT. CL*87 -00845 CL*87 -00846 CL201 -00847 PROC2550-DEL-SSN. CL201 -00848 CL201 -00849 * WRITE X147-RECORD-OUTA FROM X144-REC. CL201 -00850 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 -00851 ADD 1 TO WS-TOTAL-DELQ. CL201 -00852 CL201 -00853 IF WS-SAV-X147 = 1 CL201 -00854 GO TO PROC2500-EXIT. CL201 -00855 CL201 -00856 MOVE X147-SSN TO WS-INPUT-SSN. CL201 -00857 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 -00858 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 -00859 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 -00860 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 -00861 CL201 -00862 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 -00863 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 -00864 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 -00865 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 -00866 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 -00867 * IF WS-X144-SSN-FOUND = 1 CL245 -00868 * MOVE 'Y ' TO WS-OUT-X144 CL245 -00869 * ELSE CL245 -00870 * MOVE 'N ' TO WS-OUT-X144. CL245 -00871 * IF WS-X140-RPT-FOUND = 1 CL245 -00872 * MOVE 'Y ' TO WS-OUT-X140 CL245 -00873 * ELSE CL245 -00874 * MOVE 'N ' TO WS-OUT-X140. CL245 -00875 * MOVE 'WAGES ---DELETED ' TO WS-OUT-MESSAGE. CL245 -00876 CL201 -00877 ADD 1 TO LINE-COUNT. CL210 -00878 WRITE PRINT-RECORD FROM WS-OUTPUT. CL210 -00879 PROC2550-EXIT. CL201 -00880 EXIT. CL201 -00881 CL201 -00882 CL123 -00883 PROC2600-SAV-SSN. CL123 -00884 CL123 -00885 MOVE 0 TO WS-SAV-X147. CL129 -00886 * WRITE X147-RECORD-OUTB FROM X147-REC. CL229 -00887 MOVE X147-SSN TO WS-INPUT-SSN. CL126 -00888 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 -00889 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 -00890 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 -00891 * MOVE CPD-SSN-SEQ TO WS-OUT-SEQ. CL245 -00892 CL126 -00893 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 -00894 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 -00895 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 -00896 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 -00897 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 -00898 * IF WS-X144-SSN-FOUND = 1 CL245 -00899 * MOVE 'Y ' TO WS-OUT-X144 CL245 -00900 * ELSE CL245 -00901 * MOVE 'N ' TO WS-OUT-X144. CL245 -00902 * IF WS-X140-RPT-FOUND = 1 CL245 -00903 * MOVE 'Y ' TO WS-OUT-X140 CL245 -00904 * ELSE CL245 -00905 * MOVE 'N ' TO WS-OUT-X140. CL245 -00906 * IF WRK-SEG01-SSN-FOUND = 0 CL245 -00907 * MOVE '++ X147 NOT FOUND IN DOCS -ESSP VERIFY' CL245 -00908 * TO WS-OUT-MESSAGE CL245 -00909 * ELSE CL245 -00910 * MOVE '++ CLAIM FOUND NO WAGES CANNOT DELETE ' CL245 -00911 * TO WS-OUT-MESSAGE. CL245 -00912 * MOVE 1 TO WS-SAV-X147. CL245 -00913 * ADD 1 TO LINE-COUNT. CL245 -00914 WRITE PRINT-RECORD FROM WS-OUTPUT. CL126 -00915 PROC2600-EXIT. CL123 -00916 EXIT. CL123 -00917 CL123 -00918 PROC2700-FIND-CLAIM. CL179 -00919 MOVE X147-SSN TO WS-XSSN CL179 -00920 MOVE WS-X147-SSN-NO TO DB-SSN. CL179 -00921 MOVE ZERO TO DB-SEQ-9. CL179 -00922 CL179 -00923 MOVE ZEROS TO WS-HOLD-X147-SSN CL181 -00924 SET DB-RANDOM-PROCESSING TO TRUE. CL180 -00925 SET DB-READ-SEGMENT TO TRUE. CL180 -00926 SET DB-CLAIMANT-PROFILE TO TRUE. CL181 -00927 SET DB-RESET-POINTERS TO TRUE. CL184 -00928 MOVE 'R' TO DB-PROCESSING-MODE. CL179 -00929 MOVE 'SG01' TO DB-SEGNAME. CL179 -00930 CL179 -00931 PERFORM SERV1000-MASTER THRU CL179 -00932 SERV1000-EXIT. CL179 -00933 CL179 -00934 IF DB-END-OF-FILE CL194 -00935 DISPLAY '++ESSN NOT FOUND ON DOCS - DELETE ' X147-SSN CL195 -00936 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL194 -00937 GO TO PROC2700-EXIT. CL194 -00938 CL179 -00939 IF DB-NO-RECORD-FOUND CL186 -00940 DISPLAY '++DSSN NOT FOUND ON DOCS - DELETE ' X147-SSN CL195 -00941 * PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT CL187 -00942 GO TO PROC2700-EXIT. CL179 -00943 CL181 -00944 PERFORM UNTIL DB-NO-RECORD-FOUND OR CPD-SSN > X147-SSN CL186 -00945 * PERFORM UNTIL NOT DB-SUCCESSFUL-COMPLETION CL185 -00946 * ADD +1 TO WRK-SEG01-READ-CNT CL183 -00947 PERFORM P2750-PROCESS-CLAIM THRU P2750-EXIT CL181 -00948 SET DB-SEQUENTIAL-PROCESSING TO TRUE CL181 -00949 SET DB-CLAIMANT-PROFILE TO TRUE CL181 -00950 SET DB-READ-SEGMENT TO TRUE CL181 -00951 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION CL181 -00952 END-PERFORM. CL181 -00953 CL181 -00954 CL181 -00955 PROC2700-EXIT. CL181 -00956 EXIT. CL181 -00957 CL179 -00958 P2750-PROCESS-CLAIM. CL181 -00959 IF CPD-ALTERNATE-BASE-YES CL179 -00960 MOVE CPD-ALT-BASE-PERIOD-QTR TO WS-DOCS-BASE-QTR CL179 -00961 ELSE CL179 -00962 MOVE CPD-BASE-PERIOD-QTR-CODE TO WS-DOCS-BASE-QTR. CL179 -00963 CL179 -00964 IF WS-DOCS-BASE-QTR-Q = 1 CL188 -00965 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 -00966 ADD +1 TO WS-DOCS-BASE-QTR1-Q CL189 -00967 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 -00968 ADD +2 TO WS-DOCS-BASE-QTR2-Q CL189 -00969 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3 CL188 -00970 ADD +3 TO WS-DOCS-BASE-QTR3-Q CL189 -00971 ELSE CL188 -00972 IF WS-DOCS-BASE-QTR-Q = 2 CL188 -00973 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 -00974 ADD +1 TO WS-DOCS-BASE-QTR1-Q CL189 -00975 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 -00976 ADD +2 TO WS-DOCS-BASE-QTR2-Q CL189 -00977 ADD +1 TO WS-DOCS-BASE-QTR-Y CL188 -00978 MOVE +1 TO WS-DOCS-BASE-QTR-Q CL188 -00979 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3 CL188 -00980 ELSE CL188 -00981 IF WS-DOCS-BASE-QTR-Q = 3 CL188 -00982 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 -00983 ADD +1 TO WS-DOCS-BASE-QTR1-Q CL189 -00984 ADD +1 TO WS-DOCS-BASE-QTR-Y CL188 -00985 MOVE +1 TO WS-DOCS-BASE-QTR-Q CL188 -00986 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 -00987 ADD +1 TO WS-DOCS-BASE-QTR-Q CL188 -00988 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3 CL188 -00989 ELSE CL188 -00990 IF WS-DOCS-BASE-QTR-Q = 4 CL188 -00991 ADD +1 TO WS-DOCS-BASE-QTR-Y CL188 -00992 MOVE +1 TO WS-DOCS-BASE-QTR-Q CL188 -00993 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR1 CL188 -00994 ADD +1 TO WS-DOCS-BASE-QTR-Q CL188 -00995 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR2 CL188 -00996 ADD +1 TO WS-DOCS-BASE-QTR-Q CL188 -00997 MOVE WS-DOCS-BASE-QTR TO WS-DOCS-BASE-QTR3. CL188 -00998 CL188 -00999 MOVE X147-QUARTER TO WS-X147-QTR-ESSP. CL179 -01000 MOVE WS-X147-EYY TO WS-X147-YY CL179 -01001 MOVE WS-X147-EQ TO WS-X147-Q CL179 -01002 CL179 -01003 IF CPD-ALTERNATE-BASE-YES CL193 -01004 MOVE CPD-ALT-BASE-PERIOD-QTR TO WS-DOCS-BASE-QTR CL193 -01005 ELSE CL193 -01006 MOVE CPD-BASE-PERIOD-QTR-CODE TO WS-DOCS-BASE-QTR. CL193 -01007 CL194 -01008 DISPLAY ' DOCS BASE QTR: ' WS-DOCS-BASE-QTR. CL193 -01009 DISPLAY ' CPD BASE QTR: ' CPD-BASE-PERIOD-QTR-CODE CL193 -01010 DISPLAY ' CPD ALTB QTR: ' CPD-ALT-BASE-PERIOD-QTR. CL193 -01011 CL193 -01012 DISPLAY '*ESSP: ' X147-SSN ' ' WS-X147-QTR-DELETE CL194 -01013 DISPLAY 'DOCSB: ' CPD-SSN ' ' WS-DOCS-BASE-QTR CL184 -01014 DISPLAY 'DOCS1: ' CPD-SSN ' ' WS-DOCS-BASE-QTR1 CL186 -01015 DISPLAY 'DOCS2: ' CPD-SSN ' ' WS-DOCS-BASE-QTR2 CL186 -01016 DISPLAY 'DOCS3: ' CPD-SSN ' ' WS-DOCS-BASE-QTR3. CL186 -01017 CL179 -01018 IF WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR OR CL179 -01019 WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR1 OR CL179 -01020 WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR2 OR CL179 -01021 WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR3 CL179 -01022 MOVE X147-SSN TO WS-HOLD-X147-SSN CL179 -01023 SET DB-NO-RECORD-FOUND TO TRUE CL185 -01024 MOVE 1 TO WS-CLAIM-SSN-FOUND CL186 -01025 DISPLAY '## SSN FOUND ON DOCS - BASE CLAIM ' X147-SSN. CL195 -01026 CL179 -01027 CL179 -01028 P2750-EXIT. CL181 -01029 EXIT. CL179 -01030 ******************************************************************DTSBX629 -01031 * PROC3000-READ-MASTER-FILE *DTSBX629 -01032 ******************************************************************DTSBX629 -01033 DTSBX629 -01034 PROC3000-READ-MASTER-FILE. DTSBX629 -01035 DTSBX629 -01036 MOVE 0 TO WS-X144-SSN-FOUND. CL116 -01037 MOVE 0 TO WS-X140-RPT-FOUND. CL138 -01038 CL116 -01039 READ X144SSN-IN INTO Z144-REC CL239 -01040 AT END DTSBX629 -01041 MOVE 'Y' TO MASTER-END-IND CL*63 -01042 GO TO PROC3000-READ-EXIT. DTSBX629 -01043 DTSBX629 -01044 * IF X147-EMP-NO = WS-X147-EMP-NO CL227 -01045 * AND X147-QUARTER = WS-X147-QUARTER CL227 -01046 * MOVE 3 TO WS-X144-SSN-FOUND CL227 -01047 * ELSE CL227 -01048 * MOVE X147-SSN TO WS-X147-SSN CL227 -01049 * MOVE X147-EMP-NO TO WS-X147-EMP-NO CL227 -01050 * MOVE X147-QUARTER TO WS-X147-QUARTER. CL227 -01051 ADD 1 TO MASTER-READ-COUNT. DTSBX629 -01052 DTSBX629 -01053 PROC3000-READ-EXIT. DTSBX629 -01054 EXIT. DTSBX629 -01055 DTSBX629 -01056 DTSBX629 -01057 ******************************************************************DTSBX629 -01058 * PROC4000-SEARCH-SEG04 * CL*87 -01059 ******************************************************************DTSBX629 -01060 DTSBX629 -01061 PROC4000-SEARCH-SEG04. CL*87 -01062 DTSBX629 -01063 SET DB-RANDOM-PROCESSING TO TRUE. CL195 -01064 * SET DB-READ-SEGMENT TO TRUE. CL199 -01065 SET DB-BASE-PERIOD-EMP TO TRUE. CL195 -01066 SET DB-RESET-POINTERS TO TRUE. CL195 -01067 * MOVE X147-EMP-NO TO BPE-EMPLOYER-ACCT CL199 -01068 MOVE 'SG04' TO DB-SEGNAME. CL*87 -01069 DTSBX629 -01070 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL195 -01071 CL195 -01072 * PERFORM SERV1000-MASTER THRU CL195 -01073 * SERV1000-EXIT. CL195 -01074 DTSBX629 -01075 DISPLAY 'BPE EMP NO: ' BPE-EMPLOYER-ACCT CL197 -01076 * IF DB-NO-RECORD-FOUND OR DB-END-OF-FILE CL200 -01077 * DISPLAY '#1 EMP NOT FOUND ON DOCS CLAIM: ' X147-EMP-NO CL200 -01078 * MOVE 1 TO ENDOFSEG CL200 -01079 * GO TO PROC4000-SEG04-EXIT. CL200 -01080 CL195 -01081 PERFORM UNTIL DB-NO-RECORD-FOUND OR CL199 -01082 DB-END-OF-FILE CL199 -01083 SET DB-RANDOM-PROCESSING TO TRUE CL201 -01084 * SET DB-SEQUENTIAL-PROCESSING TO TRUE CL201 -01085 SET DB-BASE-PERIOD-EMP TO TRUE CL195 -01086 SET DB-READ-SEGMENT TO TRUE CL195 -01087 CL195 -01088 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION CL195 -01089 CL197 -01090 * DISPLAY 'BPE EMP NO: ' BPE-EMPLOYER-ACCT CL199 -01091 IF DB-SUCCESSFUL-COMPLETION AND CL197 -01092 BPE-EMPLOYER-ACCT = X147-EMP-NO CL197 -01093 DISPLAY '## BPEEMP FOUND ON DOCS CLAIM: ' X147-EMP-NO CL199 -01094 MOVE 1 TO ENDOFSEG CL197 -01095 MOVE X147-EMP-NO TO WS-HOLD-X147-EMP-NO CL197 -01096 MOVE 'Y' TO EMPLOYER-FOUND-IND CL198 -01097 SET DB-END-OF-FILE TO TRUE CL197 -01098 SET DB-NO-RECORD-FOUND TO TRUE CL197 -01099 ELSE CL195 -01100 IF NOT DB-NO-RECORD-FOUND OR CL197 -01101 DB-END-OF-FILE CL199 -01102 * BPE-EMPLOYER-ACCT > X147-EMP-NO CL199 -01103 DISPLAY '#2 EMP NOT FOUND ON DOCS CLAIM: ' X147-EMP-NO CL200 -01104 SET DB-END-OF-FILE TO TRUE CL197 -01105 SET DB-NO-RECORD-FOUND TO TRUE CL197 -01106 END-IF CL195 -01107 END-IF CL195 -01108 CL195 -01109 END-PERFORM. CL195 -01110 DTSBX629 -01111 * IF BPE-EMPLOYER-ACCT = X147-EMP-NO CL197 -01112 * MOVE 1 TO ENDOFSEG CL197 -01113 * MOVE X147-EMP-NO TO WS-HOLD-X147-EMP-NO CL197 -01114 * MOVE 'Y' TO EMPLOYER-FOUND-IND. CL197 -01115 CL*25 -01116 PROC4000-SEG04-EXIT. CL*87 -01117 EXIT. DTSBX629 -01118 DTSBX629 -01119 ******************************************************************DTSBX629 -01120 * PROC5000-WRITE-RECORD-PAID *DTSBX629 -01121 ******************************************************************DTSBX629 -01122 DTSBX629 -01123 DTSBX629 -01124 PROC5000-X147-NOT-DELETED. CL*94 -01125 MOVE X147-SSN TO WS-INPUT-SSN. CL*92 -01126 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 -01127 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 -01128 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 -01129 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 -01130 * CL245 -01131 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 -01132 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 -01133 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 -01134 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 -01135 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 -01136 * MOVE 'Y ' TO WS-OUT-X144. CL245 -01137 * MOVE '++ CLAIM FOUND ON DOCS - VERIFY' TO WS-OUT-MESSAGE. CL245 -01138 DTSBX629 -01139 * IF LINE-COUNT GREATER 55 CL*74 -01140 * MOVE ZEROES TO LINE-COUNT CL*74 -01141 ADD 1 TO LINE-COUNT. CL126 -01142 WRITE PRINT-RECORD FROM WS-OUTPUT. CL*92 -01143 PROC5000-EXIT. CL*94 -01144 EXIT. DTSBX629 -01145 DTSBX629 -01146 CL*69 -01147 S910-OPEN-READ. CL**4 -01148 SET L910-OPEN-READ-88 TO TRUE. CL**4 -01149 GO TO S910-MSTR-IO. CL**4 -01150 CL**4 -01151 S910-READ. CL**4 -01152 SET L910-READ-88 TO TRUE. CL**4 -01153 GO TO S910-MSTR-IO. CL**4 -01154 CL**4 -01155 S910-START-BROWSE. CL**4 -01156 SET L910-START-BROWSE-88 TO TRUE. CL**4 -01157 GO TO S910-MSTR-IO. CL**4 -01158 CL**4 -01159 S910-READ-NEXT. CL**4 -01160 SET L910-READ-NEXT-88 TO TRUE. CL**4 -01161 GO TO S910-MSTR-IO. CL**4 -01162 CL**4 -01163 S910-CLOSE. CL**4 -01164 SET L910-CLOSE-88 TO TRUE. CL**4 -01165 GO TO S910-MSTR-IO. CL**4 -01166 CL**4 -01167 S910-MSTR-IO. CL**4 -01168 CALL 'DTSBU910' USING L910-LINK-AREA CL**4 -01169 MSKL-REC. CL**4 -01170 S910-EXIT. CL**4 -01171 EXIT. CL**4 -01172 CL**4 -01173 S001-FROM-CAL-6. CL**4 -01174 SET L001-FROM-CAL-6 TO TRUE. CL*55 -01175 GO TO S001-DATE-CONVERT. CL*55 -01176 CL*55 -01177 S001-FROM-ABS-DAY. CL*55 -01178 SET L001-FROM-ABS-DAY TO TRUE. CL*55 -01179 GO TO S001-DATE-CONVERT. CL*55 -01180 CL*55 -01181 S001-DATE-CONVERT. CL*55 -01182 CALL 'DTSBU001' USING L001-LINK-AREA. CL*55 -01183 S001-EXIT. CL*55 -01184 EXIT. CL*55 -01185 SKIP3 CL*55 -01186 S999-ABEND. CL*55 -01187 DISPLAY '*** ' CL*55 -01188 WRK-MODULE-NAME CL*55 -01189 ' IS ABENDING: ' CL*55 -01190 WRK-ABEND-MSG. CL*55 -01191 CL*55 -01192 CALL 'DTSBU999' USING WRK-ABEND-CD. CL*55 -01193 S999-EXIT. CL*55 -01194 EXIT. CL*55 -01195 ******************************************************************DTSBX629 -01196 * READ FILES *DTSBX629 -01197 ******************************************************************DTSBX629 -01198 CL145 -01199 S960-SEG01. CL145 -01200 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK CL145 -01201 WGP-SEGMENT-ONE. CL145 -01202 S960-EXIT. CL145 -01203 EXIT. CL145 -01204 S961-SEG02. CL145 -01205 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK CL145 -01206 WGD-SEGMENT-TWO. CL145 -01207 S961-EXIT. CL145 -01208 EXIT. CL145 -01209 DTSBX629 -01210 ******************************************************************DTSBX629 -01211 * SERVICE ROUTINES *DTSBX629 -01212 ******************************************************************DTSBX629 -01213 DTSBX629 -01214 SERV1000-MASTER. DTSBX629 -01215 DTSBX629 -01216 MOVE 'R' TO DB-COMMAND-CODE. DTSBX629 -01217 DTSBX629 -01218 MOVE 'DTSBX551' TO DB-PROGRAM-NAME. CL195 -01219 DTSBX629 -01220 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. DTSBX629 -01221 DTSBX629 -01222 SERV1000-EXIT. DTSBX629 -01223 EXIT. DTSBX629 -01224 CL119 -01225 SERV2000-MASTER. CL119 -01226 CL119 -01227 MOVE 'S' TO DB-COMMAND-CODE. CL119 -01228 CL119 -01229 MOVE 'DTSBX551' TO DB-PROGRAM-NAME. CL195 -01230 CL119 -01231 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL119 -01232 CL119 -01233 SERV2000-EXIT. CL119 -01234 EXIT. CL119 -01235 S9999-ABEND. CL*78 -01236 SKIP1 CL*78 -01237 CALL 'DTSBU999' USING WRK-ABEND-CODE. CL*78 -01238 SKIP1 CL*78 -01239 S9999-EXIT. CL*78 -01240 EXIT. CL*78 +00636 IF X140-EMP-NO > Z144-EMP-NO CL253 +00637 MOVE 0 TO WS-X140-RPT-FOUND CL138 +00638 GO TO PROC2250-EXIT. CL138 +00639 CL138 +00640 IF X140-EMP-NO < Z144-EMP-NO CL253 +00641 GO TO PROC2250-X140-RPT. CL143 +00642 CL138 +00643 IF WS-X140-QUARTER > Z144-QUARTER CL253 +00644 MOVE 0 TO WS-X140-RPT-FOUND CL138 +00645 GO TO PROC2250-EXIT. CL142 +00646 CL138 +00647 IF WS-X140-QUARTER < Z144-QUARTER CL253 +00648 GO TO PROC2250-X140-RPT. CL143 +00649 CL138 +00650 PROC2250-EXIT. CL138 +00651 EXIT. CL138 +00652 PROC2275-MPRF-RPT. CL**4 +00653 CL**4 +00654 MOVE 0 TO WS-X140-RPT-FOUND CL**4 +00655 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL**4 +00656 * MOVE X140-EMP-NO TO MRPT-EMP-NO. CL*15 +00657 * MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL*15 +00658 MOVE Z144-EMP-NO TO MRPT-EMP-NO. CL*15 +00659 MOVE Z144-QUARTER TO MRPT-YRQ. CL*15 +00660 MOVE ZEROS TO MRPT-BATCH-NO. CL**4 +00661 MOVE ZEROS TO MRPT-ITEM-NO CL**4 +00662 CL**4 +00663 SET MRPT-RPT-88 TO TRUE. CL**4 +00664 MOVE MRPT-REC TO MSKL-REC. CL**4 +00665 CL**4 +00666 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 +00667 IF L910-OK-88 CL**4 +00668 PERFORM P2016-SCAN-MRPT THRU P2016-EXIT CL**4 +00669 UNTIL L910-NO-REC-88 CL**4 +00670 ELSE CL**4 +00671 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 +00672 MOVE 0 TO WS-X140-RPT-FOUND CL*15 +00673 DISPLAY 'X629 RPT NOT ON DUTAS- ' CL*15 +00674 X140-EMP-NO ' ' W-X140-REPORT-QTR CL**7 +00675 DISPLAY ' ' CL**4 +00676 DISPLAY ' '. CL**4 +00677 CL**4 +00678 CL**4 +00679 PROC2275-EXIT. CL**4 +00680 EXIT. CL**4 +00681 CL**4 +00682 P2016-SCAN-MRPT. CL**4 +00683 MOVE MSKL-REC TO MRPT-REC. CL**4 +00684 IF MRPT-YRQ = Z144-QUARTER CL*15 +00685 MOVE 1 TO WS-X140-RPT-FOUND CL**4 +00686 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 +00687 SET L910-NO-REC-88 TO TRUE CL**4 +00688 GO TO P2016-EXIT CL**4 +00689 ELSE CL**4 +00690 IF MRPT-YRQ > Z144-QUARTER CL*15 +00691 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 +00692 SET L910-NO-REC-88 TO TRUE CL**4 +00693 GO TO P2016-EXIT CL**4 +00694 ELSE CL**4 +00695 GO TO P2016-READ-NEXT CL**4 +00696 END-IF CL**4 +00697 END-IF. CL**4 +00698 CL**4 +00699 * IF MRPT-ORIG-88 CL**4 +00700 * SET W-RPT-ERROR-YES-88 TO TRUE CL**4 +00701 * SET L910-NO-REC-88 TO TRUE CL**4 +00702 * MOVE SPACES TO R140-MESSAGE CL**4 +00703 * MOVE W-EMP-NO TO R140-EMP-NO CL**4 +00704 * STRING CL**4 +00705 * ':-----FAILED - RPT EXIST IN DUTAS ' CL**4 +00706 * X140-QUARTER CL**4 +00707 * DELIMITED BY SIZE CL**4 +00708 * INTO R140-MESSAGE CL**4 +00709 * END-STRING CL**4 +00710 * MOVE R140-MESSAGE TO X434-MESSAGE CL**4 +00711 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 +00712 * GO TO P2016-EXIT CL**4 +00713 * END-IF. CL**4 +00714 CL**4 +00715 CL**4 +00716 P2016-READ-NEXT. CL**4 +00717 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 +00718 IF L910-NO-REC-88 CL**4 +00719 SET W-RPT-ERROR-NO-88 TO TRUE. CL**4 +00720 P2016-EXIT. CL**4 +00721 CL**4 +00722 CL**4 +00723 CL138 +00724 CL**4 +00725 PROC2500-DEL-SSN. CL*87 +00726 CL*87 +00727 * WRITE X147-RECORD-OUTA FROM X144-REC. CL125 +00728 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 +00729 ADD 1 TO WS-TOTAL-DELQ. CL113 +00730 CL129 +00731 IF WS-SAV-X147 = 1 CL129 +00732 GO TO PROC2500-EXIT. CL129 +00733 CL129 +00734 MOVE X147-SSN TO WS-INPUT-SSN. CL126 +00735 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL244 +00736 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL244 +00737 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL244 +00738 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL244 +00739 CL126 +00740 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL244 +00741 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL244 +00742 * MOVE X147-FNAME TO WS-OUT-FNAME. CL244 +00743 * MOVE X147-LNAME TO WS-OUT-LNAME. CL244 +00744 * MOVE X147-WAGES TO WS-OUT-WAGES. CL244 +00745 * IF WS-X144-SSN-FOUND = 1 CL244 +00746 * MOVE 'Y ' TO WS-OUT-X144 CL244 +00747 * ELSE CL244 +00748 * MOVE 'N ' TO WS-OUT-X144. CL244 +00749 * IF WS-X140-RPT-FOUND = 1 CL244 +00750 * MOVE 'Y ' TO WS-OUT-X140 CL244 +00751 * ELSE CL244 +00752 * MOVE 'N ' TO WS-OUT-X140. CL244 +00753 IF WS-CLAIM-SSN-FOUND = 1 CL205 +00754 MOVE '++CLAIM FOUND WAGES REPLACED' TO WS-OUT-MESSAGE CL205 +00755 ELSE CL205 +00756 MOVE '++NO CLAIM -- WAGES REPLACED' TO WS-OUT-MESSAGE. CL205 +00757 CL126 +00758 ADD 1 TO LINE-COUNT. CL206 +00759 WRITE PRINT-RECORD FROM WS-OUTPUT. CL206 +00760 PROC2500-EXIT. CL*87 +00761 EXIT. CL*87 +00762 CL*87 +00763 CL201 +00764 PROC2550-DEL-SSN. CL201 +00765 CL201 +00766 * WRITE X147-RECORD-OUTA FROM X144-REC. CL201 +00767 * WRITE X147-RECORD-OUTA FROM X147-REC. CL229 +00768 ADD 1 TO WS-TOTAL-DELQ. CL201 +00769 CL201 +00770 IF WS-SAV-X147 = 1 CL201 +00771 GO TO PROC2500-EXIT. CL201 +00772 CL201 +00773 MOVE X147-SSN TO WS-INPUT-SSN. CL201 +00774 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 +00775 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 +00776 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 +00777 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 +00778 CL201 +00779 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 +00780 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 +00781 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 +00782 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 +00783 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 +00784 * IF WS-X144-SSN-FOUND = 1 CL245 +00785 * MOVE 'Y ' TO WS-OUT-X144 CL245 +00786 * ELSE CL245 +00787 * MOVE 'N ' TO WS-OUT-X144. CL245 +00788 * IF WS-X140-RPT-FOUND = 1 CL245 +00789 * MOVE 'Y ' TO WS-OUT-X140 CL245 +00790 * ELSE CL245 +00791 * MOVE 'N ' TO WS-OUT-X140. CL245 +00792 * MOVE 'WAGES ---DELETED ' TO WS-OUT-MESSAGE. CL245 +00793 CL201 +00794 ADD 1 TO LINE-COUNT. CL210 +00795 WRITE PRINT-RECORD FROM WS-OUTPUT. CL210 +00796 PROC2550-EXIT. CL201 +00797 EXIT. CL201 +00798 CL201 +00799 CL123 +00800 PROC2600-SAV-SSN. CL123 +00801 CL123 +00802 MOVE 0 TO WS-SAV-X147. CL129 +00803 * WRITE X147-RECORD-OUTB FROM X147-REC. CL229 +00804 MOVE X147-SSN TO WS-INPUT-SSN. CL126 +00805 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 +00806 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 +00807 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 +00808 * MOVE CPD-SSN-SEQ TO WS-OUT-SEQ. CL245 +00809 CL126 +00810 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 +00811 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 +00812 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 +00813 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 +00814 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 +00815 * IF WS-X144-SSN-FOUND = 1 CL245 +00816 * MOVE 'Y ' TO WS-OUT-X144 CL245 +00817 * ELSE CL245 +00818 * MOVE 'N ' TO WS-OUT-X144. CL245 +00819 * IF WS-X140-RPT-FOUND = 1 CL245 +00820 * MOVE 'Y ' TO WS-OUT-X140 CL245 +00821 * ELSE CL245 +00822 * MOVE 'N ' TO WS-OUT-X140. CL245 +00823 * IF WRK-SEG01-SSN-FOUND = 0 CL245 +00824 * MOVE '++ X147 NOT FOUND IN DOCS -ESSP VERIFY' CL245 +00825 * TO WS-OUT-MESSAGE CL245 +00826 * ELSE CL245 +00827 * MOVE '++ CLAIM FOUND NO WAGES CANNOT DELETE ' CL245 +00828 * TO WS-OUT-MESSAGE. CL245 +00829 * MOVE 1 TO WS-SAV-X147. CL245 +00830 * ADD 1 TO LINE-COUNT. CL245 +00831 WRITE PRINT-RECORD FROM WS-OUTPUT. CL126 +00832 PROC2600-EXIT. CL123 +00833 EXIT. CL123 +00834 CL123 +00835 ******************************************************************DTSBX629 +00836 * PROC3000-READ-MASTER-FILE *DTSBX629 +00837 ******************************************************************DTSBX629 +00838 DTSBX629 +00839 PROC3000-READ-MASTER-FILE. DTSBX629 +00840 DTSBX629 +00841 MOVE 0 TO WS-X144-SSN-FOUND. CL116 +00842 MOVE 0 TO WS-X140-RPT-FOUND. CL138 +00843 CL116 +00844 READ X144SSN-IN INTO Z144-REC CL239 +00845 AT END DTSBX629 +00846 MOVE 'Y' TO MASTER-END-IND CL*63 +00847 GO TO PROC3000-READ-EXIT. DTSBX629 +00848 DTSBX629 +00849 * IF X147-EMP-NO = WS-X147-EMP-NO CL227 +00850 * AND X147-QUARTER = WS-X147-QUARTER CL227 +00851 * MOVE 3 TO WS-X144-SSN-FOUND CL227 +00852 * ELSE CL227 +00853 * MOVE X147-SSN TO WS-X147-SSN CL227 +00854 * MOVE X147-EMP-NO TO WS-X147-EMP-NO CL227 +00855 * MOVE X147-QUARTER TO WS-X147-QUARTER. CL227 +00856 ADD 1 TO MASTER-READ-COUNT. DTSBX629 +00857 DTSBX629 +00858 PROC3000-READ-EXIT. DTSBX629 +00859 EXIT. DTSBX629 +00860 DTSBX629 +00861 DTSBX629 +00862 ******************************************************************DTSBX629 +00863 * PROC5000-WRITE-RECORD-PAID *DTSBX629 +00864 ******************************************************************DTSBX629 +00865 DTSBX629 +00866 DTSBX629 +00867 PROC5000-X147-NOT-DELETED. CL*94 +00868 MOVE X147-SSN TO WS-INPUT-SSN. CL*92 +00869 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 +00870 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 +00871 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 +00872 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 +00873 * CL245 +00874 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 +00875 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 +00876 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 +00877 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 +00878 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 +00879 * MOVE 'Y ' TO WS-OUT-X144. CL245 +00880 * MOVE '++ CLAIM FOUND ON DOCS - VERIFY' TO WS-OUT-MESSAGE. CL245 +00881 DTSBX629 +00882 * IF LINE-COUNT GREATER 55 CL*74 +00883 * MOVE ZEROES TO LINE-COUNT CL*74 +00884 ADD 1 TO LINE-COUNT. CL126 +00885 WRITE PRINT-RECORD FROM WS-OUTPUT. CL*92 +00886 PROC5000-EXIT. CL*94 +00887 EXIT. DTSBX629 +00888 DTSBX629 +00889 CL*69 +00890 S910-OPEN-READ. CL**4 +00891 SET L910-OPEN-READ-88 TO TRUE. CL**4 +00892 GO TO S910-MSTR-IO. CL**4 +00893 CL**4 +00894 S910-READ. CL**4 +00895 SET L910-READ-88 TO TRUE. CL**4 +00896 GO TO S910-MSTR-IO. CL**4 +00897 CL**4 +00898 S910-START-BROWSE. CL**4 +00899 SET L910-START-BROWSE-88 TO TRUE. CL**4 +00900 GO TO S910-MSTR-IO. CL**4 +00901 CL**4 +00902 S910-READ-NEXT. CL**4 +00903 SET L910-READ-NEXT-88 TO TRUE. CL**4 +00904 GO TO S910-MSTR-IO. CL**4 +00905 CL**4 +00906 S910-CLOSE. CL**4 +00907 SET L910-CLOSE-88 TO TRUE. CL**4 +00908 GO TO S910-MSTR-IO. CL**4 +00909 CL**4 +00910 S910-MSTR-IO. CL**4 +00911 CALL 'DTSBU910' USING L910-LINK-AREA CL**4 +00912 MSKL-REC. CL**4 +00913 S910-EXIT. CL**4 +00914 EXIT. CL**4 +00915 CL**4 +00916 S001-FROM-CAL-6. CL**4 +00917 SET L001-FROM-CAL-6 TO TRUE. CL*55 +00918 GO TO S001-DATE-CONVERT. CL*55 +00919 CL*55 +00920 S001-FROM-ABS-DAY. CL*55 +00921 SET L001-FROM-ABS-DAY TO TRUE. CL*55 +00922 GO TO S001-DATE-CONVERT. CL*55 +00923 CL*55 +00924 S001-DATE-CONVERT. CL*55 +00925 CALL 'DTSBU001' USING L001-LINK-AREA. CL*55 +00926 S001-EXIT. CL*55 +00927 EXIT. CL*55 +00928 SKIP3 CL*55 +00929 S999-ABEND. CL*55 +00930 DISPLAY '*** ' CL*55 +00931 WRK-MODULE-NAME CL*55 +00932 ' IS ABENDING: ' CL*55 +00933 WRK-ABEND-MSG. CL*55 +00934 CL*55 +00935 CALL 'DTSBU999' USING WRK-ABEND-CD. CL*55 +00936 S999-EXIT. CL*55 +00937 EXIT. CL*55 +00938 S9999-ABEND. CL*78 +00939 SKIP1 CL*78 +00940 CALL 'DTSBU999' USING WRK-ABEND-CODE. CL*78 +00941 SKIP1 CL*78 +00942 S9999-EXIT. CL*78 +00943 EXIT. CL*78